I have coded a routine in Fortran to perform reverse byte order. This will be equivalent to src="1234"; dst="4321". I want to change the routine to to arbitrary ordering specified using the variables src and dst to set the ordering positions.
Here is the code for reverse byte ordering.
Subroutine byteorder (src, dst, x, y)
Real, Intent (out) :: y
Character (Len=*), Intent (in) :: src, dst
Real, Intent (in) :: x
Integer :: i, j
i = Transfer (x, 0)
Call Mvbits (i, 24, 8, j, 0 )
Call Mvbits (i, 16, 8, j, 8 )
Call Mvbits (i, 8, 8, j, 16 )
Call Mvbits (i, 0, 8, j, 24 )
y = Transfer (j, 0.0)
End Subroutine byteorder
You could wrap something like this
CHARACTER(len=4) :: src, dst
CHARACTER(len=1), DIMENSION(4) :: src_arr, dst_arr
INTEGER, DIMENSION(4) :: permutation
permutation = [2,4,3,1]
src_arr = TRANSFER(src,src_arr)
dst_arr = src_arr(permutation)
dst = TRANSFER(dst_arr,dst)
into a subroutine.
Fast enough ? You decide.
EDIT: My use of character variables for src and dst seems to have caused some confusion. The approach works just as well if src and dst are reals, or integers, something like:
REAL :: src, dst
Just take care to ensure that the character arrays have the same number of 1-byte elements as there are bytes in src and dst. I've used characters for the intermediate representation since these map 1:1 with bytes (on almost all computers you are likely to encounter) and I've transferred a 4-byte scalar to a 4 element array of 1-byte scalars to make it easy to permute using Fortran's inbuilt indexing capabilities. It's also easier to see what is going on if src and dat are character variables, otherwise src_arr and dst_arr are often meaningless jumbles of non-existent characters when written out.
It is even possible to do this without transfer:
program test
implicit none
character(len=*),parameter :: src = '1234'
integer,parameter :: perm(4) = [2,4,3,1]
character(len=len(src)) :: dst
integer :: i
do i=1,len(src)
dst(i:i) = src(perm(i):perm(i))
enddo
print *,src,'->',dst
end program
Related
I have coded a routine in Fortran to perform reverse byte order. This will be equivalent to src="1234"; dst="4321". I want to change the routine to to arbitrary ordering specified using the variables src and dst to set the ordering positions.
Here is the code for reverse byte ordering.
Subroutine byteorder (src, dst, x, y)
Real, Intent (out) :: y
Character (Len=*), Intent (in) :: src, dst
Real, Intent (in) :: x
Integer :: i, j
i = Transfer (x, 0)
Call Mvbits (i, 24, 8, j, 0 )
Call Mvbits (i, 16, 8, j, 8 )
Call Mvbits (i, 8, 8, j, 16 )
Call Mvbits (i, 0, 8, j, 24 )
y = Transfer (j, 0.0)
End Subroutine byteorder
You could wrap something like this
CHARACTER(len=4) :: src, dst
CHARACTER(len=1), DIMENSION(4) :: src_arr, dst_arr
INTEGER, DIMENSION(4) :: permutation
permutation = [2,4,3,1]
src_arr = TRANSFER(src,src_arr)
dst_arr = src_arr(permutation)
dst = TRANSFER(dst_arr,dst)
into a subroutine.
Fast enough ? You decide.
EDIT: My use of character variables for src and dst seems to have caused some confusion. The approach works just as well if src and dst are reals, or integers, something like:
REAL :: src, dst
Just take care to ensure that the character arrays have the same number of 1-byte elements as there are bytes in src and dst. I've used characters for the intermediate representation since these map 1:1 with bytes (on almost all computers you are likely to encounter) and I've transferred a 4-byte scalar to a 4 element array of 1-byte scalars to make it easy to permute using Fortran's inbuilt indexing capabilities. It's also easier to see what is going on if src and dat are character variables, otherwise src_arr and dst_arr are often meaningless jumbles of non-existent characters when written out.
It is even possible to do this without transfer:
program test
implicit none
character(len=*),parameter :: src = '1234'
integer,parameter :: perm(4) = [2,4,3,1]
character(len=len(src)) :: dst
integer :: i
do i=1,len(src)
dst(i:i) = src(perm(i):perm(i))
enddo
print *,src,'->',dst
end program
I'm attempting to test a program that calculates the discrete Fourier transform of a signal, namely a sine wave. To test it, I need to plot my results. However, the result is an array of size N (currently at 400) and is filled with complex numbers of the form z = x + iy. So I know that to test it I need to plot these results, and that to do this I need to plot |z|. Here's my program:
program DFT
implicit none
integer :: k, N, x, y, j, r, l, istat, p
integer, parameter :: dp = selected_real_kind(15,300)
real, allocatable,dimension(:) :: h
complex, allocatable, dimension(:) :: rst
complex, dimension(:,:), allocatable :: W
real(kind=dp) :: pi
p = 2*pi
!open file to write results to
open(unit=100, file="dft.dat", status='replace')
N = 400
!allocate arrays as length N, apart from W (NxN)
allocate(h(N))
allocate(rst(N))
allocate(W(-N/2:N/2,1:N))
pi = 3.14159265359
!loop to create the sample containing array
do k=1,N
h(k) = sin((2*pi*k)/N)
end do
!loop to fill the product matrix with values
do j = -N/2,N/2
do k = 1, N
W(j,k) = EXP((2.0_dp*pi*cmplx(0.0_dp,1.0_dp)*j*k)/N)
end do
end do
!use of matmul command to multiply matrices
rst = matmul(W,h)
print *, h, w
write(100,*) rst
end program
So my question is how do I take the magnitude of all the individual complex numbers in the array?
The ABS intrinsic function returns the magnitude of a complex number in Fortran. It is an elemental function as well, so for an array of type complex simply ABS( array ) will return a real array with the same kind as the original containing the results you want.
I am struggling with reading a text string in. Am using gfortran 4.9.2.
Below I have written a little subroutine in which I would like to submit the write format as argument.
Ideally I'd like to be able to call it with
call printarray(mat1, "F8.3")
to print out a matrix mat1 in that format for example. The numbers of columns should be determined automatically inside the subroutine.
subroutine printarray(x, udf_temp)
implicit none
real, dimension(:,:), intent(in) :: x ! array to be printed
integer, dimension(2) :: dims ! array for shape of x
integer :: i, j
character(len=10) :: udf_temp ! user defined format, eg "F8.3, ...
character(len = :), allocatable :: udf ! trimmed udf_temp
character(len = 10) :: udf2
character(len = 10) :: txt1, txt2
integer :: ncols ! no. of columns of array
integer :: udf_temp_length
udf_temp_length = len_trim(udf_temp)
allocate(character(len=udf_temp_length) :: udf)
dims = shape(x)
ncols = dims(2)
write (txt1, '(I5)') ncols
udf2 = trim(txt1)//adjustl(udf)
txt2 = "("//trim(udf2)//")"
do i = 1, dims(1)
write (*, txt2) (x(i, j), j = 1, dims(2)) ! this is line 38
end do
end suroutine printarray
when I set len = 10:
character(len=10) :: udf_temp
I get compile error:
call printarray(mat1, "F8.3")
1
Warning: Character length of actual argument shorter than of dummy argument 'udf_temp' (4/10) at (1)
When I set len = *
character(len=*) :: udf_temp
it compiles but at runtime:
At line 38 of file where2.f95 (unit = 6, file = 'stdout')
Fortran runtime error: Unexpected element '( 8
What am I doing wrong?
Is there a neater way to do this?
Here's a summary of your question that I will try to address: You want to have a subroutine that will print a specified two-dimensional array with a specified format, such that each row is printed on a single line. For example, assume we have the real array:
real, dimension(2,8) :: x
x = reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16], shape=[2,8], order=[2,1])
! Then the array is:
! 1.000 2.000 3.000 4.000 5.000 6.000 7.000 8.000
! 9.000 10.000 11.000 12.000 13.000 14.000 15.000 16.000
We want to use the format "F8.3", which prints floating point values (reals) with a field width of 8 and 3 decimal places.
Now, you are making a couple of mistakes when creating the format within your subroutine. First, you try to use udf to create the udf2 string. This is a problem because although you have allocated the size of udf, nothing has been assigned to it (pointed out in a comment by #francescalus). Thus, you see the error message you reported: Fortran runtime error: Unexpected element '( 8.
In the following, I make a couple of simplifying changes and demonstrate a few (slightly) different techniques. As shown, I suggest the use of * to indicate that the format can be applied an unlimited number of times, until all elements of the output list have been visited. Of course, explicitly stating the number of times to apply the format (ie, "(8F8.3)" instead of "(*(F8.3))") is fine, but the latter is slightly less work.
program main
implicit none
real, dimension(2,8) :: x
character(len=:), allocatable :: udf_in
x = reshape([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16], shape=[2,8], order=[2,1])
udf_in = "F8.3"
call printarray(x, udf_in)
contains
subroutine printarray(x, udf_in)
implicit none
real, dimension(:,:), intent(in) :: x
character(len=*), intent(in) :: udf_in
integer :: ncols ! size(x,dim=2)
character(len=10) :: ncols_str ! ncols, stringified
integer, dimension(2) :: dims ! shape of x
character(len=:), allocatable :: udf0, udf1 ! format codes
integer :: i, j ! index counters
dims = shape(x) ! or just use: ncols = size(x, dim=2)
ncols = dims(2)
write (ncols_str, '(i0)') ncols ! use 'i0' for min. size
udf0 = "(" // ncols_str // udf_in // ")" ! create string: "(8F8.3)"
udf1 = "(*(" // udf_in // "))" ! create string: "(*(F8.3))"
print *, "Version 1:"
do i = 1, dims(1)
write (*, udf0) (x(i, j), j = 1,ncols) ! implied do-loop over j.
end do
print *, "Version 2:"
do i = 1, dims(1)
! udf1: "(*(F8.3))"
write (*, udf1) (x(i, j), j = 1,ncols) ! implied do-loop over j
end do
print *, "Version 3:"
do i = 1, size(x,dim=1) ! no need to create nrows/ncols vars.
write(*, udf1) x(i,:) ! let the compiler handle the extents.
enddo
end subroutine printarray
end program main
Observe: the final do-loop ("Version 3") is very simple. It does not need an explicit count of ncols because the * takes care of it automatically. Due to its simplicity, there is really no need for a subroutine at all.
besides the actual error (not using the input argument), this whole thing can be done much more simply:
subroutine printarray(m,f)
implicit none
character(len=*)f
real m(:,:)
character*10 n
write(n,'(i0)')size(m(1,:))
write(*,'('//n//f//')')transpose(m)
end subroutine
end
note no need for the loop constructs as fortran will automatically write the whole array , line wrapping as you reach the length of data specified by your format.
alternately you can use a loop construct, then you can use a '*' repeat count in the format and obviate the need for the internal write to construct the format string.
subroutine printarray(m,f)
implicit none
character(len=*)f
real m(:,:)
integer :: i
do i=1,size(m(:,1))
write(*,'(*('//f//'))')m(i,:)
enddo
end subroutine
end
I need to make a FFT of a 3D array in Fortran using MPI. I've been looking at the FFTW website and I also tried to look for examples online but I could find only this code:
use, intrinsic :: iso_c_binding
include 'fftw3-mpi.f03'
integer(C_INTPTR_T), parameter :: L = ...
integer(C_INTPTR_T), parameter :: M = ...
type(C_PTR) :: plan, cdata
complex(C_DOUBLE_COMPLEX), pointer :: data(:,:)
integer(C_INTPTR_T) :: i, j, alloc_local, local_M, local_j_offset
! get local data size and allocate (note dimension reversal)
alloc_local = fftw_mpi_local_size_2d(M, L, MPI_COMM_WORLD, &
local_M, local_j_offset)
cdata = fftw_alloc_complex(alloc_local)
call c_f_pointer(cdata, data, [L,local_M])
! create MPI plan for in-place forward DFT (note dimension reversal)
plan = fftw_mpi_plan_dft_2d(M, L, data, data, MPI_COMM_WORLD, &
FFTW_FORWARD, FFTW_MEASURE)
! initialize data to some function my_function(i,j)
do j = 1, local_M
do i = 1, L
data(i, j) = my_function(i, j + local_j_offset)
end do
end do
! compute transform (as many times as desired)
call fftw_mpi_execute_dft(plan, data, data)
call fftw_destroy_plan(plan)
call fftw_free(cdata)
This code computes the FFT transform of a 2d array. My question is: how can I use this code to compute a FFT transform of a 3d array?
Regarding fftw_mpi_plan_dft_2d have a look at:
http://www.fftw.org/doc/MPI-Plan-Creation.html
It is quite obvious that there must be a fftw_mpi_plan_dft_3d function as well. The same of course for fftw_mpi_local_size_2d. The arguments will change slightly but the documentation will help you on this.
I need some technical help in modifying my FORTRAN coding. I have searched the Internet but I can't fine one which can solve my need.
Basically I am analyzing simulation data using FORTRAN program. Firstly, I shall explain the format of my data to make easy the understanding of what I want. I have 10 files. Each file contains x, y z, data for 1000 frames and each frame contains 20736 (x,y,z) data. Since the total size of all data is about 10 GB for all 10,000 frames, I have to break them into small chunks (10 files) to avoid any crash during calculation. At the beginning of each file (first line) there is a text which can be neglected and each frame ending with information of the box size (bx,by,bz). This is the format of my data files.
I have attached the coding which I have been using for analysis.
The current codding will do calculation file after file and frame after frame in the sequential order. But now I want to do the calculation on selected frames only by jumping frame after frame with certain pattern. For example, I choose frame 1, 4, 8, 12, 16.... and so on until the last frame (10,000).
I have no idea how to choose the frames which are more then 1000 which fall in the second or third files.
I have shown my code below:
module all_parameter
integer,parameter :: MAXATOM=20736
integer,parameter :: nat = 20736
integer, parameter :: startFiles=31
integer, parameter :: endFiles=40
integer,parameter :: NO_OF_FILES=10
integer,parameter :: FRAMES_IN=1000
integer, parameter :: totalFrames = ( NO_OF_FILES * FRAMES_IN )
integer :: i, j, k, IFram, nhb, nlipid, jjj
integer :: BIN, iat, jat
!real :: DELR, fnid, GNRM, RCUT, rlower, rupper
real :: junk, dR, bx, by, bz, bbx
real :: only_head, only_tail, only_water
real :: mass_head, mass_tail, mass_water
character*4 at(MAXATOM)
real,dimension(MAXATOM) :: x, y, z
real,dimension(3) :: rcm
real,dimension(MAXATOM) :: rx, ry, rz
real,dimension(MAXATOM) :: mass
integer, parameter :: startlipid=1
integer, parameter :: endlipid=64
integer, parameter :: lipidNo=64
real, parameter :: PI = (22.0/7.0)
real, dimension(startlipid:endlipid) :: array_UniVekLx, array_UniVekLy, array_UniVekLz
integer :: no, no2, c71, c72, c80, c81
real :: p1x, p1y, p1z, p2x, p2y, p2z, vekx, veky, vekz
real :: mag_vekp1p2, unit_vekx, unit_veky, unit_vekz
real :: sum_UniVekLx, sum_UniVekLy, sum_UniVekLz
real :: avg_frame_vekx, avg_frame_veky, avg_frame_vekz
real :: xx, yy, zz, frame_MagLipVek, theta,theta2, uni_frame_Vekx, uni_frame_Veky, uni_frame_Vekz
real :: xxx, yyy, zzz,UniVekLx, UniVekLy, UniVekLz, FrameAvgUniVekMag
real :: avg_UniVekLx, avg_UniVekLy,avg_UniVekLz, MagLipVek
end module all_parameter
PROGRAM order_parameter
use all_parameter
implicit none
!=========================================================================
! Open files to be read and to write on
!=========================================================================
!
! Topology file !CHANGE
open(unit=31,status="old",file="../malto_thermoNEW_Ori_50ns-set1.traj ")
open(unit=32,status="old",file="../malto_thermoNEW_Ori_50ns-set2.traj ")
open(unit=33,status="old",file="../malto_thermoNEW_Ori_50ns-set3.traj ")
open(unit=34,status="old",file="../malto_thermoNEW_Ori_50ns-set4.traj ")
open(unit=35,status="old",file="../malto_thermoNEW_Ori_50ns-set5.traj ")
open(unit=36,status="old",file="../malto_thermoNEW_Ori_50ns-set6.traj ")
open(unit=37,status="old",file="../malto_thermoNEW_Ori_50ns-set7.traj ")
open(unit=38,status="old",file="../malto_thermoNEW_Ori_50ns-set8.traj ")
open(unit=39,status="old",file="../malto_thermoNEW_Ori_50ns-set9.traj ")
open(unit=40,status="old",file="../malto_thermoNEW_Ori_50ns-set10.traj ")
! Open New Files
open(unit=51,status="unknown",file="BOXinfo.dat ")
open(unit=75,status="unknown",file="magnitude_theta_lipid-thermo-malto.dat")
do k = startlipid, endlipid
array_UniVekLx(k) =0.0
array_UniVekLy(k) =0.0
array_UniVekLz(k) =0.0
end do
! READ COORDINATES IN FRAMES FROM TRAJ file
INPUTFILES: do jjj = startFiles, endFiles
! LOOP OVER FRAMES
IFram = 1
read(jjj,'(a)') junk
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!IFram = 1
WHOLE: do while ( IFram <= FRAMES_IN)
read(jjj,'(10F8.3)') (x(i),y(i),z(i),i = 1,nat) ! reading TRAJ file
read(jjj,'(3F8.3)') bx,by,bz
write(51,'(a,3F8.3)') 'BOXINFO', bx,by,bz
! LOOP OVER ATOMS
loop1: do j = startlipid, endlipid !nat in lipids
loop2: do i = 45, 45 !,3 !atoms in a lipid
no= i + (j-1)*81
!no2= (no + 18)
c71=no
c72=(no+3)
p1x=((x(c71) + x(c72))/2.0 )
p1y=((y(c71) + y(c72))/2.0 )
p1z=((z(c71) + z(c72))/2.0 )
.
.
.
.
enddo loop2 ! going to next lipid
!CLOSE LOOP OVER ATOMS
enddo loop1 ! going to next frame , before that
!CLOSE LOOP OVER A FRAME
IFram = IFram + 1
enddo WHOLE
!CLOSE LOOP OVER ALL FILES
enddo INPUTFILES
end program order_parameter
I really appreciate your help in advance.
Thanks.
Well, in the loop, unless mod(framenumber, 4) == 0 skip to the next iteration (the CYCLE statement does that in Fortran). That way, you'll process only every fourth frame.
Also, you way want to use a somewhat more precise value for PI. 22/7, WTF?
Obviously the program needs to know which file it is reading, 1, 2... 10. Call that ifile. Then the frame with the file, say frame_in_file. Then you have frame = (ifile-1) * frame_in_file. Do you have a rule to decide whether you want to process "frame"? If the rule is to process every fourth, use mod and cycle as suggested #janneb. Otherwise, I'm not sure what you are asking.
With ten files, it would be easier to write the filename to a string and process them with a loop, opening each file in turn with the same unit number and closing at the end of the loop. This would be a little easier if you used the convention that the number in the file name was always two digits, with a leading zero if less than 10:
do ifile=1, 10
write (filename, '( "myfile_number", I2.2, ".data" )' ) ifile
open (unit=30, file=filename, ...)
loop: read from the file...
calculate overall frame number ...
cycle out of read loop if unsuitable frame...
process the frame...
end read loop
close (unit=30)
end do