Merge pull request #1 from tktmyd/develop

For version 0.1

.gitignore

@@ -30,3 +30,14 @@
 *.exe
 *.out
 *.app
+*.x
+
+# Data files
+*.win
+*.win32
+*.cnt
+*.sac
+*.dat
+test/testdata/*
+*tmp*
+*lst

README.md

@@ -1,2 +1,45 @@
 # fwin
-A module for seismic waveform data in WIN and WIN32 formats
+A module for reading seismic waveform data in WIN and WIN32 formats
+
+## Important Notice
+This library is under being development. Significant changes in designs of module libraries might occur in future versions. 
+
+## Compile
+
+```bash
+$ cd src
+ (edit makefile if necessary)
+$ make
+```
+
+To fully use the asynchronous I/O in Fortran2008, gfortran version 9 or later is required, while the program can be successfully compiled in more earlier versions. 
+
+## Core modules
+
+Please read the block comments in the code for the detail of usage. Source codes of the utility programs (see below) may be useful for understanding the usage. 
+
+### module m_win (in m_win.f90)
+- `subroutine win__read_files`: Asynchronously read a set of WIN/WIN32 files
+- `subroutine win__read_file`: Read a win file
+
+## module m_winch (in m_winch.f90)
+- `type winch__hdr`: defines channel information. Usually use as an array
+- `subroutine winch__read_tbl`: Read a channel table file
+- `subroutine winch__get_all_chid`: Obtain all channel ID from the channel table data array
+- `subroutine winch__get_all_stnm`: Obatin all station names contained in the channel table data array
+- `subroutine winch__get_all_cmpnm`: Obtain all component names contained in the channel table data array
+
+
+## Utility Programs
+
+### fchinf.x
+Display selected channel information from a given channel table file
+
+### fdewin_s.x
+Convert WIN/WIN32 files to ascii text: Synchronous version
+
+### fdewin_a.x
+Convert WIN/WIN32 files to ascii text: Asynchronous version
+
+### fwin2sac.x
+Convert WIN/WIN32 files to SAC-formatted datafiles

src/fchinf.f90

@@ -0,0 +1,88 @@
+!-------------------------------------------------------------------------------------------------!
+!> Display channel information
+!--
+program fchinf
+
+  use iso_fortran_env
+  use m_win
+  use m_winch
+  use m_getopt 
+  use m_util
+  implicit none
+  !--
+  type(winch__hdr), allocatable :: ch(:)
+  character(256) :: fn_chtbl, chbuf, stbuf, cmpbuf
+  character(4), allocatable :: chid(:)
+  character(16), allocatable :: stnm(:)
+  character(16), allocatable :: cmpnm(:)
+  logical :: is_opt, is_opt_ch, is_opt_st, is_opt_cmp
+  integer :: nch, nst, ncmp
+  integer :: i, j, k
+  character(256) :: fmt
+  logical :: chid_mode
+  integer :: ichid
+  logical :: is_all_chid, is_all_st, is_all_cmp
+  character(4) :: chid_tmp
+  !----
+
+  call getopt('f', is_opt,     fn_chtbl)
+  if(.not. is_opt) call usage_stop()
+
+  call getopt('c', is_opt_ch,  chbuf)
+  call getopt('s', is_opt_st,  stbuf)
+  call getopt('p', is_opt_cmp, cmpbuf)
+
+  ! priority is on specified channel ID than station&components
+  chid_mode = is_opt_ch
+
+  if( (.not. is_opt_ch) .and. ( (.not. is_opt_st) .or. (.not. is_opt_cmp) ) ) call usage_stop()
+
+  call winch__read_tbl(fn_chtbl, ch)
+
+  if( chid_mode ) then
+    call util__read_arglst(chbuf, nch, is_all_chid, chid)
+    if( is_all_chid ) call winch__get_all_chid(ch, chid)
+  else
+    call util__read_arglst(stbuf, nst, is_all_st, stnm)
+    if( is_all_st ) call winch__get_all_stnm(ch, stnm)
+    call util__read_arglst(cmpbuf, ncmp, is_all_cmp, cmpnm)
+    if( is_all_cmp ) call winch__get_all_cmpnm(ch, cmpnm)
+  end if    
+
+  fmt = '(A, ":  ", A, " (", A, ")", "  unit: ", A, "  T0=", F6.3, ' &
+  // '"  h=", F6.3, "  location: ", F9.5, " E,", F9.5, " N,", F9.2, " m")'
+
+  if( chid_mode ) then
+    do j=1, size(ch)
+      do i=1, size(chid)
+        ichid = win__ach2ich(chid(i))
+        if( ichid == ch(j)%ichid ) then
+          !! export channel information
+          write(output_unit, fmt) ch(i)%achid, trim(ch(i)%stnm), trim(ch(i)%cmpnm), &
+            trim(ch(i)%unit), ch(i)%period, ch(i)%damp, ch(i)%lon, ch(i)%lat, ch(i)%elev
+          exit
+        end if
+      end do
+    end do
+  else
+    do j=1, size(stnm)
+      do k=1, size(cmpnm)
+        call winch__st2chid(ch, stnm(j), cmpnm(k), chid_tmp, i)
+        if( i > 0 ) then
+          write(output_unit, fmt) ch(i)%achid, trim(ch(i)%stnm), trim(ch(i)%cmpnm), &
+            trim(ch(i)%unit), ch(i)%period, ch(i)%damp, ch(i)%lon, ch(i)%lat, ch(i)%elev
+        end if
+      end do
+    end do
+  end if
+
+  contains
+  subroutine usage_stop()
+
+    write(error_unit,'(A)') 'usage:  fchinf.x  <-f chtbl> [-c chid] [-s stnm] [-p cmpnm]'
+    stop
+
+  end subroutine usage_stop
+
+end program fchinf
+!-------------------------------------------------------------------------------------------------!

src/fdewin_a.f90

@@ -0,0 +1,111 @@
+!-------------------------------------------------------------------------------------------------!
+!> Read Win/Win32-formatted seismograph data and export to ascii files: asynchronous version
+!!
+!! @copyright
+!! Copyright (c) 2019 Takuto Maeda. All rights reserved. 
+!!
+!! @license 
+!! This software is released under the MIT license. See LICENSE for details. 
+!--
+program fdewin_a
+
+  use iso_fortran_env
+  use m_win
+  use m_util
+  use m_getopt
+
+  implicit none 
+
+  integer, parameter :: fsmax = 200
+  character(256), allocatable :: fn_win(:)
+  integer :: nch, nw, nsec
+  character(4), allocatable :: chid(:)
+  integer, allocatable :: dat(:,:)
+  integer, allocatable :: npts(:,:), sfreq(:)
+  character(80) :: d_out
+  logical :: is_test_mode
+  !! ----
+
+  !-----------------------------------------------------------------------------------------------!
+  !> command-line option processing
+  !--
+  block
+
+    character(80) :: fn_winlst
+    character(80) :: fn_chlst
+    logical :: is_opt, is_all
+
+    call getopt('l', is_opt, fn_winlst, '' )
+
+    if( is_opt ) then
+      call util__readlst( fn_winlst, nw, fn_win )
+    else
+      nw = 1
+      allocate( fn_win(1) )
+      call getopt('w', is_opt, fn_win(1), '') 
+      if(.not. is_opt) call usage_stop() 
+    end if
+
+    call getopt('c', is_opt, fn_chlst, '' )
+
+    if( is_opt ) then
+      call util__read_arglst( fn_chlst, nch, is_all, chid )
+    else
+      call usage_stop() 
+    end if
+
+    call getopt('d', is_opt, d_out, '.' ) 
+
+    call getopt('Z', is_test_mode) 
+
+  end block
+  !-----------------------------------------------------------------------------------------------!
+
+  !-----------------------------------------------------------------------------------------------!
+  !> Read the data
+  !--
+  block
+    integer :: tim
+    !----
+
+    allocate( sfreq(nch) )
+    allocate( dat(fsmax*60*nw,nch) ) !! initial size
+    call win__read_files(fn_win, chid, sfreq, nsec, tim, dat, npts)
+  end block
+  !-----------------------------------------------------------------------------------------------!
+
+  !-----------------------------------------------------------------------------------------------!
+  !> Export
+  !--  
+  block
+    integer :: i, j, io
+    character(80) :: fn_asc
+    !----
+
+    do i=1, nch
+      if( sfreq(i) > 0 ) then
+        fn_asc = trim(d_out) //'/'//trim(chid(i))//'.dat'
+        open(newunit=io, file=fn_asc, action='write', status='unknown')
+        do j=1, sfreq(i) * nsec
+          write(io,'(I0)') dat(j,i)
+        end do
+        close(io)
+        if( is_test_mode ) exit
+      else
+        write(error_unit,'(A)') 'Channel ' // chid(i) // ' : no data in the file'      
+      end if
+    end do
+  end block
+  !-----------------------------------------------------------------------------------------------!
+
+contains
+
+!-----------------------------------------------------------------------------------------------!
+  subroutine usage_stop()
+
+    write(error_unit,'(A)') 'usage:  fdewin_a.x <-l winlst|-w winfile> <-c chid|lst> [-d dir]'
+    stop
+  end subroutine usage_stop
+
+end program fdewin_a
+!-------------------------------------------------------------------------------------------------!

src/fdewin_s.f90

@@ -0,0 +1,122 @@
+!-------------------------------------------------------------------------------------------------!
+!> Read Win/Win32-formatted seismograph data and export to ascii files: synchronous version
+!!
+!! @copyright
+!! Copyright (c) 2019 Takuto Maeda. All rights reserved. 
+!!
+!! @license 
+!! This software is released under the MIT license. See LICENSE for details. 
+!--
+program fdewin_s
+
+  use iso_fortran_env
+  use m_win
+  use m_util
+  use m_getopt
+
+  implicit none 
+  !--
+
+  integer                     :: nch, nw, nsec
+  character(256), allocatable :: fn_win(:)
+  character(4),   allocatable :: chid(:)
+  integer,        allocatable :: dat(:,:), dat0(:,:)
+  integer,        allocatable :: npts(:,:), sfreq(:)
+  character(80)               :: d_out
+  integer, parameter          :: fsmax = 200
+  logical                     :: is_test_mode
+  !----
+
+  !-----------------------------------------------------------------------------------------------!
+  !> command-line option processing
+  !--
+  block
+
+    character(80) :: fn_winlst
+    character(80) :: fn_chlst
+    logical :: is_opt, is_all
+
+    call getopt('l', is_opt, fn_winlst, '' )
+
+    if( is_opt ) then
+      call util__readlst( fn_winlst, nw, fn_win )
+    else
+      nw = 1
+      allocate( fn_win(1) )
+      call getopt('w', is_opt, fn_win(1), '') 
+      if( .not. is_opt ) call usage_stop()
+    end if
+
+    call getopt('c', is_opt, fn_chlst, '' )
+
+    if( is_opt ) then
+      call util__read_arglst( fn_chlst, nch, is_all, chid )
+    else
+      if( .not. is_opt ) call usage_stop()
+    end if
+
+    call getopt('d', is_opt, d_out, '.' ) 
+
+    call getopt('Z', is_test_mode)
+
+  end block
+  !-----------------------------------------------------------------------------------------------!
+
+  !-----------------------------------------------------------------------------------------------!
+  !> Read the data
+  !--
+  block
+    integer :: i, j
+    integer :: tim
+    !----
+
+    allocate( sfreq(nch) )
+    allocate( dat(fsmax*60*nw,nch) ) !! initial size
+    dat(:,:) = 0
+
+    do i=1, nw
+      call win__read_file(fn_win(i), chid, sfreq, nsec, tim, dat0, npts)
+      do j=1, nch
+        if( sfreq(j) > 0 ) then
+           dat( (i-1)*sfreq(j)*nsec+1:i*sfreq(j)*nsec, j) = dat0(1:sfreq(j)*nsec,j)
+        end if
+      end do   
+
+    end do
+  end block
+  !-----------------------------------------------------------------------------------------------!
+
+  !-----------------------------------------------------------------------------------------------!
+  !> Export
+  !--  
+  block
+    integer :: i, j, io
+    character(80) :: fn_asc
+    !----
+
+    do i=1, nch
+      if( sfreq(i) > 0 ) then
+        fn_asc = trim(d_out) //'/'//trim(chid(i))//'.dat'
+        open(newunit=io, file=fn_asc, action='write', status='unknown')
+        do j=1, sfreq(i)*nsec*nw
+          write(io,'(I0)') dat(j,i)
+        end do
+        close(io)
+        if( is_test_mode ) exit
+      else
+        write(error_unit,'(A)') 'Channel ' // chid(i) // ' : no data in the file'      
+      end if
+    end do
+  end block
+  !-----------------------------------------------------------------------------------------------!
+
+contains
+  !-----------------------------------------------------------------------------------------------!
+  subroutine usage_stop()
+
+    write(error_unit,'(A)') 'usage:  fdewin_s.x <-l winlst|-w winfile> <-c chid|lst> [-d dir]'
+    stop
+  end subroutine usage_stop      
+
+end program fdewin_s
+!-------------------------------------------------------------------------------------------------!