besselh_make.m

来自「student teacher and proferssor llove thi」· M 代码 · 共 430 行 · 第 1/2 页

 kernel=[kernel,'         if (in_1_n==1) then',r];
 kernel=[kernel,'          if (in_2_m==1) then',r];
 kernel=[kernel,'           if (in_2_n==1) then ! scalar x scalar',r];
 kernel=[kernel,'            allocate(out(1,1))',r];
 kernel=[kernel,'            if (mat1(1,1)>=0) then',r];
 kernel=[kernel,'             call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                  mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'             out(1,1)=cmplx(a,b)',r];
 kernel=[kernel,'            else',r];
 kernel=[kernel,'             call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                  -mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'             out(1,1)=cmplx(a,b)*exp((3-2*htype)*(-mat1(1,1))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'            endif',r];
 kernel=[kernel,'           else                ! scalar x row',r];
 kernel=[kernel,'            allocate(out(1,in_2_n))',r];
 kernel=[kernel,'            do i=1,in_2_n',r];
 kernel=[kernel,'             if (mat1(1,1)>=0) then',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,i)),aimag(mat2(1,i)),',r];
 kernel=[kernel,'     &                   mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(1,i)=cmplx(a,b)',r];
 kernel=[kernel,'             else',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,i)),aimag(mat2(1,i)),',r];
 kernel=[kernel,'     &                   -mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(1,i)=cmplx(a,b)*exp((3-2*htype)*(-mat1(1,1))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'             endif',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          else',r];
 kernel=[kernel,'           if (in_2_n==1) then ! scalar x column',r];
 kernel=[kernel,'            allocate(out(in_2_m,1))',r];
 kernel=[kernel,'            do i=1,in_2_m',r];
 kernel=[kernel,'             if (mat1(1,1)>=0) then',r];
 kernel=[kernel,'              call zbesh(real(mat2(i,1)),aimag(mat2(i,1)),',r];
 kernel=[kernel,'     &                   mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(i,1)=cmplx(a,b)',r];
 kernel=[kernel,'             else',r];
 kernel=[kernel,'              call zbesh(real(mat2(i,1)),aimag(mat2(i,1)),',r];
 kernel=[kernel,'     &                   -mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(i,1)=cmplx(a,b)*exp((3-2*htype)*(-mat1(1,1))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'             endif',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           else                ! scalar x matrix',r];
 kernel=[kernel,'            allocate(out(in_2_m,in_2_n))',r];
 kernel=[kernel,'            do i=1,in_2_m',r];
 kernel=[kernel,'             do j=1,in_2_n',r];
 kernel=[kernel,'              if (mat1(1,1)>=0) then',r];
 kernel=[kernel,'               call zbesh(real(mat2(i,j)),aimag(mat2(i,j)),',r];
 kernel=[kernel,'     &                    mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)',r];
 kernel=[kernel,'              else',r];
 kernel=[kernel,'               call zbesh(real(mat2(i,j)),aimag(mat2(i,j)),',r];
 kernel=[kernel,'     &                    -mat1(1,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)*exp((3-2*htype)*(-mat1(1,1))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'              endif',r];
 kernel=[kernel,'             enddo',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          endif',r];
 kernel=[kernel,'         else',r];
 kernel=[kernel,'          if (in_2_m==1) then',r];
 kernel=[kernel,'           if (in_2_n==1) then ! row x scalar',r];
 kernel=[kernel,'            allocate(out(1,in_1_n))',r];
 kernel=[kernel,'            do i=1,in_1_n',r];
 kernel=[kernel,'             if (mat1(1,i)>=0) then',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                   mat1(1,i),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(1,i)=cmplx(a,b)',r];
 kernel=[kernel,'             else',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                   -mat1(1,i),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(1,i)=cmplx(a,b)*exp((3-2*htype)*(-mat1(1,i))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'             endif',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           else                ! row x row',r];
 kernel=[kernel,'            allocate(out(1,in_1_n))',r];
 kernel=[kernel,'            do i=1,in_1_n',r];
 kernel=[kernel,'             if (mat1(1,i)>=0) then',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,i)),aimag(mat2(1,i)),',r];
 kernel=[kernel,'     &                   mat1(1,i),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(1,i)=cmplx(a,b)',r];
 kernel=[kernel,'             else',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,i)),aimag(mat2(1,i)),',r];
 kernel=[kernel,'     &                   -mat1(1,i),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(1,i)=cmplx(a,b)*exp((3-2*htype)*(-mat1(1,i))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'             endif',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          else',r];
 kernel=[kernel,'           if (in_2_n==1) then ! row x column',r];
 kernel=[kernel,'            allocate(out(in_2_m,in_1_n))',r];
 kernel=[kernel,'            do i=1,in_2_m',r];
 kernel=[kernel,'             do j=1,in_1_n',r];
 kernel=[kernel,'              if (mat1(1,j)>=0) then',r];
 kernel=[kernel,'               call zbesh(real(mat2(i,1)),aimag(mat2(i,1)),',r];
 kernel=[kernel,'     &                    mat1(1,j),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)',r];
 kernel=[kernel,'              else',r];
 kernel=[kernel,'               call zbesh(real(mat2(i,1)),aimag(mat2(i,1)),',r];
 kernel=[kernel,'     &                    -mat1(1,j),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)*exp((3-2*htype)*(-mat1(1,j))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'              endif',r];
 kernel=[kernel,'             enddo',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           else                ! row x matrix',r];
 kernel=[kernel,'            ! error',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          endif',r];
 kernel=[kernel,'         endif',r];
 kernel=[kernel,'        else',r];
 kernel=[kernel,'         if (in_1_n==1) then',r];
 kernel=[kernel,'          if (in_2_m==1) then',r];
 kernel=[kernel,'           if (in_2_n==1) then ! column x scalar',r];
 kernel=[kernel,'            allocate(out(in_2_m,1))',r];
 kernel=[kernel,'            do i=1,in_2_m',r];
 kernel=[kernel,'             if (mat1(i,1)>=0) then',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                   mat1(i,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(i,1)=cmplx(a,b)',r];
 kernel=[kernel,'             else',r];
 kernel=[kernel,'              call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                   -mat1(i,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(i,1)=cmplx(a,b)*exp((3-2*htype)*(-mat1(i,1))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'             endif',r];
 kernel=[kernel,'            enddo',r]; 
 kernel=[kernel,'           else                ! column x row',r];
 kernel=[kernel,'            allocate(out(in_1_m,in_2_n))',r];
 kernel=[kernel,'            do i=1,in_1_m',r];
 kernel=[kernel,'             do j=1,in_2_n',r];
 kernel=[kernel,'              if (mat1(i,1)>=0) then',r];
 kernel=[kernel,'               call zbesh(real(mat2(1,j)),aimag(mat2(1,j)),',r];
 kernel=[kernel,'     &                    mat1(i,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)',r];
 kernel=[kernel,'              else',r];
 kernel=[kernel,'               call zbesh(real(mat2(1,j)),aimag(mat2(1,j)),',r];
 kernel=[kernel,'     &                    -mat1(i,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)*exp((3-2*htype)*(-mat1(i,1))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'              endif',r];
 kernel=[kernel,'             enddo',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          else',r];
 kernel=[kernel,'           if (in_1_n==1) then ! column x column',r];
 kernel=[kernel,'            allocate(out(in_1_m,1))',r];
 kernel=[kernel,'            do i=1,in_1_m',r];
 kernel=[kernel,'             if (mat1(i,1)>=0) then',r];
 kernel=[kernel,'              call zbesh(real(mat2(i,1)),aimag(mat2(i,1)),',r];
 kernel=[kernel,'     &                   mat1(i,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(i,1)=cmplx(a,b)',r];
 kernel=[kernel,'             else',r];
 kernel=[kernel,'              call zbesh(real(mat2(i,1)),aimag(mat2(i,1)),',r];
 kernel=[kernel,'     &                   -mat1(i,1),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'              out(i,1)=cmplx(a,b)*exp((3-2*htype)*(-mat1(i,1))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'             endif',r];
 kernel=[kernel,'            enddo',r]; 
 kernel=[kernel,'           else                ! column x matrix',r];
 kernel=[kernel,'            ! error',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          endif',r];
 kernel=[kernel,'         else',r];
 kernel=[kernel,'          if (in_2_m==1) then',r];
 kernel=[kernel,'           if (in_2_n==1) then ! matrix x scalar',r];
 kernel=[kernel,'            allocate(out(in_1_m,in_1_n))',r];
 kernel=[kernel,'            do i=1,in_1_m',r];
 kernel=[kernel,'             do j=1,in_1_n',r];
 kernel=[kernel,'              if (mat1(i,j)>=0) then',r];
 kernel=[kernel,'               call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                    mat1(i,j),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)',r];
 kernel=[kernel,'              else',r];
 kernel=[kernel,'               call zbesh(real(mat2(1,1)),aimag(mat2(1,1)),',r];
 kernel=[kernel,'     &                    -mat1(i,j),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)*exp((3-2*htype)*(-mat1(i,j))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'              endif',r];
 kernel=[kernel,'             enddo',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           else                ! matrix x row',r];
 kernel=[kernel,'            ! error',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          else',r];
 kernel=[kernel,'           if (in_2_n==1) then ! matrix x column',r];
 kernel=[kernel,'            ! error',r];
 kernel=[kernel,'           else                ! matrix x matrix',r];
 kernel=[kernel,'            allocate(out(in_1_m,in_1_n))',r];
 kernel=[kernel,'            do i=1,in_1_m',r];
 kernel=[kernel,'             do j=1,in_1_n',r];
 kernel=[kernel,'              if (mat1(i,j)>=0) then',r];
 kernel=[kernel,'               call zbesh(real(mat2(i,j)),aimag(mat2(i,j)),',r];
 kernel=[kernel,'     &                    mat1(i,j),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)',r];
 kernel=[kernel,'              else',r];
 kernel=[kernel,'               call zbesh(real(mat2(i,j)),aimag(mat2(i,j)),',r];
 kernel=[kernel,'     &                    -mat1(i,j),dim,htype,1,a,b,info,ierr)',r];
 kernel=[kernel,'               out(i,j)=cmplx(a,b)*exp((3-2*htype)*(-mat1(i,j))*pi*cmplx(0.0,1.0))',r];
 kernel=[kernel,'              endif',r];
 kernel=[kernel,'             enddo',r];
 kernel=[kernel,'            enddo',r];
 kernel=[kernel,'           endif',r];
 kernel=[kernel,'          endif',r];
 kernel=[kernel,'         endif',r];
 kernel=[kernel,'        endif',r];
 
  funlist=[funlist,kernel];
 
 %End of the function %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 funlist=[funlist,'       end subroutine ',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}=1;