IMPLEMENTATION

The following Fortran 90 module implements an object-oriented design of the generic NMO program.

module nnnmo
  use int1

logical,                          private :: pul
  integer,                          private :: nt
  real,                             private :: ot, dt
  real, dimension (:), allocatable, private :: t, z, w

contains

subroutine nnnmo_init (t0, z0, dz, n)
    real,    intent (in) :: t0, z0, dz
    integer, intent (in) :: n

integer              :: i

ot = t0 ; oz = z0 ; dt = dz; nt = n 
    if (.not. allocated (z)) allocate (z (nt), t (nt), w (nt)) 
    z = (/ (z0 + dt * (i - 1), i = 1, nt) /)
  end subroutine nnnmo_init

subroutine nnnmo_step (pull, nint, interp, time, ampl, x)
    logical,             intent (in) :: pull
    integer,             intent (in) :: nint
    real, dimension (:), intent (in) :: x
    interface
       function interp (x, w) result (stat)
         integer                :: stat
         real,    intent (in)   :: x
         real,    dimension (:) :: w
       end function interp
       function time (pull, x, tin, tout) result (stat)
         integer             :: stat
         logical             :: pull
         real, dimension (:) :: x, tin, tout
       end function time
       function ampl (pull, x, tin, tout, weight) result (stat)
         integer             :: stat
         logical             :: pull
         real, dimension (:) :: x, tin, tout, weight
       end function ampl
    end interface

integer                          :: stat1,stat2

pul = pull
    stat1 = time (pul, x, z, t)
    stat2 = ampl (pul, x, z, t, w)
    call int1_init (t, ot, dt, nt, interp, nt, nint, w)
  end subroutine nnnmo_step

function nnnmo_lop (adj, add, mod, dat) result (stat)
    integer              :: stat
    logical, intent (in) :: adj, add
    real, dimension (:)  :: mod, dat

integer              :: stat0

if (pul) then
       stat0 = int1_lop (.not. adj, add, dat, mod)
    else
       stat0 = int1_lop (      adj, add, mod, dat)
    end if

stat = 0
  end function nnnmo_lop

subroutine nnnmo_close ()
    call int1_close ()
    deallocate (z, t, w)
  end subroutine nnnmo_close

end module nnnmo

The module contains the initialization routine nnnmo_init, which receives the time grid information and saves it to module variables. It also translates the regular grid into a one-dimensional array. The next subroutine, nnnmo_step, computes the NMO time stretch and amplitude scaling. Its arguments are a logical variable, which defines pull or push operation, a real array x, which may contain the trace header information, and two functions to compute the time and amplitude transformation. The user of the nnnmo module is free to specify these functions according to any particular application provided that they comply to the generic interface. Typical examples of commonly used functions are collected in module nmo.

module mo_mod
contains

function linear_time  (pull, x, z, t) result (stat)
    integer             :: stat
    logical             :: pull
    real, dimension (:) :: x, z, t

if (pull) then
       t = z + sum (x)
    else
       t = z - sum (x)
    end if

stat = 0
  end function linear_time

function hyper_time (pull, x, z, t) result (stat)
    integer             :: stat
    logical             :: pull
    real, dimension (:) :: x, z, t

if (pull) then
       t = z*z + dot_product (x,x)
    else
       t = z*z - dot_product (x,x)
    end if

where (t > 0.) t = sqrt (t) ; stat = 0
  end function hyper_time

function vofz_hyper_time (pull, x, z, t) result (stat)
    integer             :: stat
    logical             :: pull
    real, dimension (:) :: x, z, t

if (pull) then
       t = z*z + x*x
    else
       t = z*z - x*x
    end if

where (t > 0.) t = sqrt (t) ; stat = 0
  end function vofz_hyper_time

function unit_ampl (pull, x, z, t, w) result (stat)
    integer             :: stat
    logical             :: pull
    real, dimension (:) :: x, z, t, w

w = 1. ; stat = 0
  end function unit_ampl

function cos2D_ampl (pull, x, z, t, w) result (stat)
    integer             :: stat
    logical             :: pull
    real, dimension (:) :: x, z, t, w

if (pull) then
       where (t > 0.)
          w = (z / t) / sqrt (t)
       elsewhere
          w = 0.
       end where
    else
       where (z > 0.)
          w = 1. / sqrt (z)
       elsewhere
          w = 0.
       end where
    end if

stat = 0
  end function cos2D_ampl

function hyper_slope (pull, x, z, t, tx) result (stat)
    integer             :: stat
    logical             :: pull
    real, dimension (:) :: x, z, t, tx

where ( t > 0.)
       tx = sqrt (dot_product (x, x)) / t
    elsewhere
       tx = 0.
    end where

stat = 0
  end function hyper_slope

end module mo_mod

After initialization calls to nnnmo_init and nnnmo_step, the actual operator nnnmo_op simply calls an interpolation operator to complete the job. When the pull parameter is set to .true., the forward operator is ``push'', and the adjoint is ``pull''. In this case, the time interpolation is carried out in the data space. When pull is .false., the time interpolation is done on the model trace. The interpolation is performed by module interp, which calls either bin1 or lint1 Fomel and Claerbout (1996) depending on the user-specified parameter.

module interp

implicit none

contains

function bin_int (x, w) result (stat)
    integer             :: stat
    real, intent (in)   :: x
    real, dimension (:) :: w
    w = 0.; w (1) = 1. ; stat = 0 
  end function bin_int

function bin2_int (x, w) result (stat)
    integer                           :: stat
    real, dimension (2), intent (in)  :: x
    real, dimension (:,:)             :: w
    w = 0.; w (1,1) = 1. ; stat = 0 
  end function bin2_int

function lin_int (x, w) result (stat)
    integer             :: stat
    real, intent (in)   :: x
    real, dimension (:) :: w
    w = 1.
    if (size (w) == 2) then
       w (2) = x 
       w (1) = 1. - x 
    end if
    stat = 0
  end function lin_int

function lin2_int (x, w) result (stat)
    integer                          :: stat
    real, dimension (2), intent (in) :: x
    real, dimension (:,:)            :: w

w = 1.
    if (size (w,1) == 2) then
       w (2,:) = x (1)
       w (1,:) = 1. - x (1) 
    end if
    if (size (w,2) == 2) then
       w (:,2) = w (:,2) * x (2)
       w (:,1) = w (:,1) * (1. - x (2)) 
    end if
    stat = 0
  end function lin2_int

end module interp