matdata.f90

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

  
  ! --- 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 = mxCreateNumericArray(3,shape(var),mxClassIDFromClassName('double'),0)
  ! --- Copy data to variable
  call mxCopyReal8toPtr(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_Real8_3

! --- Integer(kind=2), 4-dimensional array
subroutine Put_Int2_4(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,mxCreateNumericArray
  
  ! --- 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 = mxCreateNumericArray(4,shape(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_4

! --- Integer(kind=4), 3-dimensional array
subroutine Put_Int4_4(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,mxCreateNumericArray
  
  ! --- 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 = mxCreateNumericArray(4,shape(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_4

! --- real(kind=4), 3-dimensional array
subroutine Put_real4_4(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,mxCreateNumericArray
  
  ! --- 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 = mxCreateNumericArray(4,shape(var),mxClassIDFromClassName('single'),0)
  ! --- Copy data to variable
  call mxCopyReal4toPtr(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_Real4_4

! --- real(kind=8), 3-dimensional array
subroutine Put_Real8_4(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  real(kind=8), 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,mxCreateNumericArray
  
  ! --- 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 = mxCreateNumericArray(4,shape(var),mxClassIDFromClassName('double'),0)
  ! --- Copy data to variable
  call mxCopyReal8toPtr(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_Real8_4

! ---------------------------------- 
! -         Put Character          -
! ----------------------------------

! --- Character 0
subroutine Put_Char_0(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  character(len=*), 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,mxCreateString
  
  ! --- 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 = mxCreateString(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_Char_0


! --- Character 1
subroutine Put_Char_1(filename,varname,var,action)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  character(len=*), 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) :: mxCreateCharMatrixFromStrings
  
  ! --- 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 character matrix from strings
  pa = mxCreateCharMatrixFromStrings(size(var),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_Char_1


! --------------------------------------------------------------------------
! -                                                                        -
! -                          Read Subroutines                              -
! -                                                                        -
! --------------------------------------------------------------------------
! --- Integer(kind=2) 
subroutine Get_Int2_0(filename,varname,var)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  integer(kind=2), intent(out)  :: var

  character(len=len(filename)+4) :: flnm
  character(len=1) :: TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer(kind=4) :: matClose, matGetVariable
  
  integer(kind=4) :: mxGetPr
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  TrueAction = CheckAction(flnm,'r')
  if (TrueAction /= 'r') then
    write(*,'("Non-exist .mat file ",a)')flnm
    var = 0
    return
  endif
  
  ! --- Open .mat file for read
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Get variable 
  pa = matGetVariable(mp,varname)
  if (pa == 0) then
    write(*,'("Non-exist variable ",a)')varname
  else
    ! --- Copy pointer to data variable
    call mxCopyPtrToInteger2(mxGetPr(pa),var,1)
  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 Get_Int2_0

! --- Integer(kind=4) 
subroutine Get_Int4_0(filename,varname,var)
  character(len=*), intent(in) :: filename
  character(len=*), intent(in) :: varname
  integer(kind=4), intent(out)  :: var

  character(len=len(filename)+4) :: flnm
  character(len=1) :: TrueAction
  
  ! --- replace integer by integer(kind=8) on DEC alpha 64-bit platform
  integer(kind=4) :: matOpen
  integer(kind=4) :: matClose, matGetVariable
  
  integer(kind=4) :: mxGetPr
  
  ! --- check file name with .mat extension
  flnm = CheckFileName(filename)
  ! --- check file I/O action
  TrueAction = CheckAction(flnm,'r')
  if (TrueAction /= 'r') then
    write(*,'("Non-exist .mat file ",a)')flnm
    var = 0
    return
  endif
  
  ! --- Open .mat file for read
  mp = matOpen(trim(flnm),TrueAction)
  if (mp == 0) then
    write(*,'("Fail to open .mat file ",a)')trim(flnm)
    return
  endif
  
  ! --- Get variable 
  pa = matGetVariable(mp,varname)
  if (pa == 0) then
    write(*,'("Non-exist variable ",a)')varname
  else
    ! --- Copy pointer to data variable
    call mxCopyPtrToInteger4(mxGetPr(pa),var,1)
  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 Get_Int4_0

! --- real(kind=4)