[cig-commits] r17049 - in seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process: . asc2sac

[liuqy at geodynamics.org]

Author: liuqy
Date: 2010-07-16 15:19:51 -0700 (Fri, 16 Jul 2010)
New Revision: 17049

Added:
   seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/
   seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/asc2sac.f90
   seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/ascfile.f90
   seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/compile
Log:
add seismic processing utility asc2sac, which has been modified to use only in-house subroutines and sac libraries.



Added: seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/asc2sac.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/asc2sac.f90	                        (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/asc2sac.f90	2010-07-16 22:19:51 UTC (rev 17049)
@@ -0,0 +1,23 @@
+program asc2sac
+
+  implicit none
+
+  integer, parameter :: NDATAMAX = 40000
+  integer :: npts, nl, nerr
+  character(len=250) :: cnl, ascfile, sacfile
+  real b, dt, data(NDATAMAX)
+
+  call getarg(1,ascfile)
+  call getarg(2,cnl)
+  call getarg(3,sacfile)
+  if (trim(ascfile) == '' .or. trim(cnl) == '' .or. trim(sacfile) == '') &
+    stop 'Usage: asc2sac ascfile npts sacfile'
+  read(cnl,*) nl
+
+  call rasc(ascfile,data,npts,b,dt,NDATAMAX,nerr)
+  if (npts > NDATAMAX .or. npts /= nl) stop 'Check npts'
+
+  call wsac1(sacfile,data,npts,b,dt,nerr)
+
+
+end program asc2sac

Added: seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/ascfile.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/ascfile.f90	                        (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/ascfile.f90	2010-07-16 22:19:51 UTC (rev 17049)
@@ -0,0 +1,66 @@
+!------------------------------------------------
+
+subroutine rasc(ascfile,dat,npts,b,dt,nmax,nerr)
+
+  implicit none
+  character(len=*) ascfile
+  real dat(1), b, dt
+  integer npts, nmax, nerr
+
+  real tv
+  integer nline, ios, IOUNIT
+
+  IOUNIT=99
+
+  open(IOUNIT,file=trim(ascfile),status='old',iostat=ios)
+  if (ios /= 0) then
+     print 'Error opening '//trim(ascfile); nerr=1
+     return
+  endif
+
+  nline=0
+  do while(ios == 0)
+     read(IOUNIT,*,iostat=ios) tv,dat(nline+1)
+     if (ios == 0) nline=nline+1
+     if (nline==1) then
+        b=tv
+     else if (nline == 2) then
+        dt=tv-b
+     endif
+  enddo
+
+  if (nline > nmax) then
+     print *, 'npts exceeding nmax '; nerr=2
+     return
+  endif
+
+  npts=nline
+  nerr=0
+  close(IOUNIT)
+
+end subroutine rasc
+
+subroutine wasc(ascfile,dat,npts,b,dt,nerr)
+
+  implicit none
+
+  character(len=*) :: ascfile
+  real :: dat(1), b, dt
+  integer :: npts, nerr, i, ios, IOUNIT
+
+  IOUNIT=99
+  open(IOUNIT,file=trim(ascfile),status='unknown',iostat=ios)
+  if (ios /= 0) then
+     print 'Error opening '//trim(ascfile)//' for writing'
+     nerr = 1; return 
+  endif
+  do i = 1, npts
+     write(IOUNIT,'(2g15.7)') b+(i-1)*dt, dat(i)
+  enddo
+  close(IOUNIT)
+  
+  nerr=0
+  
+end subroutine wasc
+
+

Added: seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/compile
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/compile	                        (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/compile	2010-07-16 22:19:51 UTC (rev 17049)
@@ -0,0 +1,5 @@
+#!/bin/bash
+
+SACLIB='/opt/sac-101.0/lib/libsacio.a'
+
+gfortran -o asc2sac asc2sac.f90 ascfile.f90 $SACLIB


Property changes on: seismo/3D/SPECFEM3D_GLOBE/trunk/UTILS/seis_process/asc2sac/compile
___________________________________________________________________
Name: svn:executable
   + *