diag_make.m

student teacher and proferssor llove this project,this a very important exmple

function [modlist,funlist,fun_info]=diag_make(typestrlist)
% fun_info is a 1x2 cell. fun_info{1}=>1 result is pointer, 0=>not
%                         fun_info{2}=>typestr ('r' or 'c' usually)
declare_globals
funname='diag';
modlist='';funlist='';
r=[char(10)];
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
modlist=[modlist,...
	 '       interface ',funname,'f',r];
if ~iscell(typestrlist)
 typestrlist={typestrlist};
end
for i=1:length(typestrlist)
 typestr=typestrlist{i};
 temp1='';
 for k=1:length(typestr)
  if ~isempty(find(strcmp(typestr(k),barr)))
   [a(k),b(k)]=find(strcmp(typestr(k),barr)); b2(k)=0;
  else
   [a(k),b(k)]=find(strcmp(typestr(k),barr2));b2(k)=1;
  end
 end
 if a(1)==1, temp1='complex'; elseif a(1)==2, temp1='real'; else temp1='integer'; end
 for m=1:length(typestr)
  temp=any(strcmp(typestr(m),{'d','m'})); if temp,typestr(m)='x';end
  temp=any(strcmp(typestr(m),{'e','n'})); if temp,typestr(m)='w';end
  temp=any(strcmp(typestr(m),{'f','o'})); if temp,typestr(m)='y';end
  temp=any(strcmp(typestr(m),{'g','p'})); if temp,typestr(m)='z';end
 end 
 %The 1 at the end lets me make a 1-D input version.
 [modlist,funlist,len]=makeheader('diag',2,typestr,modlist,funlist,r,1);
 if ~any(strcmp(typestr(1),typs{5})) %scalar
  temp2='size(in_1)';  temp3='min(size(in_1,1),size(in_1,2))'; else temp2='1';temp3='1';
 end
 if length(typestr)==2
  if ~any(strcmp(typestr(2),typs{7})) %scalar
   temp4{1}='int(';  temp4{2}=')';  else   temp4{1}='';  temp4{2}='';
  end
 end
 if any(strcmp(typestr(1),typs{1})) %Full 2-D matrix, result is col
  if length(typestr)==1
   funlist=[funlist,'       integer, parameter :: in_2=0',r];
   funlist=[funlist,'       ',temp1,', dimension(',temp3,',1) :: out',r];
   fun_info{2}=barr2{a(1),2}; %col of same type result
  else
   funlist=[funlist,'       ',temp1,', dimension(',temp3,'-max(0,abs(in_2)-max(0,(size(in_1,2)-size(in_1,1))*in_2/abs(in_2))),1) :: out',r];
   fun_info{2}=barr2{a(1),2}; %col of same type result
  end
 else
  if length(typestr)==1
   funlist=[funlist,'       integer, parameter :: in_2=0',r];
   funlist=[funlist,'       ',temp1,', dimension(',temp2,',',temp2,') :: out',r];
   fun_info{2}=barr{a(1),1};
  else
   funlist=[funlist,'       ',temp1,', dimension(',temp2,'+abs(',temp4{1},'in_2',temp4{2},'),',temp2,'+abs(',temp4{1},'in_2',temp4{2},')) :: out',r];
   fun_info{2}=barr{a(1),1};   
  end
 end  
 
 %Here we can insert any global vars or preliminary options %%%%%%
 if any(strcmp(typestr(1),typs{1}))
  funlist=[funlist,'       integer c',r];
 end

 wantsizes=1;
 funlist=makesize1(wantsizes,funlist,len,r);
 funlist=makesize2(wantsizes,funlist,len,r,typestr);
 
 %Here we can insert type dependant things %%%%%%%%%%%%%%%%%%%%%%%
 %And now the kernel %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 kernel=[''];
 if any(strcmp(typestr(1),typs{1})) %Full 2-D matrix, result is col
  kernel=[kernel,'        if (in_2/=0) then',r];
  kernel=[kernel,'         c=',temp3,'-max(0,abs(in_2)-max(0,(size(in_1,2)-size(in_1,1))*in_2/abs(in_2)))',r];
  kernel=[kernel,'        else',r];
  kernel=[kernel,'         c=',temp3,'-max(0,abs(in_2))',r];
  kernel=[kernel,'        endif',r];
  kernel=[kernel,'        do i=1,c',r];
  kernel=[kernel,'         if (in_2>=0) then !k>=0',r];
  kernel=[kernel,'          out(i,1)=in_1(i,i+in_2)',r];
  kernel=[kernel,'         else             !k<0',r];
  kernel=[kernel,'          out(i,1)=in_1(i-in_2,i)',r];
  kernel=[kernel,'         endif',r];
  kernel=[kernel,'        enddo',r];
 else
  kernel=[kernel,'        out=0',r];
  kernel=[kernel,'        do i=1,in_1_n',r];
  kernel=[kernel,'         if (in_2>=0) then',r];
  kernel=[kernel,'          out(i,i+in_2)=in_1(i)',r];
  kernel=[kernel,'         else      !k<0',r];
  kernel=[kernel,'          out(i-in_2,i)=in_1(i)',r];
  kernel=[kernel,'         endif',r];
  kernel=[kernel,'        enddo',r];
 end
 funlist=[funlist,kernel];
 
 %End of the function %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 funlist=[funlist,'       end function ',funname,'f_',typestr,r];
 if strcmp(typestr,typestrlist{length(typestrlist)})
 else
  funlist=[funlist,r];
 end
end
%And end the module %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
modlist=[modlist...
	 '       end interface ',funname,'f',char(10)];
fun_info{1}=0;