mat_savlod Subroutine

public subroutine mat_savlod(lun, id, m, n, img, space_left, xreal, ximag)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: lun
integer :: id(GG_MAX_NAME_LENGTH)
integer :: m
integer :: n
integer :: img
integer :: space_left
doubleprecision :: xreal(*)
doubleprecision :: ximag(*)

Contents

Variables

Source Code

mat_savlod

Variables

Type Visibility Attributes Name Initial
character(len=GG_MAX_NAME_LENGTH), public :: cid
character(len=*), public, parameter :: f101 = '(A,3I9)'
character(len=*), public, parameter :: f102 = '(4Z18)'
integer, public :: ios
integer, public :: j
integer, public :: k
integer, public :: l
character(len=256), public :: message

Source Code

subroutine mat_savlod(lun,id,m,n,img,space_left,xreal,ximag)

! ident_31="@(#) M_matrix mat_savlod(3fp) read next variable from a save file or write next variable to it"

integer,intent(in)                :: lun                                       ! logical unit number
integer                           :: id(GG_MAX_NAME_LENGTH)                    ! name, format 32a1
integer                           :: m, n                                      ! dimensions
integer                           :: img                                       ! nonzero if ximag is nonzero.  returned on a load
integer                           :: space_left                                ! 0 for save, = space available for load
doubleprecision                   :: xreal(*), ximag(*)                        ! real and optional imaginary parts
character(len=GG_MAX_NAME_LENGTH) :: cid
integer                           :: j,k,l
integer                           :: ios
character(len=256)                :: message
                                                                               ! system dependent formats
character(len=*),parameter        :: f101 ='(A,3I9)'                           ! ID, MxN dimensions of ID, imaginary or real flag
character(len=*),parameter        :: f102 ='(4Z18)'                            ! format for data
      if (space_left .le. 0) then                                              ! save
         call mat_buf2str(cid,id,GG_MAX_NAME_LENGTH)                           ! convert ID to a character string
         write(lun,f101) cid,m,n,img
         do j = 1, n
            k = (j-1)*m+1
            l = j*m
            write(lun,f102) xreal(k:l)                                         ! real
            if (img .ne. 0) write(lun,f102) ximag(k:l)                         ! imaginary
         enddo
      else                                                                     ! load
         read(lun,f101,iostat=ios,iomsg=message) cid,m,n,img
         if(ios.ne.0)then
            call journal(message)
            m=0
            n=0
         else
            call mat_str2buf(cid,id,GG_MAX_NAME_LENGTH)                        ! convert character string to an ID
            if (m*n .gt. space_left) then
               m=0
               n=0
            else
               do j = 1, n
                  k = (j-1)*m+1
                  l = j*m
                  read(lun,f102,iostat=ios,iomsg=message) xreal(k:l)           ! real
                  if(ios.ne.0)then
                     call journal(message)
                     m=0
                     n=0
                     exit
                  elseif (img .ne. 0) then
                     read(lun,f102,iostat=ios,iomsg=message) ximag(k:l)        ! imaginary
                     if(ios.ne.0)then
                        m=0
                        n=0
                        exit
                     endif
                  endif
               enddo
            endif
         endif
      endif
end subroutine mat_savlod