#include "fintrf.h"

!INCLUDE 'link_fnl_shared_hpc.h'    
!INCLUDE 'link_fnl_shared.h' 
!!DEC$ OBJCOMMENT LIB:'libiomp5md.lib'

!INCLUDE 'link_fnl_static_hpc.h'    
	

module ML
!DIR$ NOOPTIMIZE
    use kernel32, only: outputdebugstring
	use myfuncs
	implicit none 
	
	private
	public	storeML, printML, outML, VSprint, openML, getML, execinML, savevecML, savematML
      
    interface getML
        module procedure getML_m, getML_v, getML_s
	end interface

	interface storeML
        module procedure storeML_m, storeML_v, storeML_m3
    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_s(mat,name)
		real   mat
        character(len=*) name
		real	matv(1)
		
		call getML_v(matv,name)
		mat=matv(1)
	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 storeML_m3(mat,name)
        real*8 mat(:,:,:)
        character(len=*) name
        integer status, engPutVariable
        mwPointer matp, mxCreateNumericArray, mxGetPr
        mwSize,parameter	:: ndim=3
		mwSize				:: dims(ndim),ms
		integer*4			:: classid=6, ComplexFlag=0
		
		dims=shape(mat)
        matp =  mxCreateNumericArray(ndim, dims, classid, ComplexFlag)
		if (matp == 0) then 
            write(6,*) 'CreateNumericArray failed'
            stop
        endif
		ms=size(mat)
        call mxCopyReal8ToPtr(dble(mat), mxGetPr(matp), ms)
        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
	
   subroutine savematML(filename,mat)
        character(len=*):: filename
        real            :: mat(:,:)
		
   		call storeML(mat,"mat")
		call execinML("save('"//filename//".mat','mat')")
        call savemat(filename//".txt",mat)
    end subroutine
    
    subroutine savevecML(filename,vec)
        character(len=*):: filename
        real            :: vec(:),mat(size(vec),1)

        mat(:,1)=vec
		print *,"now saving"//filename
        call savematML(filename,mat)
	end subroutine

end	

