module tide_module
    implicit none

    logical, save :: setup = .false.

    contains

    subroutine setup_tide(time_input, water_level, wl_size)
        integer, intent(in out) :: wl_size
        real(kind=8), dimension (:), allocatable, intent(in out) :: time_input, water_level

        integer :: iunit, i, istat
        logical :: foundFile
        character(len=255) :: wl_input
        real(kind=8), dimension (:,:), allocatable :: data_array
        real(kind=8) :: tmp

        if (.not. setup) then
            iunit = 40
            wl_input = '../tide.data'

            inquire(file=trim(adjustl(wl_input)), exist=foundFile)
            if (.not. foundFile) then
              write(*,*) 'Missing water level data file ...'
              write(*,*) 'Looking for ', trim(adjustl(wl_input)),' file'
              stop
            endif

            open(iunit, file=trim(adjustl(wl_input)), status='old', iostat=istat)

            rewind(iunit)
            wl_size = 0
            do
                read(iunit, *, iostat=istat) tmp
                if (is_iostat_end(istat)) exit
                wl_size = wl_size + 1
            end do

            allocate(data_array(wl_size, 2))
            allocate(time_input(wl_size))
            allocate(water_level(wl_size))

            rewind(iunit)
            do i= 1, wl_size
                read(iunit, *, iostat=istat) data_array(i,:)
            end do

            close(unit=iunit, iostat=istat)

            time_input(:) = data_array(:,1)
            water_level(:) = data_array(:,2)

            deallocate(data_array)

            setup = .true.
        end if

    end subroutine setup_tide

    subroutine parabola_val2(ndata, tdata, ydata, left, tval, yval)

    !*****************************************************************************80
    !
    !! PARABOLA_VAL2 evaluates a parabolic interpolant through tabular data.
    !
    !  Discussion:
    !
    !    This routine is a utility routine used by OVERHAUSER_SPLINE_VAL.
    !    It constructs the parabolic interpolant through the data in
    !    3 consecutive entries of a table and evaluates this interpolant
    !    at a given abscissa value.
    !
    !  Licensing:
    !
    !    This code is distributed under the GNU LGPL license.
    !
    !  Modified:
    !
    !    26 January 2004
    !
    !  Author:
    !
    !    John Burkardt
    !
    !  Parameters:
    !
    !    Input, integer(kind=4) :: NDATA, the number of data points.
    !    NDATA must be at least 3.
    !
    !    Input, real(kind=8) :: TDATA(NDATA), the abscissas of the data
    !    points.  The values in TDATA must be in strictly ascending order.
    !
    !    Input, real(kind=8) :: YDATA(DIM_NUM,NDATA), the data points
    !    corresponding to the abscissas.
    !
    !    Input, integer(kind=4) :: LEFT, the location of the first of the three
    !    consecutive data points through which the parabolic interpolant
    !    must pass.  1 <= LEFT <= NDATA - 2.
    !
    !    Input, real(kind=8) :: TVAL, the value of T at which the parabolic
    !    interpolant is to be evaluated.  Normally, TDATA(1) <= TVAL <= T(NDATA),
    !    and the data will be interpolated.  For TVAL outside this range,
    !    extrapolation will be used.
    !
    !    Output, real(kind=8) :: YVAL(DIM_NUM), the value of the parabolic
    !    interpolant at TVAL.
        !
        implicit none

        integer(kind=4) :: ndata

        real(kind=8) :: dif1
        real(kind=8) :: dif2
        integer(kind=4) :: left
        real(kind=8) :: t1
        real(kind=8) :: t2
        real(kind=8) :: t3
        real(kind=8) :: tval
        real(kind=8) :: tdata(ndata)
        real(kind=8) :: ydata(ndata)
        real(kind=8) :: y1
        real(kind=8) :: y2
        real(kind=8) :: y3
        real(kind=8) :: yval
        !
        !  Check.
        !
        if (left < 1) then
        write (*, '(a)') ' '
        write (*, '(a)') 'PARABOLA_VAL2 - Fatal error!'
        write (*, '(a)') '  LEFT < 1.'
        write (*, '(a,i8)') '  LEFT = ', left
        stop 1
        end if

        if (ndata-2 < left) then
        write (*, '(a)') ' '
        write (*, '(a)') 'PARABOLA_VAL2 - Fatal error!'
        write (*, '(a)') '  NDATA-2 < LEFT.'
        write (*, '(a,i8)') '  NDATA = ', ndata
        write (*, '(a,i8)') '  LEFT =  ', left
        stop 1
        end if
        !
        !  Copy out the three abscissas.
        !
        t1 = tdata(left)
        t2 = tdata(left+1)
        t3 = tdata(left+2)

        if (t2 <= t1 .or. t3 <= t2) then
        write(*, '(a)') ' '
        write(*, '(a)') 'PARABOLA_VAL2 - Fatal error!'
        write(*, '(a)') '  T2 <= T1 or T3 <= T2.'
        stop 1
        end if
        !
        !  Construct and evaluate a parabolic interpolant for the data
        !  in each dimension.
        !

        y1 = ydata(left)
        y2 = ydata(left+1)
        y3 = ydata(left+2)

        dif1 = (y2 - y1) / (t2 - t1)
        dif2 = ((y3 - y1) / (t3 - t1) &
            - (y2 - y1) / (t2 - t1)) / (t3 - t2)
        yval = y1 + (tval - t1) * (dif1 + (tval - t2) * dif2)

        return
    end subroutine parabola_val2

    subroutine linear_val2(y, t, y1, y2, t1, t2)

        implicit none
        real(kind=8), intent(in) :: t, y1, y2, t1, t2
        real(kind=8), intent(out) :: y

        if (t1 > t2) then
            print *, 'Fatal error, t1 > t2'
            stop
        end if

        y = y1 + (y2 - y1) / (t2 - t1) * (t - t1)

      return
    end subroutine linear_val2

end module tide_module


text:
! @@name:	nesting_restrict.5f
! @@type:	F-fixed
! @@compilable:	no
! @@linkable:	no
! @@expect:	failure
      SUBROUTINE WRONG5(N)
      INTEGER N

!$OMP   PARALLEL DEFAULT(SHARED)
!$OMP     CRITICAL
            CALL WORK(N,1)
! incorrect nesting of barrier region in a critical region
!$OMP       BARRIER ! { error "PGF90-S-0155-Illegal context for barrier" }
            CALL WORK(N,2)
!$OMP     END CRITICAL
!$OMP   END PARALLEL
      END SUBROUTINE WRONG5

ext: f

max_stars_repo_name: kammerdienerb/flang

max_issues_repo_name: kammerdienerb/flang

max_forks_repo_name: kammerdienerb/flang


text:
subroutine npcy
!
implicit none
!
include 'p1werm.inc'
include 'cgrow.inc'
include 'csoil.inc'
include 'chumus.inc'
!
! Local variables
!
integer :: j
real :: xx
!
! local variables
!
!     + + + purpose + + +
!     this subroutine is the master nutrient cycling subroutine.
!     calls npmin, nynit, nlch, nmnim, and ndnit for each soil
!     layer.
!
!     + + + kewords + + +
!     nutrient cycling

!     + + + common blocks + + +

! local includes
!     include 'cenvr.inc'
!     include 'cparm.inc'
!     include 'cfert.inc'

!     + + + local variables + + +
!
!     xx declared here but commented out in the code  jcaii  8/08/08
!
!     + + + local variable definitions + + +
!     ssfn - sum of n leached from each layer (kg/ha)
!     xx - depth to previous layer (m)
!
!     + + + subroutines called + + +
!     npmin
!     nynit
!     nlch
!     nmnim
!     ndnit
!
!     + + + output formats + + +
!
!     + + + end of specifications + + +
!
smr = 0.
shm = 0.
sim = 0.
sdn = 0.
smp = 0.
sip = 0.
tsfn = 0.
xx = 0.
do j = 1,ir
!        j1=lid(j)
!        j2=j1
!     calculate relative moisture content of each layer
!        sut=st(j)/(fc(j)+1.e-10)
  sut = .8
  if (sut>1.) sut = 1.
!     calculate mineral p transformations
  call npmin(j)
!        if (j1.ne.ld1) go to 2
!        calculate leaching from the top layer
!        call nynit (rq)
!        go to 3
!     calculate leaching from layers other than the top
!   2    call nlch (rq)
!   3    tsfn=tsfn+ssfn
!         if (t(j).le.0.) go to 5
!     calculate soil temperature factor for each layer
!         cdg=t(j)/(t(j)+20551.*exp(-.312*t(j)))
  cdg = 1.
!        if (rz.lt.xx) go to 4
!         if (rz.gt.xx) then
!      calculate organic n & p transformations in layers where there are roots
  call nmnim(j)
  shm = shm + hmn
  smr = smr + rmnr
  sim = sim + wim
  smp = smp + wmp
  sip = sip + wip
!         endif
!     calculate n denitrification
!   4    if (st(j1)/po(j1).lt..9) go to 5
!        if (st(j)/po(j).gt..9) then
!           call ndnit
!           sdn=sdn+wdn
!        endif
!         xx=z(j)
end do
!
end subroutine npcy

max_stars_repo_path: Source Code/npcy.f90

max_stars_repo_name: USDA-ARS-WMSRU/upgm-standalone

max_issues_repo_path: Source Code/npcy.f90

max_issues_repo_name: USDA-ARS-WMSRU/upgm-standalone

max_forks_repo_path: Source Code/npcy.f90

max_forks_repo_name: USDA-ARS-WMSRU/upgm-standalone


text:
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details

C=======================================================================
      SUBROUTINE LDTRAN(X,Y,Z,MAT)
      REAL MAT(4,4)

      CALL MXIDEN(4,MAT)
      MAT(4,1) = X
      MAT(4,2) = Y
      MAT(4,3) = Z
      RETURN

      END

max_stars_repo_name: jschueller/seacas

max_issues_repo_name: jschueller/seacas

max_forks_repo_name: jschueller/seacas


! Mikayla Webber
! 4670 Numerical Analysis
! Homework G Due 12.1.17

! use at least three numerical methods to solve:
! dy/dt = te^(3t) - 2y
! y(0) = 0
! for 0 <= t <= 2
! for each method obtain at least 100 data points on your approximation and produce a graph for each method.

program aopc
  implicit none

  integer :: i, neq, nsteps
  double precision :: a, b, dt
  double precision, allocatable, dimension(:, :) :: archive
  double precision, allocatable, dimension(:) :: f, t, u, f1, fi, fim1, fim2, fim3, fim4, yin, yout

  neq = 1
  a = 0.0d0
  b = 2.0d0
  nsteps = 100

  allocate(yin(neq), yout(neq), u(neq), t(0:nsteps), f(neq), archive(neq,0:nsteps))
  allocate(fi(neq), fim1(neq), fim2(neq), fim3(neq), fim4(neq))

  dt = ((b - a) / dble(nsteps))

  do i = 0, nsteps
    t(i) = (a + dble(i) * dt)
  end do

  archive (:,0) = (/ 1.0d0, 0.0d0, 0.0d0, 1.0d0 /) ! initial state vector
  call abinitializer(neq, nsteps, t, archive)

  do i = 4, (nsteps - 1)
    call computef(neq, t(i), archive(:,i), fi)
    call computef(neq, t(i-1), archive(:,i-1), fim1)
    call computef(neq, t(i-2), archive(:,i-2), fim2)
    call computef(neq, t(i-3), archive(:,i-3), fim3)
    call computef(neq, t(i-4), archive(:,i-4), fim4)
    u = archive(:,i) + dt / 720.0d0 * (1901.0d0 * fi - 2774.0d0 * fim1 + 2616.0d0 * fim2 - 1274.0d0 * fim3 + 251.0d0 * fim4)
  end do

  print*, 'Creating "out5.2.3"'
  open(unit=8, file='out5.2.3', status='replace')

  do i = 0, nsteps
    write(8,*) t(i), archive(1,i)
  end do

  close(8)
  deallocate(yin, yout, u, f, t, f1, fi, fim1, fim2, fim3, fim4, archive)

  stop
end program aopc

!----------------------------------------------------------------------

subroutine computef(neq, t, y, f)
  implicit none
  integer :: neq
  double precision :: f(neq)
  double precision, intent(in) :: t, y(neq)
  ! This subroutine computes the RHS of the differential equation:
  !  dy
  !  -- = f(t, y)
  !  dt
  ! where y is the array of unknowns, indexed from one to neq and f is the array of right sides.

  !y(0) = 0
  f(1) = (t * dexp(3.0d0 * t) - 2.0d0 * y(1))

  return
end

!-----------------------------------------------------------------------

subroutine abinitializer(neq, nsteps, t, archive)
  implicit none
  integer :: i, nsteps
  integer, intent(in) :: neq
  double precision, intent(in) :: t(0:nsteps)
  double precision :: tin, tout, yin(neq), yout(neq), archive(neq,0:nsteps)

  do i = 0, neq
    tin = t(i)
    yin = archive(:,i)
    tout = t(i+1)
    call extrapolate(neq, tin, tout, yin, yout)
    archive(:,i+1) = yout
  end do

  return
end

!-----------------------------------------------------------------------

subroutine extrapolate(neq, tin, tout, yin, yout)
  implicit none

  integer, intent(in) :: neq
  integer :: i, k, nrich, nsteps
  double precision :: yout(neq), bot
  double precision, intent(in) :: tin, tout, yin(neq)
  double precision, allocatable, dimension(:, :, :) :: table

  nrich = 10
  nsteps = 1
  allocate(table(0:nrich, 0:nrich, neq))

  do i = 0, nrich
    call euler(neq, tin, tout, nsteps, yin, yout)
    table(i,0,:) = yout
    nsteps = (nsteps * 2)
  end do

  do k = 1, nrich
    bot = (2.0d0**k - 1.0d0)
    do i = k, nrich
      table(i,k,:) = (table(i,k-1,:) + (table(i,k-1,:) - table(i-1,k-1,:)) / bot)
    end do
  end do

  yout = table(nrich, nrich, :)
  return
end

!-----------------------------------------------------------------------

subroutine euler(neq, tin, tout, nsteps, yin, yout)
  implicit none

  integer :: i
  integer, intent(in) :: neq, nsteps
  double precision :: yout(neq), f(neq), dt
  double precision, intent(in) :: tin, tout, yin(neq)

  yout = yin
  dt = ((tout - tin)/dble(nsteps))

  do i = 0, (nsteps - 1)
    call computef(neq, (tin + dble(i) * dt), yout, f)
    yout = (yout + dt * f)
  end do

  return
end


text:
!!  Copyright (C)  Stichting Deltares, 2012-2016.
!!
!!  This program is free software: you can redistribute it and/or modify
!!  it under the terms of the GNU General Public License version 3,
!!  as published by the Free Software Foundation.
!!
!!  This program is distributed in the hope that it will be useful,
!!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!!  GNU General Public License for more details.
!!
!!  You should have received a copy of the GNU General Public License
!!  along with this program. If not, see <http://www.gnu.org/licenses/>.
!!
!!  contact: delft3d.support@deltares.nl
!!  Stichting Deltares
!!  P.O. Box 177
!!  2600 MH Delft, The Netherlands
!!
!!  All indications and logos of, and references to registered trademarks
!!  of Stichting Deltares remain the property of Stichting Deltares. All
!!  rights reserved.

      subroutine boombounce( xold, yold, xnew, ynew, nboom, xboom, &
                                    yboom, xcatch, ycatch, catch, xbounce, ybounce, bounce)
!
!     Does a boom catch a particle in it's path from xold, yold to xnew, ynew?
!     And if it does, does it bounce without crossing another part of the boom?

      use precision_part      ! single/double precision
      use timers

      implicit none

      real    ( rp ) :: xold, yold, xnew, ynew
      integer ( ip ) :: nboom
      integer ( ip ) :: npolbounce
      real    ( sp ) :: xboom(nboom), yboom(nboom)
      real    ( sp ) :: xcatch, ycatch
      logical        :: catch
      real    ( sp ) :: xbounce, ybounce
      logical        :: bounce

!     local variables
      real    ( rp ) :: xmin, ymin, xmax, ymax
      real    ( dp ) :: xoldd, yoldd, xnewd, ynewd
      real    ( dp ) :: xboomd(nboom), yboomd(nboom)
      real    ( dp ) :: a1, b1, c1, rl1, rlnear
      real    ( dp ) :: a2(nboom), b2(nboom), c2(nboom), rl2(nboom)
      real    ( dp ) :: xcross(nboom), ycross(nboom)
      real    ( sp ) :: xcrossboom(2),ycrossboom(2)
      real    ( dp ) :: rl, xn, yn, xb, yb
      integer ( 4  ) :: iboom
      integer ( 4  ) :: inear
      real    ( dp ) :: det
      logical        :: boomgap(nboom), notnear

      integer(4) ithndl              ! handle to time this subroutine
      data       ithndl / 0 /
      if ( timon ) call timstrt( "lines_cross", ithndl )

      catch = .false.
      xcatch = 999.999e0
      ycatch = 999.999e0
      bounce = .false.
      xbounce = 999.999e0
      ybounce = 999.999e0
      inear = 0
      rlnear = 1.1D0
      boomgap = .false.
      xcrossboom = 999.999e0
      ycrossboom = 999.999e0

      xoldd = dble(xold)
      yoldd = dble(yold)
      xnewd = dble(xnew)
      ynewd = dble(ynew)
      xboomd = dble(xboom)
      yboomd = dble(yboom)

!     at least one coordinate must have changed, otherwise there is no line between old and new location
      if ( xold .ne. xnew .or. yold .ne. ynew ) then
!        fill matrix for particle track
         a1 = ynewd - yoldd
         b1 = xoldd - xnewd
         c1 = xnewd * yoldd - xoldd * ynewd
         xmin = min(xold, xnew)
         xmax = max(xold, xnew)
         ymin = min(yold, ynew)
         ymax = max(yold, ynew)

!        loop over booms
         do iboom = 1, (nboom - 1)
!           skip 'gaps' when both coordinates of either start or end are 999.999e0 (missing value)
            boomgap(iboom) = (xboom(iboom) .eq. 999.999e0 .and. xboom(iboom) .eq. 999.999e0) .or. &
                          (xboom(iboom + 1) .eq. 999.999e0 .and. xboom(iboom + 1) .eq. 999.999e0)
!           when both old and new x- or y-coordinate are less or higher than both the boom x- or y-coordinate
            notnear = (xmax .lt. xboom(iboom) .and. xmax .lt. xboom(iboom+1)) .or. &
                      (xmin .gt. xboom(iboom) .and. xmin .gt. xboom(iboom+1)) .or. &
                      (ymax .lt. yboom(iboom) .and. ymax .lt. yboom(iboom+1)) .or. &
                      (ymin .gt. yboom(iboom) .and. ymin .gt. yboom(iboom+1))
!           if both are false we might have a colission (sorry for the double denial)
            if (.not. boomgap(iboom) .and. .not. notnear) then
!              only when at least one coordinate is different we have a boom line
               if (xboomd(iboom) .ne. xboomd(iboom+1) .or. yboomd(iboom) .ne. yboomd(iboom+1) ) then
!                 fill matrix for boom track
                  a2(iboom) = yboomd(iboom+1) - yboomd(iboom)
                  b2(iboom) = xboomd(iboom) - xboomd(iboom+1)
                  c2(iboom) = xboomd(iboom+1) * yboomd(iboom) - xboomd(iboom) * yboomd(iboom+1)

!                 matrix determinant
                  det =  a1 * b2(iboom) - b1 * a2(iboom)

!                 when the determinant is zero, the lines are exactly parallel, and never cross
                  if ( det .ne. 0.0D+00 ) then
!                    calculate where the lines through the points would cross
                     xcross(iboom) = (b1 / det) * c2(iboom) - (b2(iboom) / det) * c1
                     ycross(iboom) = (a2(iboom) / det) * c1 - (a1 / det) * c2(iboom)

!                    relative distance of crosspoint between old and new location of particle
                     if (xnew .ne. xold) then
                        rl1 = (xcross(iboom) - xoldd) / (xnewd - xoldd)
                     else
                        rl1 = (ycross(iboom) - yoldd) / (ynewd - yoldd)
                     end if
!                    relative location of crosspoint on the boom
                     if (xboom(iboom+1) .ne. xboom(iboom)) then
                        rl2(iboom) = (xcross(iboom) - xboom(iboom)) / (xboom(iboom+1) - xboom(iboom))
                     else
                        rl2(iboom) = (ycross(iboom) - yboom(iboom)) / (yboom(iboom+1) - yboom(iboom))
                     end if
!                    both relative locations must be between 0.0 and 1.0 to cross
                     if ( (rl1 .ge. 0.0D0 .and. rl1 .le. 1.0D0) .and. (rl2(iboom) .ge. 0.0D0 .and. rl2(iboom) .le. 1.0D0)) then
!                       determine if this is the lowest relative location of the particle path
                        if (rl1 .lt. rlnear) then
                           catch = .true.
                           rlnear = rl1
                           inear = iboom
                        end if
                     end if
                  end if
               end if
            end if
         end do
         if (catch) then
!           return information about collision location
            xcrossboom(1) = xboom(inear)
            xcrossboom(2) = xboom(inear+1)
            ycrossboom(1) = yboom(inear)
            ycrossboom(2) = yboom(inear+1)
            xcatch = sngl(xcross(inear))
            ycatch = sngl(ycross(inear))
            npolbounce = inear

!           bounce without crossing boom?
            rl  = ((xboomd(inear) - xnewd) * b2(inear) + (ynewd - yboomd(inear)) * a2(inear)) / (b2(inear)**2 + a2(inear)**2)
            xn = xboomd(inear) - rl * b2(inear)
            yn = yboomd(inear) + rl * a2(inear)
!           potential location after bounce at boom
            xb = xn - (xnewd - xn)
            yb = yn - (ynewd - yn)
            bounce = .true.

!           fill matrix for particle track
            a1 = yb - yoldd
            b1 = xoldd - xb
            c1 = xb * yoldd - xoldd * yb
            xmin = min(xold, xb)
            xmax = max(xold, xb)
            ymin = min(yold, yb)
            ymax = max(yold, yb)

!           loop over booms, we saved some data from the previous loop (boomgap, a2, b2, c2)
            do iboom = 1, (nboom - 1)
!              when both old and new x- or y-coordinate are less or higher than both the boom x- or y-coordinate
               notnear = (xmax .lt. xboom(iboom) .and. xmax .lt. xboom(iboom+1)) .or. &
                         (xmin .gt. xboom(iboom) .and. xmin .gt. xboom(iboom+1)) .or. &
                         (ymax .lt. yboom(iboom) .and. ymax .lt. yboom(iboom+1)) .or. &
                         (ymin .gt. yboom(iboom) .and. ymin .gt. yboom(iboom+1))
!              if both are false we might have a colission (sorry for the double denial)
               if (.not.(iboom.eq.npolbounce) .and. bounce .and. (.not.boomgap(iboom) .and. .not. notnear)) then
!                 matrix determinant
                  det =  a1 * b2(iboom) - b1 * a2(iboom)
!                 when the determinant is zero, the lines are exactly parallel, and never cross
                  if ( det .ne. 0.0D+00 ) then
!                    calculate where the lines through the points would cross
                     xcross(iboom) = (b1 / det) * c2(iboom) - (b2(iboom) / det) * c1
                     ycross(iboom) = (a2(iboom) / det) * c1 - (a1 / det) * c2(iboom)

!                    relative distance of crosspoint between old and new location of particle
                     if (xb .ne. xold) then
                        rl1 = (xcross(iboom) - xoldd) / (xb - xoldd)
                     else
                        rl1 = (ycross(iboom) - yoldd) / (yb - yoldd)
                     end if
!                    relative location of crosspoint on the boom
                     if (xboom(iboom+1) .ne. xboom(iboom)) then
                        rl2(iboom) = (xcross(iboom) - xboom(iboom)) / (xboom(iboom+1) - xboom(iboom))
                     else
                        rl2(iboom) = (ycross(iboom) - yboom(iboom)) / (yboom(iboom+1) - yboom(iboom))
                     end if
!                    if both relative locations are between 0.0 and 1.0 we have crossed another part of the boom when bouncing,
!                    so boncing is not possible unless we would futher iterate
                     if ( (rl1 .ge. 0.0D0 .and. rl1 .le. 1.0D0) .and. (rl2(iboom) .ge. 0.0D0 .and. rl2(iboom) .le. 1.0D0)) then
                        bounce = .false.
                     end if
                  end if
               end if
            end do

!           return bouncing location
            xbounce = sngl(xb)
            ybounce = sngl(yb)
         end if
      end if
99999 if ( timon ) call timstop ( ithndl )
      return
      end subroutine boombounce

max_stars_repo_name: liujiamingustc/phd

max_issues_repo_name: liujiamingustc/phd

max_forks_repo_name: liujiamingustc/phd


text:
The American Brontosaurus Cabal of Davis Eristopia (ABCDE) is a member cabal of the wiki:wikipedia:Discordianism Discordian Church (also called the Erisian Church). Discordianism is a modern religion whose principal deity is wiki:wikipedia:Eris (mythology) Eris, the ancient Greek goddess of discord. Discordianism recognizes chaos, discord, and dissent as valid and desirable qualities, in contrast with most religions, which idealize harmony and order. Discordianism is centered on the idea that chaos is all that there is, and that disorder and orderthe former considered a concept distinct from chaosare both illusions. It was founded circa 1958–1959 by wiki:wikipedia:Malaclypse the Younger, who published its principal surviving sacred text, the wiki:wikipedia:Principia Discordia, and by wiki:wikipedia:Kerry Wendell Thornley Lord Omar Khayyam Ravenhurst, to whom its principal partially lost sacred text, The Honest Book of Truth, was revealed.  The Illuminatus! Trilogy is also considered good reading.

 Operations

Operation Mindfuck is one of the longest running operations of the Discordian Church.  Most cabals work apart on this project, which involves expanding the mind of your target(s) by putting them in contact with new ideas and philosophies.  Essentially, you force someone to learn something new about themselves and their world.  Like real fucking, it usually hurts the first time, but soon enough it becomes pleasurable.  ABCDE does not have any official OM projects.

Operation Write Your Congressman is an effort to get to know your representatives on a more personal level, and let them know what were really thinking about.  Inspired by St. Lazlo Toth, American, we seek action on important issues like universal health care and banning the recreational use and abuse of catnip.

Our Episkopos is working on The Big Book of Bureaucracy (tentatively titled), which seeks to document our Goddess least beloved form of chaos, and how it can make your life better.  Or at least funnier.

ABCDE Sponsored the 5505 Discordian Convergence, where we met Emperor Norton II.

 Ecumenicism

The American Brontosaurus Cabal of Davis Eristopia maintains discordant communion with the wiki:yubasutter:Yuba Erisian AppleSlinging Temple (YEAST).  They fully and completely endorse YEASTs Marriage Project (except the parts they oppose).

The ABCDE is not affiliated with the Campus Crusade for Chaos and Confusion.  Nope, no connection whatsoever.

 Discordianism Worldwide
 Popes
According to the Principia Discordia, a pope is every single man, woman, and child on this Earth. The Principia Discordia also states, A Pope is someone who is not under the authority of the authorities. It is up to each person to realize for herself or himself that she or he is already a Pope in the Discordian Church. The rights of a Pope include but are not necessarily limited to:

  To invoke infallibility at any time, including retroactively.
  To completely rework the Erisian church.
  To baptise, bury, and marry (with the permission of the deceased in the latter two cases).
  To excommunicate, deexcommunicate, reexcommunicate, and dereexcommunicate (no backsies!) both his/her/it/them/your/our/His/Her/It/Them/Your/Ourself/selves and others (if any).
  To perform all rites and functions deemed inappropriate for a Pope of Discordia.

 Original Snub
The Original Snub is the Discordian name for the events preceding the wiki:wikipedia:Judgment of Paris. wiki:wikipedia:Zeus snubbed Eris by not inviting her to the wedding of Peleus and Thetis. Eris responded by showing up at the wedding and slinging a golden apple with the word kallisti (Ancient Greek: καλλίστῃ, meaning for the prettiest one) inscribed in it into the proceedings. Three goddesses claimed the apple: wiki:wikipedia:Hera, wiki:wikipedia:Athena, and wiki:wikipedia:Aphrodite. A Phrygian mortal named Paris, who was renowned for his fair judgment, was asked to judge which of them was the prettiest one and thus which of them should have the golden apple. All three goddesses attempted to bribe Paris to choose them: Hera offered to make him king of Europe and Asia, Athena offered wisdom and skill in war, and Aphrodite offered the love of wiki:wikipedia:Helen of wiki:wikipedia:Sparta, the worlds most beautiful woman. Paris accepted Aphrodites gift and awarded the apple to her, receiving Helen but offending Hera and the Greeks. The Greeks expedition to retrieve Helen from Paris in Troy is the mythological basis of the wiki:wikipedia:Trojan War, which is said to be The First War among men.

 Pentabarf
The Pentabarf is the doctrine (catma) of Discordianism. It is as follows:

  There is no Goddess but Goddess and She is Your Goddess. There is no Erisian Movement but The Erisian Movement and it is The Erisian Movement. And every Golden Apple Corps is the beloved home of a Golden Worm.
  A Discordian Shall Always use the Official Discordian Document Numbering System.
  A Discordian is Required during his early Illumination to Go Off Alone & Partake Joyously of a Hot Dog on a Friday. This Devotive Ceremony to Remonstrate against the popular Paganisms of the Day: of Roman Catholic Churches Roman Catholic Christendomno meat on Friday, of Congregation Beth Shalom Judaismno meat of Pork, of Sri Narayan Hindu Temple Hindic Peoplesno meat of Beef, of Marysville Buddhist Church Buddhistsno meat of animal, and of Discordiansno Hot Dog Buns.
  A Discordian shall Partake of No Hot Dog Buns, for such was the Solace of Our Goddess when She was Confronted with The Original Snub.
  A Discordian is Prohibited from Believing What he Reads.

 Links
http://www.principiadiscordia.com Principia Discordia
http://www.discordian.com/discordian.html Discordian.com
http://www.kbuxton.com/discordia/ Discordianism
http://www.cs.cmu.edu/~tilt/principia/ Principia Discordia
wiki:yubasutter:Yuba Erisian AppleSlinging Temple
wiki:wikipedia:Discordianism
wiki:wikipedia:Eris (mythology)
wiki:wikipedia:Judgment of Paris
wiki:wikipedia:Malaclypse the Younger
wiki:wikipedia:Kerry Wendell Thornley Lord Omar Khayyam Ravenhurst
wiki:wikipedia:Pineal Gland
wiki:wikipedia:Operation Mindfuck
wiki:wikipedia:List of Discordian works

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
Ennui is a familiar affliction among students and Davis residents.  It is commonly known as boredom and it sucks.
Typical causes of Ennui
  Hot Summer summers
  Outskirts Extremely flat terrain
  A meager night time night life
  An overabundance of New Again family oriented public art
  The unfortunate lack of a RoboChair
Strategies for Combating Ennui
  Start a music scene band
  Commit some Urban Art vandalism
  Join the Craft Center
  Volunteer at KDVS
  Ride Critical Mass
  Go Swimming pool hopping
  Make some new Inanimate Objects with Amusing Faces friends
  Update Daviswiki with new Photo Requests pictures


text:
module assert_equals_within_absolute_test
    use double_precision_generator_m, only: DOUBLE_PRECISION_GENERATOR
    use iso_varying_string, only: var_str
    use vegetables, only: &
            double_precision_input_t, &
            input_t, &
            result_t, &
            test_item_t, &
            assert_equals_within_absolute, &
            assert_not, &
            assert_that, &
            describe, &
            fail, &
            it

    implicit none
    private
    public :: test_assert_equals_within_absolute

    character(len=*), parameter :: BOTH_MESSAGE = "Both Message"
    character(len=*), parameter :: SUCCESS_MESSAGE = "Success Message"
    character(len=*), parameter :: FAILURE_MESSAGE = "Failure Message"
contains
    function test_assert_equals_within_absolute() result(tests)
        type(test_item_t) :: tests

        tests = describe( &
                "assert_equals_within_absolute", &
                [ it( &
                        "passes with the same number even with very small tolerance", &
                        DOUBLE_PRECISION_GENERATOR, &
                        check_pass_for_same_number) &
                , it( &
                        "fails with sufficiently different numbers", &
                        DOUBLE_PRECISION_GENERATOR, &
                        check_fail_for_different_numbers) &
                , it( &
                        "passes with sufficiently close numbers", &
                        DOUBLE_PRECISION_GENERATOR, &
                        check_pass_for_close_numbers) &
                ])
    end function

    pure function check_pass_for_same_number(input) result(result_)
        class(input_t), intent(in) :: input
        type(result_t) :: result_

        double precision :: example
        type(result_t) :: example_result
        type(result_t) :: example_result_c
        type(result_t) :: example_result_s
        type(result_t) :: example_result_cc
        type(result_t) :: example_result_cs
        type(result_t) :: example_result_sc
        type(result_t) :: example_result_ss

        select type (input)
        type is (double_precision_input_t)
            example = input%input()
            example_result = assert_equals_within_absolute( &
                    example, example, tiny(0.0d0))
            example_result_c = assert_equals_within_absolute( &
                    example, example, tiny(0.0d0), BOTH_MESSAGE)
            example_result_s = assert_equals_within_absolute( &
                    example, example, tiny(0.0d0), var_str(BOTH_MESSAGE))
            example_result_cc = assert_equals_within_absolute( &
                    example, &
                    example, &
                    tiny(0.0d0), &
                    SUCCESS_MESSAGE, &
                    FAILURE_MESSAGE)
            example_result_cs = assert_equals_within_absolute( &
                    example, &
                    example, &
                    tiny(0.0d0), &
                    SUCCESS_MESSAGE, &
                    var_str(FAILURE_MESSAGE))
            example_result_sc = assert_equals_within_absolute( &
                    example, &
                    example, &
                    tiny(0.0d0), &
                    var_str(SUCCESS_MESSAGE), &
                    FAILURE_MESSAGE)
            example_result_ss = assert_equals_within_absolute( &
                    example, &
                    example, &
                    tiny(0.0d0), &
                    var_str(SUCCESS_MESSAGE), &
                    var_str(FAILURE_MESSAGE))
            result_ = &
                    assert_that( &
                            example_result%passed(), &
                            example_result%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_c%passed(), &
                            example_result_c%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_s%passed(), &
                            example_result_s%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_cc%passed(), &
                            example_result_cc%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_cs%passed(), &
                            example_result_cs%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_sc%passed(), &
                            example_result_sc%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_ss%passed(), &
                            example_result_ss%verbose_description(.false.))
        class default
            result_ = fail("Expected to get a double_precision_input_t")
        end select
    end function

    pure function check_fail_for_different_numbers(input) result(result_)
        class(input_t), intent(in) :: input
        type(result_t) :: result_

        double precision :: example
        type(result_t) :: example_result
        type(result_t) :: example_result_c
        type(result_t) :: example_result_s
        type(result_t) :: example_result_cc
        type(result_t) :: example_result_cs
        type(result_t) :: example_result_sc
        type(result_t) :: example_result_ss

        select type (input)
        type is (double_precision_input_t)
            example = input%input()
            example_result = assert_equals_within_absolute( &
                    example, example+0.2d0, 0.1d0)
            example_result_c = assert_equals_within_absolute( &
                    example, example+0.2d0, 0.1d0, BOTH_MESSAGE)
            example_result_s = assert_equals_within_absolute( &
                    example, example+0.2d0, 0.1d0, var_str(BOTH_MESSAGE))
            example_result_cc = assert_equals_within_absolute( &
                    example, &
                    example+0.2d0, &
                    0.1d0, &
                    SUCCESS_MESSAGE, &
                    FAILURE_MESSAGE)
            example_result_cs = assert_equals_within_absolute( &
                    example, &
                    example+0.2d0, &
                    0.1d0, &
                    SUCCESS_MESSAGE, &
                    var_str(FAILURE_MESSAGE))
            example_result_sc = assert_equals_within_absolute( &
                    example, &
                    example+0.2d0, &
                    0.1d0, &
                    var_str(SUCCESS_MESSAGE), &
                    FAILURE_MESSAGE)
            example_result_ss = assert_equals_within_absolute( &
                    example, &
                    example+0.2d0, &
                    0.1d0, &
                    var_str(SUCCESS_MESSAGE), &
                    var_str(FAILURE_MESSAGE))
            result_ = &
                    assert_not( &
                            example_result%passed(), &
                            example_result%verbose_description(.false.)) &
                    .and.assert_not( &
                            example_result_c%passed(), &
                            example_result_c%verbose_description(.false.)) &
                    .and.assert_not( &
                            example_result_s%passed(), &
                            example_result_s%verbose_description(.false.)) &
                    .and.assert_not( &
                            example_result_cc%passed(), &
                            example_result_cc%verbose_description(.false.)) &
                    .and.assert_not( &
                            example_result_cs%passed(), &
                            example_result_cs%verbose_description(.false.)) &
                    .and.assert_not( &
                            example_result_sc%passed(), &
                            example_result_sc%verbose_description(.false.)) &
                    .and.assert_not( &
                            example_result_ss%passed(), &
                            example_result_ss%verbose_description(.false.))
        class default
            result_ = fail("Expected to get a double_precision_input_t")
        end select
    end function

    pure function check_pass_for_close_numbers(input) result(result_)
        class(input_t), intent(in) :: input
        type(result_t) :: result_

        double precision :: example
        type(result_t) :: example_result
        type(result_t) :: example_result_c
        type(result_t) :: example_result_s
        type(result_t) :: example_result_cc
        type(result_t) :: example_result_cs
        type(result_t) :: example_result_sc
        type(result_t) :: example_result_ss

        select type (input)
        type is (double_precision_input_t)
            example = input%input()
            example_result = assert_equals_within_absolute( &
                    example, example+0.05d0, 0.1d0)
            example_result_c = assert_equals_within_absolute( &
                    example, example+0.05d0, 0.1d0, BOTH_MESSAGE)
            example_result_s = assert_equals_within_absolute( &
                    example, example+0.05d0, 0.1d0, var_str(BOTH_MESSAGE))
            example_result_cc = assert_equals_within_absolute( &
                    example, &
                    example+0.05d0, &
                    0.1d0, &
                    SUCCESS_MESSAGE, &
                    FAILURE_MESSAGE)
            example_result_cs = assert_equals_within_absolute( &
                    example, &
                    example+0.05d0, &
                    0.1d0, &
                    SUCCESS_MESSAGE, &
                    var_str(FAILURE_MESSAGE))
            example_result_sc = assert_equals_within_absolute( &
                    example, &
                    example+0.05d0, &
                    0.1d0, &
                    var_str(SUCCESS_MESSAGE), &
                    FAILURE_MESSAGE)
            example_result_ss = assert_equals_within_absolute( &
                    example, &
                    example+0.05d0, &
                    0.1d0, &
                    var_str(SUCCESS_MESSAGE), &
                    var_str(FAILURE_MESSAGE))
            result_ = &
                    assert_that( &
                            example_result%passed(), &
                            example_result%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_c%passed(), &
                            example_result_c%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_s%passed(), &
                            example_result_s%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_cc%passed(), &
                            example_result_cc%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_cs%passed(), &
                            example_result_cs%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_sc%passed(), &
                            example_result_sc%verbose_description(.false.)) &
                    .and.assert_that( &
                            example_result_ss%passed(), &
                            example_result_ss%verbose_description(.false.))
        class default
            result_ = fail("Expected to get a double_precision_input_t")
        end select
    end function
end module

max_stars_repo_name: everythingfunctional/vegetables

max_issues_repo_name: everythingfunctional/vegetables

max_forks_repo_name: everythingfunctional/vegetables


text:
      subroutine potslw (dv,d,dr,dpas,np)
c
c coulomb potential uses a 4-point integration method
c dv=potential;  d=density;  dp=bloc de travail; dr=radial mesh
c dpas=exponential step;
c np=number of points
c **********************************************************************

      implicit double precision (a-h,o-z)
      dimension dv(251), d(251), dp(251), dr(251)

      das=dpas/24.0
      do i=1,np
         dv(i)=d(i)*dr(i)
      enddo
      dlo=exp(dpas)
      dlo2=dlo*dlo
      dp(2)=dr(1)*(d(2)-d(1)*dlo2)/(12.0*(dlo-1.0))
      dp(1)=dv(1)/3.0-dp(2)/dlo2
      dp(2)=dv(2)/3.0-dp(2)*dlo2
      j=np-1
      do i=3,j
         dp(i)=dp(i-1)+das*(13.0*(dv(i)+dv(i-1))-(dv(i-2)+dv(i+1)))
      enddo
      dp(np)=dp(j)
      dv(j)=dp(j)
      dv(np)=dp(j)
      do i=3,j
         k=np+1-i
         dv(k)=dv(k+1)/dlo+das*
     $        (13.0*(dp(k+1)/dlo+dp(k)) - (dp(k+2)/dlo2 + dp(k-1)*dlo))
      enddo
      dv(1)=dv(3)/dlo2+dpas*(dp(1)+4.0*dp(2)/dlo+dp(3)/dlo2)/3.0
      do i=1,np
         dv(i)=dv(i)/dr(i)
      enddo
      return
      end


text:
c       Make the Green Function bank
c       Input name
c       Input dep_max dep_min dep_step
c       Input dist_max dist_min d_step
c       Input numdt dt,t_cor
c       Input Green_name
c       output Green

	include "model.h"

c	parameter(block_g=nt*32+100)
c	dimension green(ndis,nt,8),dist(ndis)
        real c(nlay), s(nlay),den(nlay),th(nlay),qa(nlay),qb(nlay)
	real dist(ndis),t0(ndis),tmin(ndis),t_cor,depth
	real distChange,depthMinUsed
	integer changeNx,residualNx,ii
	integer nstep1,nstep2,i
	real d_step2
	real distances(ndis)
	integer block_gg,jo,nb,numdt,ncom_out
	character*60 name, output,junk
        complex sum(ndis,9,nt)
        common/model_new/jo,nb,c,s,den,th,qa,qb,ncom_out

	open(1,file="GreenFar.in")

	write(*,*)"Input name of velocity model"
	read(1,1) name

	write(*,*)"input Max., Min., and step of epicenter depth"
	read(1,*) dep_max, dep_min, dep_step

	write(*,*)"input Max., Min., and step of epicenter distance"
	read(1,*) dist_min,d_step,nstep1,d_step2,nstep2

	write(*,*)"input number of time-point, time-step, and seconds",
     &            " to save before first-arrival"
	read(1,*) numdt,dt,t_cor

	write(*,*)"Input the outputfile"
	read(1,1) output
	write(*,*) output

	write(*,*)"Input the change distance and minimal depth actually used further"
	read(1,*) depthMinUsed, changeNx
	write(*,*) depthMinUsed, changeNx
1	format(a)

	dist_max=dist_min+nstep1*d_step+nstep2*d_step2
	write(*,*) 'maximal distance ',dist_max
c now compute distance table
	distances(1)=dist_min
	do i=1,nstep1
		distances(i+1)=distances(1)+i*d_step
	end do
	do i=1,nstep2
		distances(i+1+nstep1)=distances(i+nstep1)+d_step2
	end do
	nx=nstep1+nstep2+1
	do i=1,nx
		write(*,*) distances(i)
	end do
	lnpt=0
	npt=1
101	lnpt=lnpt+1
	npt=npt*2
	if(npt .lt. numdt) goto 101

	if(npt.gt.nt)then
	write(*,*)  "Please increase <nt> in model.h to ",npt
	stop
	endif
	if(dep_max.lt.dep_min)then
	   pause "The depth region is wrong"
	endif
	if(dist_max.lt.dist_min)then
	   pause "distance region is wrong"
	endif

	residualNx=nx-changeNx
	distChange=dist_min+nstep1*d_step
	nz=int((dep_max-dep_min)/dep_step)+1
	block_gg=4*(npt*8+7)+12

	write(*,*) 'total nx and nz =',nx,nz
	write(*,*) 'change dist for changeNx=',changeNx
	if(nx.gt.ndis) then
	  write(*,*)  "Please increase <ndis> in model.h to ",nx
	  stop
	endif

	open(11,file=output,status='unknown',access='direct',
     1	        recl=block_gg)
	nhfpt=npt/2
	ll=0
	do iz=1,nz
	   depth=dep_min + (iz-1)*dep_step
C inclded this line, use a different depth is too shallow, only for stations far out
	   if(depth.lt.depthMinUsed) then
	   	do k=1,changeNx
	   	   dist(k)=distances(k)
		write(*,*) dist(k)
	   	enddo
	   	io_model=30
	   	open(unit=io_model,file=name,status='old')
	   	call cmodel(io_model,depth)
	   	call trav(dist,changeNx,tmin)

	   	do k=1,changeNx
	   	   t0(k)=tmin(k)-t_cor
		   write(*,*) 'dist1: ',dist(k),' t0 ',t0(k)
	   	enddo

		   call sub_bs_dc(changeNx,dist,distChange,lnpt,dt,t0,sum)
		   do k=1,changeNx
		      ll=ll+1
	      write(11,rec=ll) iz,k,dist(k),t0(k),depth,dt,npt,
     1	        ((real(sum(k,n_com,ntc)),aimag(sum(k,n_com,ntc)),
     2            ntc=1,nhfpt),n_com=1,8)
		   enddo
		   close(30)
C now for stations further out use different depth in computation
		depth=depthMinUsed
		ii=1
	   	do k=changeNx+1,nx
	   	   dist(ii)=distances(k)
		   write(*,*) 'dist2: ',dist(ii),' resNX ',residualNx,' ii ',ii
		   ii=ii+1
	  	 enddo
	  	 io_model=30
	  	 open(unit=io_model,file=name,status='old')
	  	 call cmodel(io_model,depth)
	  	 call trav(dist,residualNx,tmin)

		   do k=1,residualNx
		      t0(k)=tmin(k)-t_cor
		      write(*,*) 'dist1: ',dist(k),' t0 ',t0(k)
		   enddo

		   call sub_bs_dc(residualNx,dist,dist_max,lnpt,dt,t0,sum)
C but write actually the depth that should have been used, otherwise there will be an error in syn1d
		   depth=dep_min + (iz-1)*dep_step
		   do k=1,residualNx
		      ll=ll+1
	      write(11,rec=ll) iz,k,dist(k),t0(k),depth,dt,npt,
     1	        ((real(sum(k,n_com,ntc)),aimag(sum(k,n_com,ntc)),
     2            ntc=1,nhfpt),n_com=1,8)
		   enddo
		   close(30)
	   else
	   	do k=1,nx
	   	   dist(k)=distances(k)
	   	enddo
	   	io_model=30
	   	open(unit=io_model,file=name,status='old')
	   	call cmodel(io_model,depth)
	   	call trav(dist,nx,tmin)

	   	do k=1,nx
	   	   t0(k)=tmin(k)-t_cor
	   	enddo

	   	call sub_bs_dc(nx,dist,dist_max,lnpt,dt,t0,sum)
	   	do k=1,nx
	   	   ll=ll+1
	      write(11,rec=ll) iz,k,dist(k),t0(k),depth,dt,npt,
     1	        ((real(sum(k,n_com,ntc)),aimag(sum(k,n_com,ntc)),
     2            ntc=1,nhfpt),n_com=1,8)
		   enddo
	   	close(30)
	  endif
	  write(*,*) 'depth = ',iz,depth
	   if(iz<10) then
		   write(junk,'(I1)') iz
	 endif
	   if(iz>=10) then
		   write(junk,'(I2)') iz
	 endif
	   open(12,file='test'//junk)
	   write(12,*)1
	   write(12,*)"(7e11.4)"
	   if(depth.lt.depthMinUsed) then
	   do n_com=1,8
	      write(12,*)dist(1),t0(1)
	      write(12,*)npt,dt
	      write(12,*)((real(sum(residualNx,n_com,ntc)),aimag(sum(residualNx,n_com,ntc))),ntc=1,nhfpt)

	   enddo
	else
	   do n_com=1,8
	      write(12,*)dist(1),t0(1)
	      write(12,*)npt,dt
	      write(12,*)((real(sum(nx,n_com,ntc)),aimag(sum(nx,n_com,ntc))),ntc=1,nhfpt)

	   enddo
	endif
	close(12)
	enddo
	close(11)
	close(10)

	open(19,file='Green_Bank.inf',status='unknown')
	write(19,*) "Name of velocity model"
	write(19,'(a)') name
	write(19,*) "Maximum, Minimum, and Step of Epicenter Depth"
	write(19,*) dep_max, dep_min, dep_step
	write(19,*)"Minimum, Step1 and N1, and Step2 and N2 of Epicenter Distance"
	write(19,*) dist_min,d_step,nstep1,d_step2,nstep2
	write(19,*)"The lnpt, dt, block_gg, t_cor"
	write(19,*) lnpt,dt,block_gg,t_cor
	write(19,*)"The name of file to store Green Bank"
	write(19,'(a)') output
	write(19,*)"The number of GreenFunctions in Distance and Depth"
	write(19,*) nx,nz
	write(19,*) "Velocity Structure model"
	write(19,*) jo,nb
	do jj=1,jo
	  write(19,*) th(jj),c(jj), s(jj),den(jj),qa(jj),qb(jj)
	enddo
	close(19)

	stop
	end

max_stars_repo_name: kevinmilner/bbp

max_issues_repo_name: kevinmilner/bbp

max_forks_repo_name: kevinmilner/bbp


text:
subroutine compare_var (vari, varo)
  use varspecs_mod, only: varspecs

  implicit none

  include 'netcdf.inc'
!
! Input arguments
!
  type(varspecs) :: vari
  type(varspecs) :: varo
!
! Local workspace
!
  logical isfloatingi
  logical isfloatingo

  if (vari%name /= varo%name) then
    write(6,*)'compare_var: names do not match: ', trim(vari%name), trim(varo%name)
    stop 999
  end if

  isfloatingi = vari%xtype == nf_float .or. vari%xtype == nf_double
  isfloatingo = varo%xtype == nf_float .or. varo%xtype == nf_double

  if (vari%xtype /= varo%xtype .and. .not. (isfloatingi .and. isfloatingo)) then
    write(6,*)'compare_var: types are incompatible for: ', &
              trim(vari%name), ' ', trim(varo%name)
  end if

  return
end subroutine compare_var

max_stars_repo_licenses: zlib-acknowledgement FTL RSA-MD

max_issues_repo_licenses: zlib-acknowledgement FTL RSA-MD

max_forks_repo_licenses: zlib-acknowledgement FTL RSA-MD


text: y <= a and b and d;