#include "fintrf.h"

!INCLUDE 'link_fnl_shared_hpc.h'    
!INCLUDE 'link_fnl_shared.h'    
INCLUDE 'link_fnl_static_hpc.h'    

module ML
    use kernel32, only: outputdebugstring
	implicit none 
	
	private
	public	storeML, printML, outML, VSprint, openML, getML, execinML
      
    interface getML
        module procedure getML_m, getML_v
	end interface

	interface storeML
        module procedure storeML_m, storeML_v
    end interface

    interface printML
        module procedure s_and_pML_m, s_and_pML_v
    end interface

    interface outML
        module procedure printML_m, printML_v
    end interface

    mwPointer, private :: ep
     
contains
      
	subroutine VSprint(string)
		character(*) string 
		integer status
        mwPointer mexPrintf
        
!		write (*,'(a)',advance='no'),trim(string)
		
		status=mexPrintf(trim(string)//"\n"C)
		call outputdebugstring(trim(string)//"\n"C)
  
	end subroutine

    subroutine openML()
        mwPointer engOpen
        ep = engOpen('matlab ')

        if (ep .eq. 0) then
            write(6,*) 'Can''t start MATLAB engine'
            stop
        endif
		call engEvalString(ep,"enableservice('AutomationServer',true)")
        call execinML('format shortg')
    end subroutine
      
    subroutine execinML(cmdstring)
 		character(len=*) cmdstring
		integer status, engEvalString
		status=engEvalString(ep,cmdstring)
	end subroutine

	subroutine getML_m(mat,name)
		implicit none
		real   mat(:,:)
        real*8 mat8(size(mat,1),size(mat,2))
        character(len=*) name
        mwPointer matp, mxGetPr, mxGetM, mxGetN, engGetVariable
        mwSize m1,m2

		matp=engGetVariable(ep,name)
		if (matp == 0) then 
            write(6,*) 'engGetVariable failed'
            stop
        endif
  		m1=mxGetM(matp)
        m2=mxGetN(matp)
        call mxCopyPtrToReal8(mxGetPr(matp),mat8, m1*m2)
		call mxDestroyArray(matp)
		mat=mat8
	end subroutine

	subroutine getML_v(mat,name)
		implicit none
		real   mat(:)
        real*8 mat8(size(mat,1),1)
        character(len=*) name
        mwPointer matp, mxGetPr, mxGetM, mxGetN, engGetVariable
        mwSize m1,m2

		matp=engGetVariable(ep,name)
		if (matp == 0) then 
            write(6,*) 'engGetVariable failed'
            stop
        endif
  		m1=mxGetM(matp)
        m2=mxGetN(matp)
        call mxCopyPtrToReal8(mxGetPr(matp),mat8, m1*m2)
		call mxDestroyArray(matp)
		mat=mat8(:,1)
	end subroutine

	subroutine storeML_m(mat,name)
        real*8 mat(:,:)
        character(len=*) name
        integer status, engPutVariable
        mwPointer matp, mxCreateDoubleMatrix, mxGetPr
        mwSize m1,m2

        m1=size(mat,1)
        m2=size(mat,2)

        matp = mxCreateDoubleMatrix(m1,m2, 0)
		if (matp == 0) then 
            write(6,*) 'CreateDoubleMatrix failed'
            stop
        endif
        call mxCopyReal8ToPtr(dble(mat), mxGetPr(matp), m1*m2)
        status = engPutVariable(ep, trim(adjustl(name)), matp)
          
        if (status .ne. 0) then 
            write(6,*) 'engPutVariable failed'
            stop
        endif
        call mxDestroyArray(matp)
    end subroutine

    subroutine s_and_pML_m(mat,name)
        real*8 mat(:,:)
        character(len=*) name
        character(len=10000) outstring
        integer status
        mwPointer engEvalString, engOutputBuffer
        
        call storeML_m(mat,name)
        status=engOutputBuffer(ep,outstring)
        status=engEvalString(ep,'display('//trim(adjustl(name))//')')
        call VSprint(trim(outstring))
	end subroutine

    subroutine printML_m(mat)
        real*8 mat(:,:)
        character(len=10000) outstring
        integer status
        mwPointer engEvalString, engOutputBuffer
        
        call storeML_m(mat,'out')
        status=engOutputBuffer(ep,outstring)
        status=engEvalString(ep,'disp('//'out'//')')
        call VSprint(trim(outstring))
	end subroutine
      
    subroutine storeML_v(vec,name)
        character(len=*) name
        real*8 vec(:)
        real*8 mat(1,size(vec))
        
        mat(1,:)=vec
        call storeML_m(mat,name)
    end subroutine

    subroutine s_and_pML_v(vec,name)
        character(len=*) name
        real*8 vec(:)
        real*8 mat(1,size(vec))
        
        mat(1,:)=vec
        call s_and_pML_m(mat,name)
    end subroutine

    subroutine printML_v(vec)
        real*8 vec(:)
        real*8 mat(1,size(vec))
        
        mat(1,:)=vec
        call printML_m(mat)
	end subroutine
end	

