matdata.f90

三维FDTD,matlal编程,mur边界条件,平面波光源

! --------------------------------------------------------------------------
! - This module is used to read and write variables from and into Matlab   -
! - .mat format data file, which require linked with                       -
! - libmat.lib, libmat.dll, libmx.lib, libmx.dll and libut.dll             -
! - All these libraries are supported by Mathworks.inc Matlab 13           -
! -                                                                        -
! - Copyright (c) 2003-2004 by Dr. Chen Xianyao                            -
! - Key Lab. of Marine Science and Numerical Modelling                     -
! - First Institute of Oceanography                                        -
! - E-mail: [e-mail], [e-mail]                    -
! -                                                                        -
! - All Rights Reserved.                                                   -
! - Disclosure without explicit written consent from the copyright owner   -
! - does not constitute publication.                                       -
! -                                                                        -
! - Matlab is one of products of Mathworks inc.                            -
! --------------------------------------------------------------------------
module MatData
implicit none

integer(kind=4), private :: mp, pa
integer, private :: sta

!interface write
!  module procedure  Put_Int2_0, Put_Int4_0, Put_Real4_0, Put_Real8_0, Put_Char_0, &
!                    Put_Int2_1, Put_Int4_1, Put_Real4_1, Put_Real8_1, Put_Char_1, &
!                    Put_Int2_2, Put_Int4_2, Put_Real4_2, Put_Real8_2,             &
!                    Put_Int2_3, Put_Int4_3, Put_Real4_3, Put_Real8_3,             &
!                    Put_Int2_4, Put_Int4_4, Put_Real4_4, Put_Real8_4             
!end interface

interface matwrite
  module procedure  Put_Int2_0, Put_Int4_0, Put_Real4_0, Put_Real8_0, Put_Char_0, &
                    Put_Int2_1, Put_Int4_1, Put_Real4_1, Put_Real8_1, Put_Char_1, &
                    Put_Int2_2, Put_Int4_2, Put_Real4_2, Put_Real8_2,             &
                    Put_Int2_3, Put_Int4_3, Put_Real4_3, Put_Real8_3,             &
                    Put_Int2_4, Put_Int4_4, Put_Real4_4, Put_Real8_4             
end interface

!interface read
!  module procedure  Get_Int2_0, Get_Int4_0, Get_Real4_0, Get_Real8_0, Get_Char_0, &
!                    Get_Int2_1, Get_Int4_1, Get_Real4_1, Get_Real8_1, Get_Char_1, &
!                    Get_Int2_2, Get_Int4_2, Get_Real4_2, Get_Real8_2,             &
!                    Get_Int2_3, Get_Int4_3, Get_Real4_3, Get_Real8_3,             &
!                    Get_Int2_4, Get_Int4_4, Get_Real4_4, Get_Real8_4             
!end interface

interface matread
  module procedure  Get_Int2_0, Get_Int4_0, Get_Real4_0, Get_Real8_0, Get_Char_0, &
                    Get_Int2_1, Get_Int4_1, Get_Real4_1, Get_Real8_1, Get_Char_1, &
                    Get_Int2_2, Get_Int4_2, Get_Real4_2, Get_Real8_2,             &
                    Get_Int2_3, Get_Int4_3, Get_Real4_3, Get_Real8_3,             &
                    Get_Int2_4, Get_Int4_4, Get_Real4_4, Get_Real8_4             
end interface

contains
! --- convert string into lowercase
function lowercase(s1) result(s2)
  character(len=*), intent(in) :: s1
  character(len=len(s1)) :: s2
  integer :: id,ich
  do id = 1,len(s1)
    ich = ichar(s1(id:id))
    if (ich >= 65 .and. ich<=90) then
      s2(id:id) = char(ich+32)
    else
      s2(id:id) = s1(id:id)    
    endif
  enddo
end function lowercase

! --- CheckFileName
function CheckFileName(filename) result(s)
  character(len=*), intent(in) :: filename
  character(len=len(filename)+4) :: s
  integer :: L,Ls
  L = len(filename)
  if (L-3 <=0) then
    Ls = L
  else
    Ls = L-3
  endif
  if (lowercase(filename(Ls:L)) /= '.mat') then
    s = filename//'.mat'
  else	  
    s = filename
  endif
end function CheckFileName

! --- CheckAction
function CheckAction(flnm,actionin) result(TrueAction)
  character(len=*), intent(in) :: flnm
  character(len=1), intent(in) :: actionin
  character(len=1) :: TrueAction
  logical :: ext
  
  TrueAction = lowercase(actionin)
  Inquire(file=flnm,exist=ext)
  if (TrueAction == 'a') then
    if (ext) then
      TrueAction = 'u'; return
    else
      TrueAction = 'w'; return
    endif
  endif
  if (TrueAction == 'r' .and. (.not. ext) ) then
    TrueAction = ''; return
  endif    
end function CheckAction

! --- Integer(kind=2) 
subroutine Put_Int2_0(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  integer(kind=2), intent(in)  :: var
  character(len=1), intent(in), optional :: action

  character(len=len(filename)+4) :: flnm
  character(len=1) :: actionin,TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer :: matClose, matPutVariable
  
  integer(kind=4) :: mxGetPr,mxClassIDFromClassName,mxCreateNumericMatrix
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  
  ! --- check file I/O action
  actionin = 'a'
  if (present(action)) actionin = action
  TrueAction = CheckAction(flnm,actionin)
  
  ! --- Open .mat file
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Create variable
  pa = mxCreateNumericMatrix(1,1,mxClassIDFromClassName('int16'),0)
  ! --- Copy data to variable
  call mxCopyInteger2toPtr(var,mxGetPr(pa),1)
  ! --- Put variable into .mat file with given name
  sta = matPutVariable(mp,varname,pa)
  if (sta /= 0) then
    write(*,'("Fail to write data ",a," to .mat file ",a)')varname,trim(flnm)
  endif
  sta = matClose(mp)  
  if (sta /= 0) then
    write(*,'("Fail to close .mat file ",a)')trim(flnm)
  endif
  ! --- DestroyArray, Clean Memory
  call mxDestroyArray(pa)
end subroutine Put_Int2_0


! --- Integer(kind=4) 
subroutine Put_Int4_0(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  integer(kind=4), intent(in)  :: var
  character(len=1), intent(in), optional :: action

  character(len=len(filename)+4) :: flnm
  character(len=1) :: actionin, TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer :: matClose, matPutVariable
  
  integer(kind=4) :: mxGetPr,mxClassIDFromClassName,mxCreateNumericMatrix
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  actionin = 'a'
  if (present(action)) actionin = action
  TrueAction = CheckAction(flnm,actionin)
  ! --- Open .mat file
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Create variable
  pa = mxCreateNumericMatrix(1,1,mxClassIDFromClassName('int32'),0)
  ! --- Copy data to variable
  call mxCopyInteger4toPtr(var,mxGetPr(pa),1)
  ! --- Put variable into .mat file with given name
  sta = matPutVariable(mp,varname,pa)
  if (sta /= 0) then
    write(*,'("Fail to write data ",a," to .mat file ",a)')varname,trim(flnm)
  endif
  sta = matClose(mp)  
  if (sta /= 0) then    
    write(*,'("Fail to close .mat file ",a)')trim(flnm)
  endif
  ! --- DestroyArray, Clean Memory
  call mxDestroyArray(pa)
end subroutine Put_Int4_0

! --- real(kind=4) 
subroutine Put_Real4_0(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  real(kind=4), intent(in)  :: var
  character(len=1), intent(in), optional :: action

  character(len=len(filename)+4) :: flnm
  character(len=1) :: actionin, TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer :: matClose, matPutVariable
  
  integer(kind=4) :: mxGetPr,mxClassIDFromClassName,mxCreateNumericMatrix
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  actionin = 'a'
  if (present(action)) actionin = action
  TrueAction = CheckAction(flnm,actionin)
  ! --- Open .mat file
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Create variable
  pa = mxCreateNumericMatrix(1,1,mxClassIDFromClassName('single'),0)
  ! --- Copy data to variable
  call mxCopyReal4toPtr(var,mxGetPr(pa),1)
  ! --- Put variable into .mat file with given name
  sta = matPutVariable(mp,varname,pa)
  if (sta /= 0) then
    write(*,'("Fail to write data ",a," to .mat file ",a)')varname,trim(flnm)
  endif
  sta = matClose(mp)  
  if (sta /= 0) then    
    write(*,'("Fail to close .mat file ",a)')trim(flnm)
  endif
  ! --- DestroyArray, Clean Memory
  call mxDestroyArray(pa)
end subroutine Put_Real4_0

! --- real(kind=8) 
subroutine Put_Real8_0(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  real(kind=8), intent(in)  :: var
  character(len=1), intent(in), optional :: action

  character(len=len(filename)+4) :: flnm
  character(len=1) :: actionin, TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer :: matClose, matPutVariable
  
  integer(kind=4) :: mxGetPr,mxClassIDFromClassName,mxCreateNumericMatrix
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  actionin = 'a'
  if (present(action)) actionin = action
  TrueAction = CheckAction(flnm,actionin)
  ! --- Open .mat file
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Create variable
  pa = mxCreateNumericMatrix(1,1,mxClassIDFromClassName('double'),0)
  ! --- Copy data to variable
  call mxCopyReal8toPtr(var,mxGetPr(pa),1)
  ! --- Put variable into .mat file with given name
  sta = matPutVariable(mp,varname,pa)
  if (sta /= 0) then
    write(*,'("Fail to write data ",a," to .mat file ",a)')varname,trim(flnm)
  endif
  sta = matClose(mp)  
  if (sta /= 0) then    
    write(*,'("Fail to close .mat file ",a)')trim(flnm)
  endif
  ! --- DestroyArray, Clean Memory
  call mxDestroyArray(pa)
end subroutine Put_Real8_0

! --- Integer(kind=2), 1-dimensional array
subroutine Put_Int2_1(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  integer(kind=2), dimension(:), intent(in)  :: var
  character(len=1), intent(in), optional :: action

  character(len=len(filename)+4) :: flnm
  character(len=1) :: actionin, TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer :: matClose, matPutVariable
  
  integer(kind=4) :: mxGetPr,mxClassIDFromClassName,mxCreateNumericMatrix
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  actionin = 'a'
  if (present(action)) actionin = action
  TrueAction = CheckAction(flnm,actionin)
  ! --- Open .mat file
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Create variable
  pa = mxCreateNumericMatrix(1,size(var),mxClassIDFromClassName('int16'),0)
  ! --- Copy data to variable
  call mxCopyInteger2toPtr(var,mxGetPr(pa),size(var))
  ! --- Put variable into .mat file with given name
  sta = matPutVariable(mp,varname,pa)
  if (sta /= 0) then
    write(*,'("Fail to write data ",a," to .mat file ",a)')varname,trim(flnm)
  endif
  sta = matClose(mp)  
  if (sta /= 0) then    
    write(*,'("Fail to close .mat file ",a)')trim(flnm)
  endif
  ! --- DestroyArray, Clean Memory
  call mxDestroyArray(pa)
end subroutine Put_Int2_1

! --- Integer(kind=4), 1-dimensional array
subroutine Put_Int4_1(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  integer(kind=4), dimension(:), intent(in)  :: var
  character(len=1), intent(in), optional :: action

  character(len=len(filename)+4) :: flnm
  character(len=1) :: actionin, TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer :: matClose, matPutVariable
  
  integer(kind=4) :: mxGetPr,mxClassIDFromClassName,mxCreateNumericMatrix
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  actionin = 'a'
  if (present(action)) actionin = action
  TrueAction = CheckAction(flnm,actionin)
  ! --- Open .mat file
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Create variable
  pa = mxCreateNumericMatrix(1,size(var),mxClassIDFromClassName('int32'),0)
  ! --- Copy data to variable
  call mxCopyInteger4toPtr(var,mxGetPr(pa),size(var))
  ! --- Put variable into .mat file with given name
  sta = matPutVariable(mp,varname,pa)
  if (sta /= 0) then
    write(*,'("Fail to write data ",a," to .mat file ",a)')varname,trim(flnm)
  endif
  sta = matClose(mp)  
  if (sta /= 0) then    
    write(*,'("Fail to close .mat file ",a)')trim(flnm)
  endif
  ! --- DestroyArray, Clean Memory
  call mxDestroyArray(pa)
end subroutine Put_Int4_1

! --- real(kind=4), 1-dimensional array
subroutine Put_Real4_1(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  real(kind=4), dimension(:), intent(in)  :: var
  character(len=1), intent(in), optional :: action

  character(len=len(filename)+4) :: flnm
  character(len=1) :: actionin, TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer :: matClose, matPutVariable
  
  integer(kind=4) :: mxGetPr,mxClassIDFromClassName,mxCreateNumericMatrix
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  actionin = 'a'
  if (present(action)) actionin = action
  TrueAction = CheckAction(flnm,actionin)