Catherine Moroney wrote:
> Can I declare the dummy argument in the subroutine to be a
> real, dimension(:), and then somehow mash a 3-d real array
> into that dummy vector? I could probably do it if I explicitly
> declare a new array and "pack" the existing 3-d array into the
> new 1-d one, but I'd be interested to know if there's a way of
> passing the 3-d array into a 1-d one inside the subroutine without
> a call to "pack".
You may instead write a "working horse" with
real(8) :: array(*)
1D dummy input and call that subroutine with
actual arrays of any shape. As for instance here:
subroutine write_buffer_1D(io,buf)
implicit none
integer(IK),intent(in) :: io
real(RK), intent(in) :: buf(:)
! *** end of interface ***
call write_real_buf(io,buf,size(buf))
end subroutine write_buffer_1D
subroutine write_buffer_2D(io,buf)
implicit none
integer(IK),intent(in) :: io
real(RK), intent(in) :: buf(:,:)
! *** end of interface ***
call write_real_buf(io,buf,size(buf))
end subroutine write_buffer_2D
subroutine write_buffer_3D(io,buf)
implicit none
integer(IK),intent(in) :: io
real(RK), intent(in) :: buf(:,:,:)
! *** end of interface ***
call write_real_buf(io,buf,size(buf))
end subroutine write_buffer_3D
subroutine write_real_buf(io,buf,siz)
! DISK INTERFACE: working horse for writing
implicit none
integer(IK),intent(in) :: io, siz
real(RK), intent(in) :: buf(*)
! *** end of interface ***
#ifndef _IO_SEQ_FAILSAFE
! variable RECL = buf(:siz)
DPRINT 'write_real_buf(',siz,')'
WRITE(io,IOSTAT=iostat) buf(:siz)
#else
! constant RECL = 1 REAL(r8_kind)
! may consume twice the space:
integer(IK) :: i
do i=1,siz
WRITE(io) buf(i)
enddo
#endif
if( iostat /= 0 )then
select case ( on_error )
case ( IO_ABORT )
print *,'write_real_buf: IO error: got IOSTAT=',iostat,' while writing unit ',io
ABORT('write_real_buf: IO error')
case ( IO_CONTINUE )
print *,'write_real_buf: ignore IO error: got IOSTAT=',iostat,' while writing unit ',io
WARN('write_real_buf: ignore IO error')
case default
ABORT('no such case')
end select
endif
end subroutine write_real_buf
|