Those who write papers, especially longer one, they know how difficult and irritating it is to sort the bibliography every time you change the text. I made this little code to sort the bibliography as they appear in the text using '\cite{}'. Some journal does not allow to sort the bibliography as it appear in the figure caption. I have not given any special care to it for simplicity. The code appears below in a very misaligned fashion. It should work pretty well.
function bibsort(fname,bibfile,outfile)
%
% 'bibsort' sorts the bibliography of the main latex file
% as the references appear in the text.
%
% bibsort('paper.tex','bibliography.tex',''outputfile.tex')
% will find the citation from file 'paper.tex' and find the
% bibliography from file 'bibliography.tex' and the sorted bibliograpy
% will be written in 'outputfile.tex'. Default biblography file is the
% main file and the default outputfile is 'bib.tex'.
%
% This program will identify a reference as written in '\cite{reference}'
% in the main file and then search for that reference in the bibliograpy
% as written in '\bibitem{refererence}'. More reference as seperated
% by , inside one '\cite{}' is incorporated. Again, one '\cite{}' as
% splitted into two lines are also taken care of.
%
% Tanmoy Das.
% Feb 12 2008.
%
if nargin<1;error('Specify your input latex file');end;
if nargin ==1;bibfile=fname;outfile = 'bib.tex';end;
if nargin ==2;outfile = 'bib.tex';end;
%
fid = fopen(fname,'rt');
if fid<0;error(sprintf('%s%s%s','Input file [',fname,'] NOT found'));end
bfid = fopen(bibfile,'rt');
if bfid<0;error(sprintf('%s%s%s','Bibliography file [',bibname,'] NOT found'));end
ofid = fopen(outfile,'w');
%
% Identify all the references and save in variable 'd'
b = 'cite{';
ii = 1; % No of references as identified
while feof(fid) == 0;
tline = fgetl(fid); %read one line
len = length(tline);
if len>=1&tline(1)=='%';continue;end
% find the indices where refereces are located
indi = findstr(tline, b);
%num = length(indi);
if length(indi) > 0
len1= length(indi);
ik = 1; % index for the length of a reference
ij = 1; % index for the no of reference in one line
while (ij<=len1)
%tline(indi(ij)-1)
if (indi(ij)>2)&(tline(indi(ij)-2)=='%');ij=ij+1;continue;end;
il = indi(ij)+5;
while(il<=len)
c = tline(il); % store one character of the line
%} is found then the ref(s) in \cite{} is identified
if c=='}' ;ii= ii+1; ik=1; break; end;
% if , in \cite{} is found then one ref if identified
if c==','; ik=1; ii=ii+1; il = il+1; end;
d(ii,ik)=tline(il); % Store one character of a ref.
ik = ik+1; % increases the character length of a ref
% check if the line is finished before identifying one full
% ref.
if il==len;
tlinen = fgetl(fid); % go to net line
while length(tlinen)>=1&tlinen(1)=='%';
tlinen = fgetl(fid); % go to net line
end
tline = [tline tlinen]; % add the new line to old one
len = length(tline); % modify the new line length
% look for aditional '\cite{' in the new line
indi = findstr(tline, b);
% modify the new no of '\cite{' in the total line
len1=length(indi);
end
il = il+1; % go to the next character in the line
end %while: all ref found under one '\cite'
ij = ij+1; % go to the next '\cite'
end %while
end % if
end % while
%%%%%%%%%%%%%%%%%%%%%
% Now remove the same reference and store all independent references in
% 'f', as they are in order
%%%%%%%%%%%%%%%%%%%%%
ii = 1;
f(ii,:) = d(ii,:);
for ij = 2:size(d,1)
flag = 0;
for ik = ij-1:-1:1
if d(ij,:)==d(ik,:);flag = 1;break;end;
end
if (flag==0)
ii = ii+1;
f(ii,:) = d(ij,:);
else
continue
end
end
fclose(fid);
%
% Now look for the references fron 'The bibliograpy'
%
bfid = fopen(bibfile,'rt');
while feof(bfid) == 0;
tline = fgetl(bfid);
%if length(tline)>=1&tline(1)=='%';continue;end
indi = findstr(tline, sprintf('%s%s%s','\begin{thebibliography'));
num = length(indi);
if num > 0
fprintf(ofid,'%s\n',tline);
break;
end
end
fclose(bfid);
%
for ii = 1:size(f,1)
bfid = fopen(bibfile,'rt');
while feof(bfid) == 0;
tline = fgetl(bfid);
%if length(tline)>=1&tline(1)=='%';continue;end
indi = findstr(tline, sprintf('%s%s%s','\bibitem{',f(ii,:),'}'));
num = length(indi);
if num > 0
if (indi(1)>1)&(tline(indi(1)-1)=='%');continue;end;
fprintf(ofid,'%s\n',tline);
num2 = 0;
while (num2==0)
tline1 = fgetl(bfid);
%while length(tline1)>=1;%&tline1(1)=='%';
% tline1 = fgetl(fid);
%end
ind1 = findstr(tline1, '\end{thebibliography');
num1 = length(ind1);
if num1 >0;break;end;
ind2 = findstr(tline1, '\bibitem{');
num2 = length(ind2);
if num2==0;
%tline = [tline; tline1];
fprintf(ofid,'%s\n',tline1);
end;
end
% fprintf(ofid,'%s\n',tline);
break
end
end
fclose(bfid);
if(num<=0)error(sprintf('%s%s%s','Reference[',f(ii,:),']not found'));end;
end
%
bfid = fopen(bibfile,'rt');
while feof(bfid) == 0;
tline = fgetl(bfid);
%if length(tline)>=1&tline(1)=='%';continue;end
indi = findstr(tline, sprintf('%s%s%s','\end{thebibliography'));
num = length(indi);
if num > 0
fprintf(ofid,'%s\n',tline);
end
end
fclose(bfid);
fclose(ofid);
return
Saturday, October 11, 2008
spline interpolation function for advanced fortran
This subroutine will help you to spline the whole dimension of a vector. This can be easily modified to multi-dimensional matrix calculation.
subroutine spline(n,x,y,yp1,ypn,no,xo,yo)
cccccccccccccccccccccccccccccccccccccccccccccccccccc
c This subroutine will calculate the cubic-spline intepolated value of
c given any function for single variable of any dimension
c
c inputs/output:
c n : (input) [scalar] dimension of input array
c x : (input) [vector of length 'n'], independent variable of dimension 'n'
c y : (input)[vector of length 'n']' the function of x (an array of dimension 'n'
c yp1 : (input) [scalar] =1.e+30 :: the routine is signaled to set
c the corresponding boundary condition
c for a natural spline, with zero
c second derivative on that boundary
c ypn : (input) same to yp1 = 1.e+30
c no : (input) [scalar] dimension output array
c xo : (input) [vector of length 'no'], 'x' values at which you want to spline
c yo : (output) [vector of length 'no'], splined value
c
c Note: This works properly in any inter fortran compiler and f90-compiler
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Tanmoy Das.
c
c Feb 13, 2008.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
integer::n,no,io
real,dimension(1:n)::x,y,y2,u
real,dimension(1:no)::xo,yo
c
if (yp1.gt.0.99e30) then
y2(1)=0.
u(1)=0.
else
y2(1)=-0.5
u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
endif
do 11 i=2,n-1
sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
p=sig*y2(i-1)+2.
y2(i)=(sig-1.)/p
u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
& /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
11 continue
if (ypn.gt.0.99e30) then
qn=0.
un=0.
else
qn=0.5
un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
endif
y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
do 12 k=n-1,1,-1
y2(k)=y2(k)*y2(k+1)+u(k)
12 continue
cccccccccccccccccccccccccccccccccccccccccccccc
c now for any arbitrary x
cccccccccccccccccccccccccccccccccccccccccccccc
do io = 1,no
klo=1
khi=n
1 if (khi-klo.gt.1) then
k=(khi+klo)/2.
if (x(k).gt.xo(io)) then
khi=k
else
klo=k
endif
goto 1
endif
h=x(khi)-x(klo)
if (h.eq.0.) pause 'bad XA input'
a=(x(khi)-xo(io))/h
b=(xo(io)-x(klo))/h
yo(io)=a*y(klo)+b*y(khi)+
& (a*(a*a-1.)*y2(klo)+b*(b*b-1.)*y2(khi))*h*h/6.
enddo
c
return
end
subroutine spline(n,x,y,yp1,ypn,no,xo,yo)
cccccccccccccccccccccccccccccccccccccccccccccccccccc
c This subroutine will calculate the cubic-spline intepolated value of
c given any function for single variable of any dimension
c
c inputs/output:
c n : (input) [scalar] dimension of input array
c x : (input) [vector of length 'n'], independent variable of dimension 'n'
c y : (input)[vector of length 'n']' the function of x (an array of dimension 'n'
c yp1 : (input) [scalar] =1.e+30 :: the routine is signaled to set
c the corresponding boundary condition
c for a natural spline, with zero
c second derivative on that boundary
c ypn : (input) same to yp1 = 1.e+30
c no : (input) [scalar] dimension output array
c xo : (input) [vector of length 'no'], 'x' values at which you want to spline
c yo : (output) [vector of length 'no'], splined value
c
c Note: This works properly in any inter fortran compiler and f90-compiler
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Tanmoy Das.
c
c Feb 13, 2008.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
integer::n,no,io
real,dimension(1:n)::x,y,y2,u
real,dimension(1:no)::xo,yo
c
if (yp1.gt.0.99e30) then
y2(1)=0.
u(1)=0.
else
y2(1)=-0.5
u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
endif
do 11 i=2,n-1
sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
p=sig*y2(i-1)+2.
y2(i)=(sig-1.)/p
u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))
& /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
11 continue
if (ypn.gt.0.99e30) then
qn=0.
un=0.
else
qn=0.5
un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
endif
y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
do 12 k=n-1,1,-1
y2(k)=y2(k)*y2(k+1)+u(k)
12 continue
cccccccccccccccccccccccccccccccccccccccccccccc
c now for any arbitrary x
cccccccccccccccccccccccccccccccccccccccccccccc
do io = 1,no
klo=1
khi=n
1 if (khi-klo.gt.1) then
k=(khi+klo)/2.
if (x(k).gt.xo(io)) then
khi=k
else
klo=k
endif
goto 1
endif
h=x(khi)-x(klo)
if (h.eq.0.) pause 'bad XA input'
a=(x(khi)-xo(io))/h
b=(xo(io)-x(klo))/h
yo(io)=a*y(klo)+b*y(khi)+
& (a*(a*a-1.)*y2(klo)+b*(b*b-1.)*y2(khi))*h*h/6.
enddo
c
return
end
The main code to use mpi_distrbt
This is the example of the script you can insert in your main program to use mpi_istrbt.
max_ipara=bzq ! the maximum array dimension to be parallelized
if(MPImyid.eq.0)then ! do the distribution in main node only
write(6,*)' Master process #',MPImyid,' starting'
c
call mpi_distrbt(max_ipara,nummpiprocsm,
& MPInumprocs,ipara_ini_fin)
endif ! master processor selection
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
c
c THIS IS EXECUTED BY ALL (MASTER+SLAVE) PROCESSORS
c
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
write(6,*)' Slave process #',MPImyid,' starting'
c blocking receive of integer data
icount=2*MPInumprocs
iroot=0
call MPI_BCAST(ipara_ini_fin, icount, MPI_INTEGER, iroot,
& MPI_COMM_WORLD, ierr)
c call the serial version
ipara_ini=ipara_ini_fin(1,MPImyid)
ipara_fin=ipara_ini_fin(2,MPImyid)
write(6,*)'Slave #',MPImyid,
& ' computing from ipara ',ipara_ini,' to ',ipara_fin
max_ipara=bzq ! the maximum array dimension to be parallelized
if(MPImyid.eq.0)then ! do the distribution in main node only
write(6,*)' Master process #',MPImyid,' starting'
c
call mpi_distrbt(max_ipara,nummpiprocsm,
& MPInumprocs,ipara_ini_fin)
endif ! master processor selection
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
c
c THIS IS EXECUTED BY ALL (MASTER+SLAVE) PROCESSORS
c
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
write(6,*)' Slave process #',MPImyid,' starting'
c blocking receive of integer data
icount=2*MPInumprocs
iroot=0
call MPI_BCAST(ipara_ini_fin, icount, MPI_INTEGER, iroot,
& MPI_COMM_WORLD, ierr)
c call the serial version
ipara_ini=ipara_ini_fin(1,MPImyid)
ipara_fin=ipara_ini_fin(2,MPImyid)
write(6,*)'Slave #',MPImyid,
& ' computing from ipara ',ipara_ini,' to ',ipara_fin
Monday, February 25, 2008
Fortran paraller programming : job distributor to several processors
subroutine mpi_distrbt(max_ipara,nummpiprocsm,
& MPInumprocs,ipara_ini_fin)
ccccccccccccccccccccccccccccccc
cc This subroutine helps to distribute your total no of array dimension into the total number of
cc avaiable processor.
cc max_ipara = array dimension
cc nummpiprocsm = maximum number of processor available in the cluster
cc MPInumprocs = Number of processors you are using
cc ipara_ini_fin = output: real, dimension (1:2,1:MPImyid), where MPImyid is the identification number for
cc the processor
cc
cc A typical code to demonstrate how to use this is given in the blog.
cc
cc ALL COPYRIGHT IS RESERVED by Tanmoy Das.
cc Created in 2006/2007.
cc
cc I thank Seppo Sharakorpi for creating the basic structure and the algorithm of this code.
cc
ccccccccccccccccccccccc
real :: dummy
integer :: nummpiprocsm,max_ipara
integer,dimension(0:nummpiprocsm) :: isendcounts
integer,dimension(1:2,0:nummpiprocsm) :: ipara_ini_fin
c
C THESE ARE THE START AND FINISH VALUES OF OLD LOOP, NOW PARALLELIZED
c
ipara_ini_tot=1
ipara_fin_tot=max_ipara
write(6,*)
write(6,*)' ipara ranging from ',
& ipara_ini_tot,' to ',ipara_fin_tot
write(6,*)
c broadcast tasks to slaves
nummpitask_tot=ipara_fin_tot-ipara_ini_tot+1
cc
write(6,*)'---------------------------------------------------'
write(6,*) 'MPI MASTER: Scattering total of ',nummpitask_tot,' tasks'
write(6,*)'---------------------------------------------------'
cc
if ( nummpitask_tot < style="color: rgb(255, 153, 255);">then
write(6,*)' SERIOUS ERROR:: nummpitask_tot <>'
write(6,*) ipara_ini_tot, ipara_fin_tot, MPInumprocs
endif
cc
dummy=nummpitask_tot/MPInumprocs
islavetasks=floor(dummy)+1
isendcounts(0)=nummpitask_tot-(MPInumprocs-1)*islavetasks
cc
if ( isendcounts(0) > 0 ) then
ipara_ini_fin(1,0)=ipara_ini_tot
ipara_ini_fin(2,0)=ipara_ini_tot+isendcounts(0)-1
cc
do ii=1,(MPInumprocs-1)
isendcounts(ii)=islavetasks
ipara_ini_fin(1,ii)=ipara_ini_fin(2,ii-1)+1
ipara_ini_fin(2,ii)=ipara_ini_fin(1,ii)+isendcounts(ii)-1
end do
cc
write(6,*) isendcounts(0),' tasks for the master'
write(6,*) isendcounts(1),' tasks for each of the ',
& (MPInumprocs-1),' slaves'
write(6,*)
else
c if number of tasks is only slightly larger than MPInumprocs
islavetasks=floor(dummy)
isendcounts(0)=islavetasks
ipara_ini_fin(1,0)=ipara_ini_tot
ipara_ini_fin(2,0)=ipara_ini_tot+isendcounts(0)-1
idummy=nummpitask_tot-(MPInumprocs)*islavetasks
cc
do ii=1,(MPInumprocs-1)
isendcounts(ii)=islavetasks
cc
if ( ii <= idummy ) then isendcounts(ii)=isendcounts(ii)+1 end if
cc
ipara_ini_fin(1,ii)=ipara_ini_fin(2,ii-1)+1
ipara_ini_fin(2,ii)=ipara_ini_fin(1,ii)+isendcounts(ii)-1
end do
cc
write(6,*) isendcounts(0),' tasks for the master,'
write(6,*)isendcounts(1),' tasks for each of the first',
& idummy,' slaves and'
write(6,*)isendcounts(idummy+1),
& ' tasks for each of the other',
& (MPInumprocs-1)-idummy,' slaves'
write(6,*)
end if
cc
return
end subroutine
& MPInumprocs,ipara_ini_fin)
ccccccccccccccccccccccccccccccc
cc This subroutine helps to distribute your total no of array dimension into the total number of
cc avaiable processor.
cc max_ipara = array dimension
cc nummpiprocsm = maximum number of processor available in the cluster
cc MPInumprocs = Number of processors you are using
cc ipara_ini_fin = output: real, dimension (1:2,1:MPImyid), where MPImyid is the identification number for
cc the processor
cc
cc A typical code to demonstrate how to use this is given in the blog.
cc
cc ALL COPYRIGHT IS RESERVED by Tanmoy Das.
cc Created in 2006/2007.
cc
cc I thank Seppo Sharakorpi for creating the basic structure and the algorithm of this code.
cc
ccccccccccccccccccccccc
real :: dummy
integer :: nummpiprocsm,max_ipara
integer,dimension(0:nummpiprocsm) :: isendcounts
integer,dimension(1:2,0:nummpiprocsm) :: ipara_ini_fin
c
C THESE ARE THE START AND FINISH VALUES OF OLD LOOP, NOW PARALLELIZED
c
ipara_ini_tot=1
ipara_fin_tot=max_ipara
write(6,*)
write(6,*)' ipara ranging from ',
& ipara_ini_tot,' to ',ipara_fin_tot
write(6,*)
c broadcast tasks to slaves
nummpitask_tot=ipara_fin_tot-ipara_ini_tot+1
cc
write(6,*)'---------------------------------------------------'
write(6,*) 'MPI MASTER: Scattering total of ',nummpitask_tot,' tasks'
write(6,*)'---------------------------------------------------'
cc
if ( nummpitask_tot < style="color: rgb(255, 153, 255);">then
write(6,*)' SERIOUS ERROR:: nummpitask_tot <>'
write(6,*) ipara_ini_tot, ipara_fin_tot, MPInumprocs
endif
cc
dummy=nummpitask_tot/MPInumprocs
islavetasks=floor(dummy)+1
isendcounts(0)=nummpitask_tot-(MPInumprocs-1)*islavetasks
cc
if ( isendcounts(0) > 0 ) then
ipara_ini_fin(1,0)=ipara_ini_tot
ipara_ini_fin(2,0)=ipara_ini_tot+isendcounts(0)-1
cc
do ii=1,(MPInumprocs-1)
isendcounts(ii)=islavetasks
ipara_ini_fin(1,ii)=ipara_ini_fin(2,ii-1)+1
ipara_ini_fin(2,ii)=ipara_ini_fin(1,ii)+isendcounts(ii)-1
end do
cc
write(6,*) isendcounts(0),' tasks for the master'
write(6,*) isendcounts(1),' tasks for each of the ',
& (MPInumprocs-1),' slaves'
write(6,*)
else
c if number of tasks is only slightly larger than MPInumprocs
islavetasks=floor(dummy)
isendcounts(0)=islavetasks
ipara_ini_fin(1,0)=ipara_ini_tot
ipara_ini_fin(2,0)=ipara_ini_tot+isendcounts(0)-1
idummy=nummpitask_tot-(MPInumprocs)*islavetasks
cc
do ii=1,(MPInumprocs-1)
isendcounts(ii)=islavetasks
cc
if ( ii <= idummy ) then isendcounts(ii)=isendcounts(ii)+1 end if
cc
ipara_ini_fin(1,ii)=ipara_ini_fin(2,ii-1)+1
ipara_ini_fin(2,ii)=ipara_ini_fin(1,ii)+isendcounts(ii)-1
end do
cc
write(6,*) isendcounts(0),' tasks for the master,'
write(6,*)isendcounts(1),' tasks for each of the first',
& idummy,' slaves and'
write(6,*)isendcounts(idummy+1),
& ' tasks for each of the other',
& (MPInumprocs-1)-idummy,' slaves'
write(6,*)
end if
cc
return
end subroutine
Subscribe to:
Posts (Atom)