pprofile_T.f

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!  The @header, @table_section, @table_subsection, @item and @end_table commands
!  are custom defined commands in Doxygen.in. They are defined under ALIASES.
!  For the page created here, the 80 column limit is exceeded. Arguments of
!  aliases are separated by ','. If you intended ',' to be a string you must use
!  an escaped comma '\,'.
!
!*******************************************************************************
!
!  Note separating the Doxygen comment block here so detailed decription is
!  found in the Module not the file.
!
!*******************************************************************************
      MODULE pprofile_t
      USE stel_kinds
      USE stel_constants
      USE v3_utilities
      USE mpi_inc
      USE profiler
 
      IMPLICIT NONE
 
!*******************************************************************************
!  model module parameters
!*******************************************************************************
      INTEGER, PARAMETER, PUBLIC :: p_type_len=20
 
      INTEGER, PARAMETER, PUBLIC :: ilb_b   = 0
      INTEGER, PARAMETER, PUBLIC :: iub_b   = 21
      INTEGER, PARAMETER, PUBLIC :: iub_asf = 101
 
      INTEGER, PARAMETER, PRIVATE :: pprofile_none_type           = -1
      INTEGER, PARAMETER, PRIVATE :: pprofile_two_power_type      = 0
      INTEGER, PARAMETER, PRIVATE :: pprofile_two_power_gs_type   = 1
      INTEGER, PARAMETER, PRIVATE :: pprofile_power_series_type   = 2
      INTEGER, PARAMETER, PRIVATE :: pprofile_cubic_spline_type   = 3
      INTEGER, PARAMETER, PRIVATE :: pprofile_akima_spline_type   = 4
      INTEGER, PARAMETER, PRIVATE :: pprofile_line_segment_type   = 5
      INTEGER, PARAMETER, PRIVATE :: pprofile_two_power_r_type    = 6
      INTEGER, PARAMETER, PRIVATE :: pprofile_gp_1d_sexp_type     = 7
      INTEGER, PARAMETER, PRIVATE :: pprofile_gp_1d_ln_sexp_type  = 8
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) model class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE pprofile_class
         INTEGER :: p_type = pprofile_none_type
         REAL (rprec), DIMENSION(ilb_b:iub_b) :: b = 0.0
         REAL (rprec), DIMENSION(:), POINTER  :: as => null()
         REAL (rprec), DIMENSION(:), POINTER  :: af => null()
         INTEGER                              :: maxsplineindex = 1
 
         REAL (rprec), DIMENSION(:), POINTER  :: cache => null()
         REAL (rprec), DIMENSION(:), POINTER  :: cache_hyper => null()
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE pprofile_pointer
         TYPE (pprofile_class), POINTER :: p => null()
      END TYPE
 
!*******************************************************************************
! SECTION III. INTERFACE BLOCKS
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE pprofile_get_gp
         MODULE PROCEDURE pprofile_get_gp_ij,                                  &
     &                    pprofile_get_gp_pi,                                  &
     &                    pprofile_get_gp_pp
      END INTERFACE
 
      PRIVATE findmaxindex
 
      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pprofile_construct(p_type, b, as, af)
 
      IMPLICIT NONE
 
!  Declare Arguments 
      TYPE (pprofile_class), POINTER :: pprofile_construct
      CHARACTER (len=*), INTENT(in)         :: p_type
      REAL(rprec), DIMENSION(:), INTENT(in) :: b
      REAL(rprec), DIMENSION(:), INTENT(in) :: as
      REAL(rprec), DIMENSION(:), INTENT(in) :: af
 
!  local variables
      CHARACTER (len=p_type_len)            :: p_type_lc
      REAL (rprec)                          :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(pprofile_construct)
 
! Store profile coeffients.
      pprofile_construct%b = b
 
! Find and store the maximum s index if specifying splines.
      pprofile_construct%maxSplineIndex = findmaxindex(as)
      ALLOCATE(pprofile_construct%as(pprofile_construct%maxSplineIndex))
      pprofile_construct%as = as(1:pprofile_construct%maxSplineIndex)
 
      ALLOCATE(pprofile_construct%af(pprofile_construct%maxSplineIndex))
      pprofile_construct%af = af(1:pprofile_construct%maxSplineIndex)
 
!  Convert the type to lower case, and truncate
      p_type_lc = p_type
      CALL tolower(p_type_lc)
      SELECT CASE(trim(p_type_lc))
      
         CASE ('two_power')
            pprofile_construct%p_type = pprofile_two_power_type
 
         CASE ('two_power_gs')
            pprofile_construct%p_type = pprofile_two_power_gs_type
 
         CASE ('two_power_r')
            pprofile_construct%p_type = pprofile_two_power_r_type
 
         CASE ('power_series')
            pprofile_construct%p_type = pprofile_power_series_type
 
         CASE ('cubic_spline')
            IF (pprofile_construct%maxSplineIndex .lt. 4) THEN
               WRITE(*,*) 'pprofile:cubic spline: too few as values'
               WRITE(*,*) 'maxSplineIndex, as = ',                             &
     &                    pprofile_construct%maxSplineIndex
               WRITE(*,*) pprofile_construct%as
               CALL exit(1)
            END IF
            pprofile_construct%p_type = pprofile_cubic_spline_type
 
         CASE ('akima_spline')
            IF (pprofile_construct%maxSplineIndex .lt. 4) THEN
               WRITE(*,*) 'pprofile:akima spline: too few as values'
               WRITE(*,*) 'maxSplineIndex, as = ',                             &
     &                    pprofile_construct%maxSplineIndex
               WRITE(*,*) pprofile_construct%as
               CALL exit(1)
            END IF
            pprofile_construct%p_type = pprofile_akima_spline_type
 
         CASE ('line_segment')
            pprofile_construct%p_type = pprofile_line_segment_type
 
         CASE ('sq_exp_1d')
            pprofile_construct%p_type = pprofile_gp_1d_sexp_type
            ALLOCATE(pprofile_construct%cache(                                 &
     &                  SIZE(pprofile_construct%af)))
            ALLOCATE(pprofile_construct%cache_hyper(2))
 
         CASE ('sq_exp_1d_ln')
            pprofile_construct%p_type = pprofile_gp_1d_ln_sexp_type
            ALLOCATE(pprofile_construct%cache(                                 &
     &                  SIZE(pprofile_construct%af)))
            ALLOCATE(pprofile_construct%cache_hyper(2))
 
         CASE ('none')
            pprofile_construct%p_type = pprofile_none_type
 
         CASE DEFAULT
            pprofile_construct%p_type = pprofile_none_type
            WRITE(*,*) 'Unrecognized p_type:', p_type_lc
            WRITE(*,*) ' *** CHECK YOUR INPUT ***'
         
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_construct', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE pprofile_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments 
      TYPE (pprofile_class), POINTER :: this
 
!  Start of executable code
      IF (ASSOCIATED(this%as)) THEN
         DEALLOCATE(this%as)
         this%as => null()
      END IF
 
      IF (ASSOCIATED(this%af)) THEN
         DEALLOCATE(this%af)
         this%af => null()
      END IF
 
      IF (ASSOCIATED(this%cache)) THEN
         DEALLOCATE(this%cache)
         this%cache => null()
      END IF
 
      IF (ASSOCIATED(this%cache_hyper)) THEN
         DEALLOCATE(this%cache_hyper)
         this%cache_hyper => null()
      END IF
 
      DEALLOCATE(this)
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pprofile_get_value(this, s_arg)
      USE line_segment
      USE functions
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                       :: pprofile_get_value
      TYPE (pprofile_class), INTENT (in) :: this
      REAL (rprec), INTENT(in)           :: s_arg
 
!  local variables
      REAL (rprec)                       :: s_use
      REAL (rprec)                       :: s_01
      LOGICAL                            :: l_01
      INTEGER                            :: i
      INTEGER                            :: iflag
      REAL (rprec)                       :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  Define argument and logical variable for s between zero and one
      s_01 = max(zero, min(one,s_arg))
      l_01 = (s_arg .ge. zero) .and. (s_arg .le. one)
 
      SELECT CASE(this%p_type)
      
         CASE (pprofile_none_type)
            pprofile_get_value = -1.e49_rprec
 
! v3fit uses an extra varible as an offset than vmec as a result the b array is
! one index shorter than what two_power takes.
         CASE (pprofile_two_power_type)
            pprofile_get_value = this%b(0)
            IF (l_01) THEN
               pprofile_get_value = pprofile_get_value                         &
     &                            + two_power(s_arg, this%b(1:iub_b))
            END IF
 
! v3fit uses an extra varible as an offset than vmec as a result the b array is
! one index shorter than what two_power takes. This profile reverses the s
! argument so that the maximum amplitude is at s=1 and the minimum is at s = 0.
         CASE (pprofile_two_power_r_type)
            pprofile_get_value = this%b(0)
            IF (l_01) THEN
               s_use = 1.0 - s_arg
               pprofile_get_value = pprofile_get_value                         &
     &                            + two_power(s_use, this%b(1:iub_b))
            END IF
 
! v3fit uses an extra varible as an offset than vmec as a result the b array is
! one index shorter than what two_power_gs takes. As a result only 5 guassian
! peaks maybe specified instead of the 6 vmec can use.
         CASE (pprofile_two_power_gs_type)
            pprofile_get_value = this%b(0)
            IF (l_01) THEN
               pprofile_get_value = pprofile_get_value                         &
     &                            + two_power_gs(s_arg,                        &
     &                                           this%b(1:iub_b))
            END IF
      
         CASE (pprofile_power_series_type)
            pprofile_get_value = zero
            DO i = iub_b, ilb_b, -1      ! all of b array, backwards
               pprofile_get_value = pprofile_get_value*s_01                    &
     &                            + this%b(i)
            END DO
 
         CASE (pprofile_cubic_spline_type)
            s_use = min(this%as(this%maxSplineIndex),                          &
     &                  max(s_arg, this%as(1)))
            CALL spline_cubic(s_use, pprofile_get_value,                       &
     &                        this%as, this%af,                                &
     &                        this%maxSplineIndex, iflag)
            IF (iflag .ge. 0) THEN
 
               CALL profiler_set_stop_time('pprofile_get_value',               &
     &                                     start_time)
 
               RETURN
            ELSE IF (iflag .eq. -1) THEN
               WRITE (*,*) 'ERROR: pprofile: outside value from ' //           &
     &                     'spline_cubic'
            ELSE IF(iflag .eq. -2) THEN
               WRITE (*,*) 'ERROR: pprofile:  decreasing s values ' //         &
     &                     'in spline_cubic'
            ELSE
               WRITE (*,*) 'ERROR: pprofile: unknown error from ' //           &
     &                     'spline_cubic'
            END IF
!  Splines shuld not reach this point without triggering an error.
            CALL exit(1)
 
         CASE (pprofile_akima_spline_type)
            s_use = min(this%as(this%maxSplineIndex),                          &
     &                  max(s_arg,this%as(1)))
            CALL spline_akima(s_use, pprofile_get_value,                       &
     &                        this%as, this%af,                                &
     &                        this%maxSplineIndex, iflag)
            IF (iflag < 0) THEN
               WRITE (*,*) 'ERROR: pprofile: bad value from ' //               &
     &                     'spline_akima requested'
               CALL exit(1)
            END IF
 
         CASE (pprofile_line_segment_type,                                     &
     &         pprofile_gp_1d_sexp_type,                                       &
     &         pprofile_gp_1d_ln_sexp_type)
            CALL line_seg(s_arg, pprofile_get_value, this%as, this%af,         &
     &                    this%maxSplineIndex)
         
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_get_value', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pprofile_get_p_type_name(this)
 
!  Declare Arguments
      CHARACTER (len=p_type_len)        :: pprofile_get_p_type_name
      TYPE (pprofile_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                      :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE (this%p_type)
 
         CASE (pprofile_two_power_type)
            pprofile_get_p_type_name = 'two_power'
 
         CASE (pprofile_two_power_gs_type)
            pprofile_get_p_type_name = 'two_power_gs'
 
         CASE (pprofile_two_power_r_type)
            pprofile_get_p_type_name = 'two_power_r'
 
         CASE (pprofile_power_series_type)
            pprofile_get_p_type_name = 'power_series'
 
         CASE (pprofile_cubic_spline_type)
            pprofile_get_p_type_name = 'cubic_spline'
 
         CASE (pprofile_akima_spline_type)
            pprofile_get_p_type_name = 'akima_spline'
 
         CASE (pprofile_line_segment_type)
            pprofile_get_p_type_name = 'line_segment'
 
         CASE (pprofile_gp_1d_sexp_type)
            pprofile_get_p_type_name = 'sq_exp_1d'
 
         CASE (pprofile_gp_1d_ln_sexp_type)
            pprofile_get_p_type_name = 'sq_exp_1d_ln'
 
         CASE DEFAULT
            pprofile_get_p_type_name = 'none'
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_get_p_type_name',                  &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pprofile_get_gp_ij(this, i, j)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                       :: pprofile_get_gp_ij
      TYPE (pprofile_class), INTENT (in) :: this
      INTEGER, INTENT(in)                :: i
      INTEGER, INTENT(in)                :: j
 
!  local variables
      REAL (rprec)                       :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE(this%p_type)
 
         CASE (pprofile_gp_1d_sexp_type)
            pprofile_get_gp_ij = pprofile_gp_1d_sqexp_k(this,                  &
     &                                                  this%as(i),            &
     &                                                  this%as(j))
 
         CASE (pprofile_gp_1d_ln_sexp_type)
            pprofile_get_gp_ij = pprofile_gp_1d_sqexp_ln_k(this,               &
     &                                                     this%as(i),         &
     &                                                     this%as(j))
 
         CASE DEFAULT
            pprofile_get_gp_ij = 0.0
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_get_gp_ij', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pprofile_get_gp_pi(this, p, i)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                       :: pprofile_get_gp_pi
      TYPE (pprofile_class), INTENT (in) :: this
      REAL (rprec), INTENT(in)           :: p
      INTEGER, INTENT(in)                :: i
 
!  local variables
      REAL (rprec)                       :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE(this%p_type)
 
         CASE (pprofile_gp_1d_sexp_type)
            pprofile_get_gp_pi = pprofile_gp_1d_sqexp_k(this, p,               &
     &                                                  this%as(i))
 
         CASE (pprofile_gp_1d_ln_sexp_type)
            pprofile_get_gp_pi = pprofile_gp_1d_sqexp_ln_k(this, p,            &
     &                                                     this%as(i))
 
         CASE DEFAULT
            pprofile_get_gp_pi = 0.0
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_get_gp_pi', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pprofile_get_gp_pp(this, p1, p2)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                       :: pprofile_get_gp_pp
      TYPE (pprofile_class), INTENT (in) :: this
      REAL (rprec), INTENT(in)           :: p1
      REAL (rprec), INTENT(in)           :: p2
 
!  local variables
      REAL (rprec)                       :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE(this%p_type)
 
         CASE (pprofile_gp_1d_sexp_type)
            pprofile_get_gp_pp = pprofile_gp_1d_sqexp_k(this, p1, p2)
 
         CASE (pprofile_gp_1d_ln_sexp_type)
            pprofile_get_gp_pp = pprofile_gp_1d_sqexp_ln_k(this, p1, p2)
 
         CASE DEFAULT
            pprofile_get_gp_pp = 0.0
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_get_gp_pp', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pprofile_get_gp_num_hyper_param(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER :: pprofile_get_gp_num_hyper_param
      TYPE (pprofile_class), INTENT (in) :: this
 
!  local variables
      REAL (rprec)                       :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE(this%p_type)
 
         CASE (pprofile_gp_1d_sexp_type, pprofile_gp_1d_ln_sexp_type)
            pprofile_get_gp_num_hyper_param = 2
 
         CASE DEFAULT
            pprofile_get_gp_num_hyper_param = 0
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_get_gp_num_hyper_param',           &
     &                            start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  UTILITY SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE pprofile_write(this, id, iou)
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (pprofile_class), INTENT(in) :: this
      CHARACTER (len=*), INTENT(in)     :: id
      INTEGER, INTENT(in)               :: iou
 
!  local variables
      INTEGER                           :: i
      REAL (rprec)                      :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  Actual write. Could do a select-case on p_type.
      WRITE(iou,1100) id
      WRITE(iou,1200) trim(pprofile_get_p_type_name(this))
      
      SELECT CASE(this%p_type)
         
         CASE (pprofile_two_power_type,                                        &
     &         pprofile_two_power_r_type)
            WRITE(iou,1210)
            WRITE(iou,1300) this%b(0:3)
 
         CASE (pprofile_power_series_type,                                     &
     &         pprofile_two_power_gs_type)
            WRITE(iou,1220)
            WRITE(iou,1300) this%b(ilb_b:iub_b)
            
         CASE (pprofile_cubic_spline_type,                                     &
     &         pprofile_akima_spline_type,                                     &
     &         pprofile_line_segment_type)
            WRITE(iou,1230)
            WRITE(iou,1231) (i, this%as(i), this%af(i),                        &
     &                       i = 1, this%maxSplineIndex)
 
         CASE (pprofile_gp_1d_sexp_type,                                       &
     &         pprofile_gp_1d_ln_sexp_type)
            WRITE(iou,1300) this%b(0:1)
            WRITE(iou,1231) (i, this%as(i), this%af(i),                        &
     &                       i = 1, this%maxSplineIndex)
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_write', start_time)
 
1100  FORMAT(/' Parameterized Profile Write: id = ',a)
1200  FORMAT('   pp_type = ',a)
1210  FORMAT(' b_0 + Th(s)Th(1-s)(b_1 (1 - s ** b_2) ** b_3).',                &
     &       '   b(0:3) = ')
1220  FORMAT(' Th(s)Th(1-s)[Sum_0_n b_i s** i].   b(0:n) = ')
1230  FORMAT(' i       as(i)           af(i)')
1231  FORMAT(1x,i3,2x,es15.8,2x,es15.8)
1300  FORMAT(4(2x,es15.8))
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE pprofile_save_state(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (pprofile_class), INTENT(inout) :: this
 
!  local variables
      REAL (rprec)                     :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE (this%p_type)
 
         CASE (pprofile_gp_1d_sexp_type,                                       &
     &         pprofile_gp_1d_ln_sexp_type)
            this%cache = this%af
            this%cache_hyper = this%b(0:1)
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_save_state', start_time)
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE pprofile_reset_state(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (pprofile_class), INTENT(inout) :: this
 
!  local variables
      REAL (rprec)                     :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE (this%p_type)
 
         CASE (pprofile_gp_1d_sexp_type,                                       &
     &         pprofile_gp_1d_ln_sexp_type)
            this%af = this%cache
            this%b(0:1) = this%cache_hyper
 
      END SELECT
 
      CALL profiler_set_stop_time('pprofile_reset_state', start_time)
 
      END SUBROUTINE
 
!*******************************************************************************
!  PRIVATE
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION findmaxindex(s_array)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER                               :: findmaxindex
      REAL(rprec), DIMENSION(:), INTENT(in) :: s_array
 
!  local variables
      REAL (rprec)                          :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      findmaxindex = maxloc(s_array, dim=1)
 
      CALL profiler_set_stop_time('findMaxIndex', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      PURE FUNCTION pprofile_gp_1d_sqexp_k(this, p1, p2)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec) :: pprofile_gp_1d_sqexp_k
      TYPE (pprofile_class), INTENT(in) :: this
      REAL (rprec), INTENT(in)          :: p1
      REAL (rprec), INTENT(in)          :: p2
 
!  Start of executable code
      pprofile_gp_1d_sqexp_k =                                                 &
     &   this%b(0)**2*exp(-(p1 - p2)**2/(2.0*this%b(1)**2))
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      PURE FUNCTION pprofile_gp_1d_sqexp_ln_k(this, p1, p2)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec) :: pprofile_gp_1d_sqexp_ln_k
      TYPE (pprofile_class), INTENT(in) :: this
      REAL (rprec), INTENT(in)          :: p1
      REAL (rprec), INTENT(in)          :: p2
 
!  Start of executable code
      pprofile_gp_1d_sqexp_ln_k =                                              &
     &   exp(2.0*this%b(0) - (p1 - p2)**2/(2.0*this%b(1)**2))
 
      END FUNCTION
 
      END MODULE