program testls c c Test program for subroutines LOADMAT and SAVEMAT. These routines are c used to read and write files in the MAT-file format. c c For this test, create several matrices in the MATLAB workspace and save c them to the file MATLAB.MAT using the MATLAB SAVE command. Next, exit c MATLAB and run this test program. This program, TESTLS, will read c MATLAB.MAT and write a file called FORTRAN.MAT with the same matrices. c After running this test program invoke MATLAB again, load FORTRAN.MAT using c the LOAD command, and verify that the matrices loaded are the same as those c originally saved to MATLAB.MAT. c c Author: S.N. Bangert 5-31-85 c Revised 5-27-86 SNB c c character array used to hold the MATLAB variable names (max name c length is 20) character name(20) c c header data and read/write flag from loadmat and savemat integer m, n, type, namlen, imagf, rwflg c c arrays used to hold real and imaginary parts of data (dimensioned to c hold the largest expected matrix) double precision rpart(1000), ipart(1000) c integer irecr, irecw c data irecr, irecw / 1, 1 / write(6,1111) 1111 format(' ','test output') c c open(unit=1,file='matlab.mat',status='old',form='unformatted', $ access='direct', recl=1) open(unit=2,file='fortran.mat',status='new',form='unformatted', $ access='direct', recl=1) c c Each call to loadmat reads the next matrix on the file until there c are no more matrices to be read or there is an error. c 10 call loadmat(type,m,n,imagf,namlen,name,rpart,ipart, $ 1,irecr,rwflg) c write(*,*) 'rwflg from loadmat = ',rwflg c c A successful read is indicated by rwflg = 0 c if ( rwflg .eq. 0 ) then c c temporary write test of matrix mntemp=m*n do 6001 i=1,mntemp 6001 write(*,*)rpart(i) write(*,6000) type,m,n,imagf,namlen, $ (name(i),i=1,namlen) 6000 format(/1x,'type = ',i3,4x,'m = ',i3,4x,'n = ',i3,4x, $ 'imagf =',i2/1x,'namlen = ',i2,4x,'name = ',20a1///) c c Write the matrix to fortran.mat c call savemat(type,m,n,imagf,namlen,name,rpart,ipart, $ 2,irecw,rwflg) c if ( rwflg .eq. 0 ) go to 10 c write(*,*) 'Write error' end if c close(1) close(2) c end