# ADAS Subroutine h4gasy

C
subroutine h4gasy( istdim ,
& x , dx ,
& form , iforms , iends
& )
c-----------------------------------------------------------------------
c
c **************** fortran77 subroutine: h4gasy.for *******************
c
c purpose: initialises common arrays required for splining with
c smooth fitting to an asymptotic form
c
c calling program: various
c
c notes: (1) uses labelled common /espl3/
c (2) common /espl3/ is set by this routine
c (3) conditions at 1st & nth nodes controlled by iend1 & iendn
c iend = 1 : specified d log(y) ie. dy/y at node stored in
c appropriate vector
c = 2 : zero curvature
c = 3 : constant curvature
c = 4 : matched to specified functional form in terms of
c two parameters a and b such that
c funct = p(1)*a+q(1)*b
c 1st deriv. = p(2)*a+q(2)*b
c 2nd deriv. = p(3)*a+q(3)*b
c where a1,b1,p1,q1 are used for 1st node and
c an,bn,pn,qn for nth node
c
c (4) if iends=1,matching is at first knot(given by x)
c =2,matching is at last knot(given by x)
c asymptotic forms are given in external function form(i,x)
c where i=4*iforms-5+2*iends points to 1st part of asymp. form
c =4*iforms-4+2*iends points to 2nd part of asymp. form
c thus a series of asymptotic forms may be present in form
c
c
c input : (i*4) istdim = dimensionality for splining arrays
c
c input : (i*4) n = number of knots
c common /espl3/ provides input in vector iend which specifies
c choice of end condition at first iend(1) or last
c iend(2) knot of spline
c input : (r*8) x = x-value of end point
c input : (r*8) dx = displacement from x-value for
c derivative evaluation
c input : (r*8) form = external function specifying asymptotic forms
c input : (i*4) iforms = selected form
c input : (i*4) iends = 1,matching is at first knot(given by x)
c = 2,matching is at last knot(given by x)
c
c
c routines:
c routine source brief description
c -------------------------------------------------------------
c i4unit adas fetch unit number for output of messages
c
c author: Hugh P. Summers, University of Strathclyde
c JA7.08
c Tel.: +44 (0)141-548-4196
c
c date: 24 July 2002
c
c
c version: 1.1 Hugh Summers 24/07/02
c modified: first release
c-----------------------------------------------------------------------
INTEGER IENDS, IFORMS, ISTDIM
REAL*8 DX, X