module io implicit none save !-------------------------------------------------------------------------------------------------- ! These are the input and output units !-------------------------------------------------------------------------------------------------- integer(4), parameter :: stdin=5 ! Standard input integer(4), parameter :: stdout=6 ! Standard output integer(4), parameter :: tmpio=29 ! Unit of temporary io files integer(4), parameter :: input=30 ! Unit of the DNS field integer(4), parameter :: out_u=80 ! Unit used for output of u rms integer(4), parameter :: out_v=81 ! Unit used for output of v rms integer(4), parameter :: out_w=82 ! Unit used for output of w rms !-------------------------------------------------------------------------------------------------- ! These are the direct access files which are used as hoard files !-------------------------------------------------------------------------------------------------- integer(4), parameter :: u=2002 ! Hoard file for u, (mx,mz,my) ! Opened in calc_uw ! Closed in interpolate_y integer(4), parameter :: v=2003 ! Hoard file for v, (mx,mz,my) ! Opened in prep_workfile ! Closed in interpolate_y integer(4), parameter :: w=2004 ! Hoard file for w, (mx,mz,my) ! Opened in calc_uw ! Closed in interpolate_y integer(4) :: record_length ! record length for the hoard files ! Calculated in prep_io integer(4) :: record_length_real! record length for the hoard files in real space ! Calculated in prep_io character(100) :: inpfilename !-------------------------------------------------------------------------------------------------- contains !-------------------------------------------------------------------------------------------------- subroutine open_hoard(hoard) !------------------------------------------------------------------------------------------ ! Subroutine to open a new hoard file !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard integer(4) :: io_stat open(unit=hoard, status='SCRATCH', iostat=io_stat, access='DIRECT', & & form='UNFORMATTED', recl=record_length) if ( io_stat/=0 ) then print *,'!!!Could not open workspace for unit ',hoard,' on disk' stop 1 end if end subroutine open_hoard !-------------------------------------------------------------------------------------------------- subroutine open_hoard_real(hoard) !------------------------------------------------------------------------------------------ ! Subroutine to open a new hoard file !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard integer(4) :: io_stat open(unit=hoard, status='SCRATCH', iostat=io_stat, access='DIRECT', & & form='UNFORMATTED', recl=record_length_real) if ( io_stat/=0 ) then print *,'!!!Could not open workspace for unit ',hoard,' on disk' stop 1 end if end subroutine open_hoard_real !-------------------------------------------------------------------------------------------------- subroutine read_plane_yx(hoard, field, k) use data, only: mx, my !------------------------------------------------------------------------------------------ ! Subroutine to read a yx plane !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard real(4), dimension(my,mx), intent(out) :: field integer(4), intent(in) :: k integer(4) :: j do j = 1, my read(unit=hoard,rec = recpoint(j,k)) field(j,:) end do end subroutine read_plane_yx !-------------------------------------------------------------------------------------------------- subroutine write_plane_yx(hoard, field, k) use data, only: mx, my !------------------------------------------------------------------------------------------ ! Subroutine to write a yx plane !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard real(4), dimension(my,mx), intent(in) :: field integer(4), intent(in) :: k integer(4) :: j do j = 1, my write(unit=hoard,rec = recpoint(j,k)) field(j,:) end do end subroutine write_plane_yx !-------------------------------------------------------------------------------------------------- subroutine read_plane_xz(hoard, field, j) use data, only: mx, mz !------------------------------------------------------------------------------------------ ! Subroutine to read a xz plane !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard real(4), dimension(mx,mz), intent(out) :: field integer(4), intent(in) :: j integer(4) :: k do k = 1, mz read(unit=hoard,rec = recpoint(j,k)) field(:,k) end do end subroutine read_plane_xz !-------------------------------------------------------------------------------------------------- subroutine write_plane_xz(hoard, field, j) use data, only: mx, mz !------------------------------------------------------------------------------------------ ! Subroutine to write a xz plane !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard real(4), dimension(mx,mz), intent(in) :: field integer(4), intent(in) :: j integer(4) :: k do k = 1, mz write(unit=hoard,rec = recpoint(j,k)) field(:,k) end do end subroutine write_plane_xz !-------------------------------------------------------------------------------------------------- subroutine read_plane_xz_real(hoard, real_field, j) use data, only: mgalx, mgalz !------------------------------------------------------------------------------------------ ! Subroutine to read a xz plane in realspace !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard real(4), dimension(mgalx+2,mgalz), intent(out) :: real_field integer(4), intent(in) :: j integer(4) :: k do k = 1, mgalz read(unit=hoard,rec = recpoint_real(j,k)) real_field(:,k) end do end subroutine read_plane_xz_real !-------------------------------------------------------------------------------------------------- subroutine write_plane_xz_real(hoard, real_field, j) use data, only: mgalx, mgalz !------------------------------------------------------------------------------------------ ! Subroutine to write a xz plane in realspace !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard real(4), dimension(mgalx+2,mgalz), intent(in) :: real_field integer(4), intent(in) :: j integer(4) :: k do k = 1, mgalz write(unit=hoard,rec = recpoint_real(j,k)) real_field(:,k) end do end subroutine write_plane_xz_real !-------------------------------------------------------------------------------------------------- subroutine read_plane_xy_real(hoard, real_field, k) use data, only: mgalx, my !------------------------------------------------------------------------------------------ ! Subroutine to read a xy plane in realspace !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: hoard real(4), dimension(mgalx+2,my), intent(out) :: real_field integer(4), intent(in) :: k integer(4) :: j do j = 1, my read(unit=hoard,rec = recpoint_real(j,k)) real_field(:,j) end do end subroutine read_plane_xy_real !-------------------------------------------------------------------------------------------------- function recpoint(j, k) use data, only: mx, mz !------------------------------------------------------------------------------------------ ! Pointer to appropriate record in wavespace !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: j, k integer(4) :: recpoint recpoint = k + mz*(j-1) end function recpoint !-------------------------------------------------------------------------------------------------- function recpoint_real(j, k) use data, only: mgalx, mgalz !------------------------------------------------------------------------------------------ ! Pointer to appropriate record in realspace !------------------------------------------------------------------------------------------ implicit none integer(4), intent(in) :: j, k integer(4) :: recpoint_real recpoint_real = k + mgalz*(j-1) end function recpoint_real !-------------------------------------------------------------------------------------------------- subroutine prep_io() use data ! character(100), parameter :: inpdir="/data/raid0/chan940_uvw/" character(100), parameter :: inpdir="/data/raid0/amitabh/chan180_uvw/" character(100) flname integer j, byte_length write(*,*) "checking transformed field" write(*,'(A,A)') "enter filename, to be read from ",inpdir read(*,*) flname open(input,file=trim(inpdir)//trim(flname),form='unformatted') read(input) time, Re, alpha, beta, a0, mx, my, mz write(*,'(A)') "time, Re, alpha, beta, a0, mx, my, mz" write(*,'(5(1p1e15.6),3I5)') time, Re, alpha, beta, a0, mx, my, mz allocate(u00(my),w00(my)) read(input) (u00(j), w00(j), j = 1, my) mgalx = 3*mx/2 mgalz = 3*(mz+1)/2 inquire(iolength=byte_length) real(1.,4) record_length = mx*byte_length write(*,*) "record length = ", record_length write(stdout,*) ' time: ', time write(stdout,*) ' alpha: ', alpha write(stdout,*) ' beta: ', beta write(stdout,*) ' Reynolds number: ', Re write(stdout,*) ' Number of modes: ', mx, mz, my write(stdout,*) ' The following sizes are calculated (int -> real trunc. possible):' write(stdout,*) ' Collocation points in (x,z): ', mgalx, mgalz end subroutine prep_io !-------------------------------------------------------------------------------------------------- subroutine input_field() use data implicit none integer j real(4), allocatable, dimension(:,:) :: uxz, vxz, wxz real(8) t0, t1, t2 allocate(uxz(mx,mz),vxz(mx,mz),wxz(mx,mz)) call open_hoard(u) call open_hoard(v) call open_hoard(w) do j = 1,my ! write(*,*) j call cpu_time(t0) read(input) uxz,vxz,wxz call cpu_time(t1) ! write(*,*) "time taken to read plane =",t1-t0 call write_plane_xz(u,uxz,j) call write_plane_xz(v,vxz,j) call write_plane_xz(w,wxz,j) call cpu_time(t2) ! write(*,*) "time taken to write plane to hoard =",t2-t1 enddo close(input) deallocate(uxz,vxz,wxz) end subroutine input_field !-------------------------------------------------------------------------------------------------- subroutine cleanup() use data, only: alp2, bet2, u00, w00, kx, kz !------------------------------------------------------------------------------------------ ! We close all of IO and deallocate any remaining arrays !------------------------------------------------------------------------------------------ implicit none close(u) close(v) close(w) deallocate(alp2, bet2, kx, kz,u00,w00) end subroutine cleanup !-------------------------------------------------------------------------------------------------- end module io