Related
I want to solve this equation by using Fortran:
Where ψ (psi) is a complex Fortran variable.
Now, I am solving this by defining two new complex variables:
ir=(1.0,0.0) and ii=(0.0,1.0).
I use these to select only the real or imaginary part of the equation. In this way I solve my equation separately for the real and imaginary part. The code is here:
do i = 1,nn
mod2 = (abs(psi(i)))**2
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2*imag(psi(i))) + ii*(beta*real(der2(i)) - alpha*mod2*real(psi(i)))
end do
Where psi and der2 are complex arrays with nn elements.
I want to solve this equation in a better way without splitting it in two equations. I tried to solve it in this way:
mod2 = abs(psi)**2
psi = -ii*(-beta*der2+alpha*mod2*psi)
but it doesn't work because I obtain completely different values with respect to the first method I used. For me it makes sense that it doesn't work because in the second method I am not evaluating the real part. Is this right?
As an example, the 10° element of my psi array becomes:\
(-6.39094355774850412E-003,-6.04041029332164168E-003) (with 1° method)\
(-1.75266632213431602E-004,-6.21567692553507290E-003) (2° method)\
Any suggestion?
Thank you!
The problem is mod2 = abs(psi)**2 should have been mod2 = abs(dat)**2
But I think that the correct calculation for mod2 is sum( real( dat*conjg(dat) ) )
I get the same result with both methods with some arbitrary data:
eq1=
(-595.000000000000,-120.200000000000)
(-713.800000000000,-1.40000000000000)
(-832.600000000000,117.400000000000)
(-951.400000000000,236.200000000000)
(-1070.20000000000,355.000000000000)
(-1189.00000000000,473.800000000000)
(-1307.80000000000,592.600000000000)
(-1426.60000000000,711.400000000000)
(-1545.40000000000,830.200000000000)
(-1664.20000000000,949.000000000000)
eq2=
(-595.000000000000,-120.200000000000)
(-713.800000000000,-1.40000000000000)
(-832.600000000000,117.400000000000)
(-951.400000000000,236.200000000000)
(-1070.20000000000,355.000000000000)
(-1189.00000000000,473.800000000000)
(-1307.80000000000,592.600000000000)
(-1426.60000000000,711.400000000000)
(-1545.40000000000,830.200000000000)
(-1664.20000000000,949.000000000000)
Test code
program Console1
use,intrinsic :: iso_fortran_env
implicit none
! Variables
integer, parameter :: sp=real32, wp=real64
complex(wp), parameter :: ir = (1d0,0d0), ii = (0d0,1d0)
real(wp), parameter :: alpha = 0.1d0, beta = 0.2d0
integer, parameter :: n=10
complex(wp) :: dat(n), psi(n), der2(n)
integer :: i
! Body of Console1
dat = [ ( (2d0-i)*ir - (4d0+i)*ii, i=1,n ) ]
der2 = [ ( -(5d0+i)*ir + (1d0-i)*ii, i=1,n ) ]
psi = eq1(dat, der2)
print *, "eq1="
do i=1,n
print *, psi(i)
end do
psi = eq2(dat, der2)
print *, "eq2="
do i=1,n
print *, psi(i)
end do
contains
function eq1(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(psi))
complex(wp) :: psi(size(dat))
real(wp) :: mod2
integer :: i
mod2 = sum( real( dat*conjg(dat) ) )
do i=1, size(psi)
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2*imag(dat(i))) + ii*(beta*real(der2(i)) - alpha*mod2*real(dat(i)))
end do
end function
function eq2(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(dat))
complex(wp) :: psi(size(dat))
real(wp) :: mod2
mod2 = sum( real( dat*conjg(dat) ) )
psi = -ii*(-beta*der2+alpha*mod2*dat)
end function
end program Console1
Also with your definition of |ψ| we have also consistent results.
eq1=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
eq2=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
with code
function eq1(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(psi))
complex(wp) :: psi(size(dat))
real(wp) :: mod2(size(dat))
integer :: i
mod2 = abs(dat)**2
do i=1, size(psi)
psi(i) = ir*(-beta*imag(der2(i)) + alpha*mod2(i)*imag(dat(i))) + ii*(beta*real(der2(i)) - alpha*mod2(i)*real(dat(i)))
end do
end function
function eq2(dat, der2) result(psi)
complex(wp), intent(in) :: dat(:), der2(size(dat))
complex(wp) :: psi(size(dat))
real(wp) :: mod2(size(dat))
mod2 = abs(dat)**2
psi = -ii*(-beta*der2+alpha*mod2*dat)
end function
Going back to the original problem, I can replicate the issue
eq1=
(-13.0000000000000,-3.80000000000000)
(-21.4000000000000,-1.40000000000000)
(-34.6000000000000,3.40000000000000)
(-53.8000000000000,11.8000000000000)
(-80.2000000000000,25.0000000000000)
(-115.000000000000,44.2000000000000)
(-159.400000000000,70.6000000000000)
(-214.600000000000,105.400000000000)
(-281.800000000000,149.800000000000)
(-362.200000000000,205.000000000000)
eq2=
(0.000000000000000E+000,-1.20000000000000)
(0.200000000000000,-1.40000000000000)
(0.400000000000000,-1.60000000000000)
(0.600000000000000,-1.80000000000000)
(0.800000000000000,-2.00000000000000)
(-1952.64000000000,779.256000000000)
(NaN,NaN)
(1.40000000000000,-2.60000000000000)
(NaN,NaN)
(1.80000000000000,-3.00000000000000)
with mod2 = abs(psi)**2 instead of mod2 = abs(dat)**2
I have a file pos.xyz with the following format, where i = 6,etc represent the frame indices. (Here, the first frame has i = 6. In general, the first frame's index can be i = 0,i = 1, or i = 2,...)
I want to implement a function: For any two given integers a and b,( a<b, e.g., 7 and 9), read
the data from the frame index 7 to 9 into an array. Could you give me a suggestion on how to implement this idea?
4
i = 6, time = 3.000, E = -205.1846561900
O 2.6028572470 4.1666579520 12.7865910725
O 6.5415232423 8.8963227363 17.7533721708
O 15.6020396800 11.9022808314 15.2930838049
O 11.2843786793 13.2653367176 13.8186352548
4
i = 7, time = 3.500, E = -205.1845561905
O 5.1072569275 11.9945026418 4.1254340934
O 2.5299942732 11.4124710424 9.5495912455
O 14.8837181647 12.6571252157 7.8905997802
O 15.1684493877 10.7315923081 2.6631494700
4
i = 8, time = 4.000, E = -205.1846261900
O 2.6028572470 4.1666579520 12.7865910725
O 6.5415232423 8.8963227363 17.7533721708
O 15.6020396800 11.9922808314 15.2930838049
O 11.2843786793 13.2653367176 13.8186352548
4
i = 9, time = 4.500, E = -205.1846561805
O 5.1072569375 11.9945026418 4.1258340934
O 2.5299942732 11.4124710424 9.5495912455
O 14.8837181647 12.6570252157 7.8905997802
O 15.1684493877 10.7310923081 2.6630494700
4
i = 10, time = 5.000, E = -205.1846551805
O 5.1072569275 11.9945026418 4.1254340934
O 2.5299932732 11.4129710424 9.5495912455
O 14.8837181647 12.6571252157 7.8905997802
O 15.1684473877 10.7313923081 2.6631494700
what I did: for the special case with i = 0 as the first frame. For example, If I want to read from the 3rd frame, I can first skip (m+2)*(3-1) lines and then READ the data,m=4. The function is as follows.
SUBROUTINE skip_lines(indx, i_input)
! Purpose:
! To skip lines when read data from the input
IMPLICIT NONE
INTEGER :: i
INTEGER,INTENT(IN) :: i_input,indx
do i=1,i_input
read(indx,*) !Neglect (nat+2)*(ns-1) lines
enddo
END SUBROUTINE skip_lines
But for general case, if the first frame has a frame non-zero number,this idea is not efficient. I hope to find a better way to implement it.
Thanks to #francescalus 's and #High Performance Mark 's suggestions. I use a DO WHILE loop and I have implemented my idea. I put one simplified version of my subroutine here. It include some types defined in modules, which are not the important thing here. Now, it can
(1) Read a trajectory file from any step a to any step b, where a and b are given by user;
(2) Read data every ns steps.
SUBROUTINE read_traj(indx,nmo_start,nmo_end,ns,nat,n_samples)
! goal:
! read info from the trajectory file (format: ***.xyz)
! read data from frame a to frame b
USE atom_module
USE parameter_shared
INTEGER :: iatom, i_sample
INTEGER, PARAMETER:: nat = 4
INTEGER :: n_samples !n_samples = INT((a-b)/ns)
INTEGER, PARAMETER :: indx = 10
INTEGER, PARAMETER :: ns = 2 ! read one sample from the trajectory every ns step.
INTEGER, PARAMETER :: a =7
INTEGER, PARAMETER :: b=10
CHARACTER(LEN=4) :: x
INTEGER :: y
allocate(atom_info(nat,n_samples))
i_sample = 1
DO WHILE (i_sample < n_samples)
read(indx, '(A3,I5)') x, y
CHECK: IF (head_char=="i = " .AND. (y>a-1 .and. y<b+1) .AND. MOD(y-(a-1),ns) == 1) THEN
WRITE(*,*)"head_char and y:", x, y
BACKSPACE(UNIT=indx) ! we have to read the whole line with ' i = ' line.
read(indx,120) sampled_movie(i_sample), sampled_time(i_sample), sampled_energy(i_sample)
120 FORMAT (3X,I5,8X,F9.3,5X,F20.10)
inner: do iatom= 1,nat
read (indx,*) atom_info(iatom, i_sample)%atom_name, atom_info(iatom,i_sample)%coord(1), &
atom_info(iatom,i_sample)%coord(2), atom_info(iatom,i_sample)%coord(3)
enddo inner
i_sample = i_sample + 1
ENDIF CHECK
END DO
END SUBROUTINE read_traj
gfortran -Wall -fcheck=all parameter_shared.f95 atom_module.f95 traj.f95 sample.f95 test.f95 -o test.x
! test.f95
PROGRAM test
! Purpose: To read data starting from any block.
USE atom_module
IMPLICIT NONE
!==========
!parameters
!==========
INTEGER :: ns ! Get one sample from the trajectory every ns step.
INTEGER :: nmo_start
INTEGER :: nmo_end
INTEGER :: nat ! number of atoms
REAL(kind=4) :: delta_t0 ! For reading data
character(LEN=200) :: pos_filename
!===============
! Initialization
delta_t0 = 0.0005; ns = 2
nmo_start = 7; nmo_end = 10
nat = 4; pos_filename="pos.xyz"
!========================
! Sampling the trajectory
CALL sample(pos_filename,nmo_start,nmo_end,nat,ns)
END PROGRAM test
! sample.f95
SUBROUTINE sample(pos_filename,nmo_start,nmo_end,nat,ns)
USE parameter_shared
USE atom_module, ONLY: atom_info
USE traj
IMPLICIT NONE
!==========
!Parameters
!==========
character(LEN=*), INTENT(IN) :: pos_filename
INTEGER, INTENT(IN) :: nmo_start
INTEGER, INTENT(IN) :: nmo_end
INTEGER, INTENT(IN) :: nat ! number of atoms
INTEGER, INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
!Local varables
INTEGER :: n_samples !n_samples = INT(nmo/ns)
INTEGER :: iatom,imovie,i
!Initialization
iatom = 0; imovie =0; i =0
! Obatin n_samples
n_samples = sampling_number(nmo_start,nmo_end,ns)
allocate(sampled_movie(n_samples))
allocate(sampled_time(n_samples))
allocate(sampled_energy(n_samples))
!=======================
!read in trajectory file
!=======================
open(10,file=trim(pos_filename))
CALL read_traj(10,nmo_start,nmo_end,ns,nat,n_samples)
close(10)
write(6,*) 'End of trajectory reading.'
!=============
!write in file
!=============
sampled_pos_filename = 'pos_sampled.xyz'
open(10,file=sampled_pos_filename)
do i =1,n_samples
write (10,'(I8)') nat
WRITE(10,100) 'i =',i-1,', time =',sampled_time(i),', E =',sampled_energy(i)
100 FORMAT (1X,A3,I10,A8,F10.3,A5,F20.10)
DO iatom = 1, nat
WRITE(10,*) TRIM(atom_info(iatom, i)%atom_name), &
atom_info(iatom,i)%coord(1), &
atom_info(iatom,i)%coord(2), &
atom_info(iatom,i)%coord(3)
ENDDO
enddo
write(6,*)'Sampled trajectory is written in: ', sampled_pos_filename
close(10)
deallocate(sampled_movie, sampled_time,sampled_energy)
END SUBROUTINE sample
MODULE traj
IMPLICIT NONE
CONTAINS
INTEGER FUNCTION sampling_number(nmo_start,nmo_end,ns)
!To calculate the total numbers of samples one want to include
INTEGER,INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
INTEGER,INTENT(IN) :: nmo_start, nmo_end
write(*,*) 'In function sampling_number: nmo_end = ', nmo_end
positive: IF (nmo_end <0 .OR. nmo_start < 0 .OR. ns <0) THEN
write(*,*) 'Please enter non-negative values for the ns, starting step and ending step.'
ELSE IF (nmo_end < nmo_start) THEN
write(*,*) 'Please note that starting step shoud not larger than ending step.'
ELSE IF (ns ==0) THEN
sampling_number = nmo_end-(nmo_start-1)
ELSE IF (nmo_end-(nmo_start-1) <= ns) THEN
sampling_number = INT((nmo_end-(nmo_start-1))/ns + 1)
ELSE IF (nmo_end-(nmo_start-1) > ns) THEN
sampling_number = INT((nmo_end-(nmo_start-1))/ns)
END IF positive
END FUNCTION sampling_number
SUBROUTINE read_traj(indx,nmo_start,nmo_end,ns,nat,n_samples)
! Purpose: to READ data starting from a pattern-matched line.
USE atom_module, ONLY: atom_info
USE parameter_shared, ONLY: sampled_movie, sampled_time, sampled_energy
INTEGER :: iatom,i_sample
INTEGER, INTENT(IN) :: nat
INTEGER, INTENT(IN) :: n_samples !n_samples = INT(nmo/ns)
INTEGER, INTENT(IN) :: indx
INTEGER, INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
INTEGER, INTENT(IN) :: nmo_start, nmo_end ! To get the total number of moves
CHARACTER(LEN=4) :: head_char
INTEGER :: y
allocate(atom_info(nat,n_samples))
i_sample = 1
write(*,*) "read_traj(): New total time steps (n_samples):", n_samples
DO WHILE (i_sample < n_samples+1) ! +1 means i_sample can take the value of n_samples
read(indx, '(A4)') head_char
PRE_CHECK:IF (head_char=="i = ") THEN
BACKSPACE(UNIT=indx) ! Because I am not able to read other lines with the format '(A4,I8)', and have not find any good way, so I try to read it in '(A4)' first
read(indx, '(A4,I8)') head_char, y
CHECK_HEAD:IF (head_char=="i = " .AND. (y>nmo_start-1 .and. y<nmo_end+1) .AND. MOD(y-(nmo_start-1),ns) == 1) THEN
WRITE(*,*)"read_traj():", head_char, y
BACKSPACE(UNIT=indx) ! Because we have to read the whole line with ' i = ' line.
read(indx,130) sampled_movie(i_sample), sampled_time(i_sample), sampled_energy(i_sample)
130 FORMAT (4X,I8,9X,F12.3,6X,F20.10)
131 FORMAT (A4,3F20.10)
inner: do iatom= 1,nat
read (indx,131) atom_info(iatom, i_sample)%atom_name, atom_info(iatom,i_sample)%coord(1), &
atom_info(iatom,i_sample)%coord(2), atom_info(iatom,i_sample)%coord(3)
enddo inner
i_sample = i_sample + 1
ENDIF CHECK_HEAD
ENDIF PRE_CHECK
END DO
END SUBROUTINE read_traj
END MODULE traj
MODULE atom_module
! To define the derived data type for atom
IMPLICIT NONE
TYPE :: atom
CHARACTER(LEN=2) :: atom_name
INTEGER :: atom_id
INTEGER :: host_id ! For O atom in water, host_id = atom_id
REAL :: mass
REAL, DIMENSION(3) :: coord
END TYPE atom
! The array atom_info can be shared by subroutines
TYPE(atom), ALLOCATABLE, DIMENSION(:,:) :: atom_info
END MODULE atom_module
MODULE parameter_shared
!
! Purpose:
! To declare data to share between routines.
IMPLICIT NONE
!SAVE
character(LEN=200) :: sampled_pos_filename
INTEGER, ALLOCATABLE, DIMENSION(:) :: sampled_movie
REAL, ALLOCATABLE, DIMENSION(:) :: sampled_time, sampled_energy
END MODULE parameter_shared
I am using a known code (CAMB) which generates values like this :
k(h/Mpc) Pk/s8^2(Mpc/h)^3
5.2781500000e-06 1.9477400000e+01
5.5479700000e-06 2.0432300000e+01
5.8315700000e-06 2.1434000000e+01
6.1296700000e-06 2.2484700000e+01
6.4430100000e-06 2.3587000000e+01
6.7723700000e-06 2.4743400000e+01
7.1185600000e-06 2.5956400000e+01
7.4824500000e-06 2.7228900000e+01
7.8649500000e-06 2.8563800000e+01
8.2669900000e-06 2.9964100000e+01
I would like to get more precision on the generated values, like this :
k(h/Mpc) Pk/s8^2(Mpc/h)^3
5.3594794736e-06 1.8529569626e+01
5.6332442000e-06 1.9437295914e+01
5.9209928622e-06 2.0389484405e+01
6.2234403231e-06 2.1388326645e+01
6.5413364609e-06 2.2436098099e+01
6.8754711720e-06 2.3535198212e+01
7.2266739153e-06 2.4688137054e+01
7.5958159869e-06 2.5897554398e+01
7.9838137026e-06 2.7166225433e+01
8.3916311269e-06 2.8497039795e+01
8.8202796178e-06 2.9893053055e+01
9.2708232842e-06 3.1357446670e+01
9.7443817140e-06 3.2893573761e+01
Here the section of code that produces the data :
I tried to do the following modifications in the declarations of variables at the beginning of code above :
1)First try :
!Export files of total matter power spectra in h^{-1} Mpc units, against k/h.
Type(MatterTransferData), intent(in) :: MTrans
Type(CAMBdata) :: State
character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
character(LEN=name_tag_len) :: columns(3)
integer itf, i, unit
integer points
! Added : way of declaring double precision
integer, parameter :: wp = selected_real_kind(15,307)
real(wp), dimension(:,:), allocatable :: outpower
but it doesn't compile :
real(wp), dimension(:,:), allocatable :: outpower
1
Error: Symbol ‘wp’ at (1) has no IMPLICIT type
../results.f90:3660:25:
allocate(outpower(points,ncol))
1
Error: Allocate-object at (1) is neither a data pointer nor an allocatable variable
../results.f90:3676:16:
outpower(:,1) = exp(PK_data%matpower(:,1))
1
Error: Unclassifiable statement at (1)
../results.f90:3679:20:
outpower(:,3) = exp(PK_data%vvpower(:,1))
1
Error: Unclassifiable statement at (1)
compilation terminated due to -fmax-errors=4.
make[1]: *** [results.o] Error 1
make: *** [camb] Error 2
2) Also, I tried :
!Export files of total matter power spectra in h^{-1} Mpc units, against k/h.
Type(MatterTransferData), intent(in) :: MTrans
Type(CAMBdata) :: State
character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
character(LEN=name_tag_len) :: columns(3)
integer itf, i, unit
integer points
! Added : way of declaring double precision
double precision, dimension(:,:), allocatable :: outpower
but same thing, no compilation succeeded
call Transfer_GetMatterPowerS(State, MTrans, outpower(1,1), itf, minkh,dlnkh, points)
1
Error: Type mismatch in argument ‘outpower’ at (1); passed REAL(8) to REAL(4)
make[1]: *** [results.o] Error 1
make: *** [camb] Error 2
UPDATE 1:
with -fmax-errors=1, I get the following :
call Transfer_GetMatterPowerS(State, MTrans, outpower(1,1), itf, minkh,dlnkh, points)
1
Error: Type mismatch in argument ‘outpower’ at (1); passed REAL(8) to REAL(4)
compilation terminated due to -fmax-errors=1.
Except the solution given by #Steve with compilation option -freal-4-real-8, isn't really there another solution that I could include directly into code, i.e the section that I have given ?
UPDATE 2: here below the 3 relevant subroutines Transfer_GetMatterPowerS , Transfer_GetMatterPowerData and Transfer_SaveMatterPower that produces the error when trying to get double precision :
subroutine Transfer_GetMatterPowerS(State, MTrans, outpower, itf, minkh, dlnkh, npoints, var1, var2)
class(CAMBdata) :: state
Type(MatterTransferData), intent(in) :: MTrans
integer, intent(in) :: itf, npoints
integer, intent(in), optional :: var1, var2
real, intent(out) :: outpower(*)
real, intent(in) :: minkh, dlnkh
real(dl) :: outpowerd(npoints)
real(dl):: minkhd, dlnkhd
minkhd = minkh; dlnkhd = dlnkh
call Transfer_GetMatterPowerD(State, MTrans, outpowerd, itf, minkhd, dlnkhd, npoints,var1, var2)
outpower(1:npoints) = outpowerd(1:npoints)
end subroutine Transfer_GetMatterPowerS
subroutine Transfer_GetMatterPowerData(State, MTrans, PK_data, itf_only, var1, var2)
!Does *NOT* include non-linear corrections
!Get total matter power spectrum in units of (h Mpc^{-1})^3 ready for interpolation.
!Here there definition is < Delta^2(x) > = 1/(2 pi)^3 int d^3k P_k(k)
!We are assuming that Cls are generated so any baryonic wiggles are well sampled and that matter power
!spectrum is generated to beyond the CMB k_max
class(CAMBdata) :: State
Type(MatterTransferData), intent(in) :: MTrans
Type(MatterPowerData) :: PK_data
integer, intent(in), optional :: itf_only
integer, intent(in), optional :: var1, var2
double precision :: h, kh, k, power
integer :: ik, nz, itf, itf_start, itf_end, s1, s2
s1 = PresentDefault (transfer_power_var, var1)
s2 = PresentDefault (transfer_power_var, var2)
if (present(itf_only)) then
itf_start=itf_only
itf_end = itf_only
nz = 1
else
itf_start=1
nz= size(MTrans%TransferData,3)
itf_end = nz
end if
PK_data%num_k = MTrans%num_q_trans
PK_Data%num_z = nz
allocate(PK_data%matpower(PK_data%num_k,nz))
allocate(PK_data%ddmat(PK_data%num_k,nz))
allocate(PK_data%nonlin_ratio(PK_data%num_k,nz))
allocate(PK_data%log_kh(PK_data%num_k))
allocate(PK_data%redshifts(nz))
PK_data%redshifts = State%Transfer_Redshifts(itf_start:itf_end)
h = State%CP%H0/100
do ik=1,MTrans%num_q_trans
kh = MTrans%TransferData(Transfer_kh,ik,1)
k = kh*h
PK_data%log_kh(ik) = log(kh)
power = State%CP%InitPower%ScalarPower(k)
if (global_error_flag/=0) then
call MatterPowerdata_Free(PK_data)
return
end if
do itf = 1, nz
PK_data%matpower(ik,itf) = &
log(MTrans%TransferData(s1,ik,itf_start+itf-1)*&
MTrans%TransferData(s2,ik,itf_start+itf-1)*k &
*const_pi*const_twopi*h**3*power)
end do
end do
call MatterPowerdata_getsplines(PK_data)
end subroutine Transfer_GetMatterPowerData
subroutine Transfer_SaveMatterPower(MTrans, State,FileNames, all21cm)
use constants
!Export files of total matter power spectra in h^{-1} Mpc units, against k/h.
Type(MatterTransferData), intent(in) :: MTrans
Type(CAMBdata) :: State
character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
character(LEN=name_tag_len) :: columns(3)
integer itf, i, unit
integer points
! Added : way of declaring double precision
!integer, parameter :: wp = selected_real_kind(15,307)
!real(wp), dimension(:,:), allocatable :: outpower
double precision, dimension(:,:), allocatable :: outpower
real minkh,dlnkh
Type(MatterPowerData) :: PK_data
integer ncol
logical, intent(in), optional :: all21cm
logical all21
!JD 08/13 Changes in here to PK arrays and variables
integer itf_PK
all21 = DefaultFalse(all21cm)
if (all21) then
ncol = 3
else
ncol = 1
end if
do itf=1, State%CP%Transfer%PK_num_redshifts
if (FileNames(itf) /= '') then
if (.not. transfer_interp_matterpower ) then
itf_PK = State%PK_redshifts_index(itf)
points = MTrans%num_q_trans
allocate(outpower(points,ncol))
!Sources
if (all21) then
call Transfer_Get21cmPowerData(MTrans, State, PK_data, itf_PK)
else
call Transfer_GetMatterPowerData(State, MTrans, PK_data, itf_PK)
!JD 08/13 for nonlinear lensing of CMB + LSS compatibility
!Changed (CP%NonLinear/=NonLinear_None) to CP%NonLinear/=NonLinear_none .and. CP%NonLinear/=NonLinear_Lens)
if(State%CP%NonLinear/=NonLinear_none .and. State%CP%NonLinear/=NonLinear_Lens) then
call State%CP%NonLinearModel%GetNonLinRatios(State, PK_data)
PK_data%matpower = PK_data%matpower + 2*log(PK_data%nonlin_ratio)
call MatterPowerdata_getsplines(PK_data)
end if
end if
outpower(:,1) = exp(PK_data%matpower(:,1))
!Sources
if (all21) then
outpower(:,3) = exp(PK_data%vvpower(:,1))
outpower(:,2) = exp(PK_data%vdpower(:,1))
outpower(:,1) = outpower(:,1)/1d10*const_pi*const_twopi/MTrans%TransferData(Transfer_kh,:,1)**3
outpower(:,2) = outpower(:,2)/1d10*const_pi*const_twopi/MTrans%TransferData(Transfer_kh,:,1)**3
outpower(:,3) = outpower(:,3)/1d10*const_pi*const_twopi/MTrans%TransferData(Transfer_kh,:,1)**3
end if
call MatterPowerdata_Free(PK_Data)
columns = ['P ', 'P_vd','P_vv']
unit = open_file_header(FileNames(itf), 'k/h', columns(:ncol), 15)
do i=1,points
write (unit, '(*(E15.6))') MTrans%TransferData(Transfer_kh,i,1),outpower(i,:)
end do
close(unit)
else
if (all21) stop 'Transfer_SaveMatterPower: if output all assume not interpolated'
minkh = 1e-4
dlnkh = 0.02
points = log(MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf)/minkh)/dlnkh+1
! dlnkh = log(MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf)/minkh)/(points-0.999)
allocate(outpower(points,1))
call Transfer_GetMatterPowerS(State, MTrans, outpower(1,1), itf, minkh,dlnkh, points)
columns(1) = 'P'
unit = open_file_header(FileNames(itf), 'k/h', columns(:1), 15)
do i=1,points
write (unit, '(*(E15.6))') minkh*exp((i-1)*dlnkh),outpower(i,1)
end do
close(unit)
end if
deallocate(outpower)
end if
end do
end subroutine Transfer_SaveMatterPower
I wrote a program for matrix product state in Fortran 90. In this program, I use the Intel MKL library. When the compiler option is:
OPTIMIZE= -parallel -par-threshold90 -ipo -O3 -no-prec-div -fp-model fast=2 -xHost
LinkLine = $(OPTIMIZE) $(DIAGNOSE) -mkl -static-intel,
in the runtime, the memory keeps increasing.
If I change the compiler option to:
OPTIMIZE= -ipo -O3 -no-prec-div -fp-model fast=2 -xHost
LinkLine = $(OPTIMIZE) $(DIAGNOSE) -mkl=sequential -static-intel,
there is no problem, everything is fine.
Why does this happen? Is there any solution to this?
Follow the suggestions by Alexander, I post one of the subroutines (performing singular value decomposition for a matrix) in the following:
SUBROUTINE SVD(Theta,S1,S2,lambda,Din,Dout)
IMPLICIT NONE
INTEGER, INTENT(IN) :: Din, Dout
COMPLEX(kind=rKind),DIMENSION(Din,Din), INTENT(IN) :: Theta
REAL(kind=rKind), INTENT(OUT) :: lambda(Dout)
COMPLEX(kind=rKind), INTENT(OUT) :: S1(Din,Dout),S2(Din,Dout)
COMPLEX(kind=rKind) :: M(Din,Din)
REAL(kind=rKind) :: temp_lam(Din)
COMPLEX(kind=rKind) :: temp_U(Din,Din), temp_V(Din,Din)
COMPLEX(kind=rKind) :: WORK(10*Din)
REAL(kind=rKind) :: RWORK(5*Din)
REAL(kind=rKind), PARAMETER :: Truncation = 1E-13_rKind
INTEGER :: INFO, i
!----------------------------
M = Theta
CALL ZGESVD('A','A',Din,Din,M,Din,temp_lam,temp_U,Din,temp_V,Din,WORK,10*Din,RWORK,INFO)
lambda = 0.0_rKind
S1 = 0.0_rKind
S2 = 0.0_rKind
DO i = 1,Dout
IF (temp_lam(i)/temp_lam(1)>Truncation) THEN
lambda(i) = temp_lam(i)
S1(:,i) = temp_U(:,i)
S2(:,i) = temp_V(i,:)
END IF
END DO
END SUBROUTINE SVD
And another subroutine is
SUBROUTINE TwoSiteUpdate(A_update,B_update,lambda_2_update,&
& A,B,lambda_1,lambda_2,U,D1,D2_old,D2_new)
! Designed for 1D MPS.
IMPLICIT NONE
INTEGER, INTENT(IN) :: D1, D2_old, D2_new
COMPLEX(kind=rKind), INTENT(IN) :: A(D1,D2_old,localSize), B(D2_old,D1,localSize)
REAL(kind=rKind), INTENT(IN) :: lambda_1(D1), lambda_2(D2_old)
COMPLEX(kind=rKind), INTENT(IN) :: U(localSize,localSize,localSize,localSize)
COMPLEX(kind=rKind), INTENT(OUT) :: A_update(D1,D2_new,localSize), B_update(D2_new,D1,localSize)
REAL(kind=rKind), INTENT(OUT) :: lambda_2_update(D2_new)
COMPLEX(kind=rKind) :: temp_A(D1,D2_old,localSize)
COMPLEX(kind=rKind) :: temp_B(D2_old,D1,localSize)
COMPLEX(kind=rKind) :: Theta(D1,localSize,D1,localSize)
COMPLEX(kind=rKind) :: Theta_S(D1*localSize,D1*localSize)
COMPLEX(kind=rKind) :: S1(D1*localSize,D2_new), S2(D1*localSize,D2_new)
COMPLEX(kind=rKind) :: S1_tmp(D1,localSize,D2_new)
COMPLEX(kind=rKind) :: S2_tmp(D1,localSize,D2_new)
REAL(kind=rKind), PARAMETER :: Truncation=1E-16_rKind
COMPLEX(kind=rKind) :: tmp_ele
INTEGER :: i1,i2,i3,im
INTEGER :: mA1,mB1,mA2,mB2
INTEGER :: i
!------------------- add lambda on A, B ----------------------
temp_A = 0.0_rKind
temp_B = 0.0_rKind
DO im = 1,localSize
DO i2 = 1,D2_old
DO i1 = 1,D1
IF(lambda_1(i1)>Truncation) THEN
temp_A(i1,i2,im) = A(i1,i2,im)*SQRT(lambda_1(i1))
temp_B(i2,i1,im) = B(i2,i1,im)*SQRT(lambda_1(i1))
END IF
END DO
END DO
END DO
!--------------- svd on Theta ----------------
Theta = 0.0_rKind
DO mB2 = 1,localSize
DO i2 = 1,D1
DO mA2 = 1,localSize
DO i1 = 1,D1
tmp_ele = 0.0_rKind
DO mB1 = 1,localSize
DO mA1 = 1,localSize
DO i3 = 1,D2_old
tmp_ele = tmp_ele + U(mA2,mB2,mA1,mB1)*temp_A(i1,i3,mA1)*temp_B(i3,i2,mB1)
END DO
END DO
END DO
Theta(i1,mA2,i2,mB2) = tmp_ele
END DO
END DO
END DO
END DO
Theta_S = RESHAPE(Theta,SHAPE=(/D1*localSize,D1*localSize/))
CALL SVD(Theta_S,S1,S2,lambda_2_update,D1*localSize,D2_new)
lambda_2_update = lambda_2_update/lambda_2_update(1)
S1_tmp = RESHAPE(S1,SHAPE=(/D1,localSize,D2_new/))
S2_tmp = RESHAPE(S2,SHAPE=(/D1,localSize,D2_new/))
!---------------- update A, B ----------------
A_update = 0.0_rKind
B_update = 0.0_rKind
DO im = 1,localSize
DO i2 = 1,D2_new
DO i1 = 1,D1
IF (lambda_1(i1)>Truncation) THEN
A_update(i1,i2,im) = S1_tmp(i1,im,i2)*SQRT(lambda_2_update(i2))/SQRT(lambda_1(i1))
B_update(i2,i1,im) = S2_tmp(i1,im,i2)*SQRT(lambda_2_update(i2))/SQRT(lambda_1(i1))
END IF
END DO
END DO
END DO
END SUBROUTINE TwoSiteUpdate
Above two subroutines are the time consuming part of the program. Without these two subroutines, the program is fine and the memory does not increase. With these two, the memory do increase when I use the parallel version.
You may check whether you used compound type with allocatable items in loops. You may also use OpenMP parallel directives and the -openmp compile option to manual control where to be paralleled, rather than the auto-parallel, as follows
$omp parallel do
do i = 1, n
...
$ ifort -openmp foo.f90
I want to apply three different methods, selected with the value of an integer switch. The first method uses two integers, the second a real array and an integer and the third a real 2D array. In my current implementation, I allocate and pass as parameters all the above data (2 int + real_array + int + real_2array). I could also use a module, but it would be similar. I'm searching for a method to define only the data that my method will use (i.e. only the matrix for method 3) and nothing else. Any suggestions?
Edit:
I have made a simplified version of what I described above.
A part of the main program:
INTEGER :: m, imeth
REAL*8 :: x, y
REAL*8, DIMENSION(:), ALLOCATABLE :: uu, wc
REAL*8, DIMENSION(:,:), ALLOCATABLE :: BCH
imeth = 0
m = 64
ALLOCATE(uu(m), uu_(m), wc(m))
ALLOCATE(BCH(m,m))
if (imeth .EQ. 0) then
x = 1.0d0
y = 2.0d0
elseif (imeth .EQ. 1) then
!Assign values to wc
else
!Assign values to BCH
endif
call subr(m,x,y,uu,uu_,imeth,BCH,wc)
STOP
END
and a subroutine
SUBROUTINE subr(n,a,b,u,u_,imeth,DCH,ws)
IMPLICIT NONE
INTEGER, INTENT(IN) :: n, imeth
REAL*8, INTENT(IN) :: u(n), DCH(n,n), ws(n)
REAL*8, INTENT(OUT) :: u_(n)
INTEGER :: i
if (imeth .EQ. 0) then
u_ = -u_ * 0.5d0 / (a+b)
elseif (imeth .EQ. 1) then
u_ = -u / ws
else
u_ = matmul(DCH,u)
endif
RETURN
END SUBROUTINE subr
I want the main program to have a form like
imeth = 0
m = 64
ALLOCATE(uu(m), uu_(m))
if (imeth .EQ. 0) then
a = 1.0d0
b = 2.0d0
elseif (imeth .EQ. 1) then
ALLOCATE(wc(m))
!Assign values to wc
else
ALLOCATE(BCH(m,m))
!Assign values to BCH
endif
if (imeth .EQ. 0) then
call subrA(m,x,y,uu,uu_)
elseif (imeth .EQ. 1) then
call subrB(m,wc,uu,uu_)
else
call subrC(m,BCH,uu,uu_)
endif
EDIT: After OP added the code I think that using optional arguments in conjunction with the present intrinsic might be better suited for this task. The subroutine could then read
SUBROUTINE subr(n,u_,a,b,u,DCH,ws)
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
REAL*8, INTENT(OUT) :: u_(n)
REAL*8, INTENT(IN),OPTIONAL :: a(n)
REAL*8, INTENT(IN),OPTIONAL :: b(n)
REAL*8, INTENT(IN),OPTIONAL :: u(n)
REAL*8, INTENT(IN),OPTIONAL :: DCH(n,n)
REAL*8, INTENT(IN),OPTIONAL :: ws(n)
INTEGER :: i
if ( present(a) .and. present(b) ) then
u_ = -u_ * 0.5d0 / (a+b)
elseif ( present(u) .and. present(ws) ) then
u_ = -u / ws
elseif ( present(wch) .and. present(u) ) then
u_ = matmul(DCH,u)
else
stop 'invalid combination'
endif
END SUBROUTINE subr
Here is the old answer as it still might be helpful:
Maybe you could try interfaces:
module interface_test
implicit none
interface method
module procedure method1
module procedure method2
module procedure method3
end interface
contains
subroutine method1(int1, int2)
implicit none
integer,intent(in) :: int1
integer,intent(out) :: int2
int2 = 2*int1
end subroutine
subroutine method2(int, realArray)
implicit none
integer,intent(in) :: int
real,intent(out) :: realArray(:)
realArray = real(2*int)
end subroutine
subroutine method3(realArray)
implicit none
real,intent(inout) :: realArray(:,:)
realArray = 2*realArray
end subroutine
end module
program test
use interface_test, only: method
implicit none
integer :: int1, int2
real :: arr1D(10)
real :: arr2D(10,10)
int1 = 1
call method(int1, int2)
print *, int2
call method(int1,arr1D)
print *, arr1D(1)
arr2D = 1.
call method(arr2D)
print *, arr2D(1,1)
end program