module mod_HB_matrices
#include<messenger.h>

!*****************************************************************************************
!*                                                                                *
!* This module contains subroutines for calculating matrices necessary for the HB scheme *
!* inv_E      - inverse Fourier transform matrix                                         *
!* diff_inv_E - the partial derivative of the inverse Fourier transform matrix wrt time  *
!* E          - Fourier transform matrix                                                 *
!* D          - psuedo spectral operator                                                 *
!* For K number of HB frequencies, w and N number of HB time levels (N = 2K + 1), t      *
!* the sizes of all matrices considered here is NxN                                      *
!*                                                                                *
!* The general form of inv_E:                                                            *
!* ([1 sin(w_1*t_1) ... sin(w_K*t_1) cos(w_1*t_1) ... cos(w_K*t_1)],                     *
!*  [1 sin(w_1*t_2) ... sin(w_K*t_2) cos(w_1*t_2) ... cos(w_K*t_2)],                     *
!*                                  .                                                    *
!*                                  .                                                    *
!*  [1 sin(w_1*t_N) ... sin(w_K*t_N) cos(w_1*t_N) ... cos(w_K*t_N)])                     *
!*                                                                                *
!* The general form of diff_inv_E:                                                       *
!* ([0 w_1*cos(w_1*t_1) ... w_K*cos(w_K*t_1) -w_1*sin(w_1*t_1) ... -w_K*sin(w_K*t_1)],   *
!*  [0 w_1*cos(w_1*t_2) ... w_K*cos(w_K*t_2) -w_1*sin(w_1*t_2) ... -w_K*sin(w_K*t_2)],   *
!*                                          .                                            *
!*                                          .                                            *
!*  [0 w_1*cos(w_1*t_N) ... w_K*cos(w_K*t_N) -w_1*sin(w_1*t_N) ... -w_K*sin(w_K*t_N)])   *
!*                                                                                *
!*****************************************************************************************

    use mod_kinds,      only: rk,ik
    use mod_constants,  only: ZERO,ONE
    use mod_inv,        only: inv

    implicit none

contains

    !> Calculate the inverse Fourier transform matrix, inv(E)
    !!
    !! @author Mayank Sharma
    !! @date   1/4/2017
    !!
    !! @param[in]   nfreq - Number of HB frequencies
    !! @param[in]   ntime - Number of HB time levels (= 2nfreq + 1)
    !! @param[in]   omega - Array containing HB frequency values (size nfreq)
    !! @param[in]   t     - Array containing HB time level values (size ntime)
    !!
    !------------------------------------------------------------------------------------
    subroutine calc_inv_E(nfreq,ntime,omega,t,inv_E)
        integer(ik),            intent(in)          :: nfreq,ntime
        real(rk),dimension(:),  intent(in)          :: omega,t
        real(rk),dimension(:,:),intent(inout)       :: inv_E

        integer                                     :: irow,icol

        !
        ! inv_E - inverse Fourier transform matrix
        !
        do irow = 1,ntime
            do icol = 1,ntime

                if (icol == 1) then

                    inv_E(irow,icol) = ONE

                else if (icol >= 2 .and. icol <= nfreq + 1) then

                    inv_E(irow,icol) = sin(omega(icol - 1)*t(irow))

                else

                    inv_E(irow,icol) = cos(omega(icol - (nfreq + 1))*t(irow))

                end if

            end do  ! icol
        end do  ! irow

    end subroutine calc_inv_E
    !************************************************************************************

    !> Calculate the partial derivative of inv(E) wrt time
    !!
    !! @author Mayank Sharma
    !! @date   1/4/2017
    !!
    !! @param[in]   nfreq - Number of HB frequencies
    !! @param[in]   ntime - Number of HB time levels (= 2nfreq + 1)
    !! @param[in]   omega - Array containing HB frequency values (size nfreq)
    !! @param[in]   t     - Array containing HB time levels (size ntime)
    !!
    !------------------------------------------------------------------------------------
    subroutine calc_diff_inv_E(nfreq,ntime,omega,t,diff_inv_E)
        integer(ik),            intent(in)          :: nfreq,ntime
        real(rk),dimension(:),  intent(in)          :: omega,t
        real(rk),dimension(:,:),intent(inout)       :: diff_inv_E

        integer                                     :: irow,icol

        !
        ! diff_inv_E - partial derivative of inverse Fourier transform matrix wrt t
        !
        do irow = 1,ntime
            do icol = 1,ntime

                if (icol == 1) then

                    diff_inv_E(irow,icol) = ZERO

                else if (icol >= 2 .and. icol <= nfreq + 1) then

                    diff_inv_E(irow,icol) = omega(icol - 1)*cos(omega(icol - 1)*t(irow))

                else

                    diff_inv_E(irow,icol) = -omega(icol - (nfreq + 1))*&
                                            sin(omega(icol - (nfreq + 1))*t(irow))

                end if

            end do  ! icol
        end do  ! irow

    end subroutine calc_diff_inv_E
    !************************************************************************************

    !>  Calculate the Fourier transform matrix
    !!
    !!  @author Mayank Sharma
    !!  @date   3/18/2017
    !!
    !------------------------------------------------------------------------------------
    subroutine calc_E(nfreq,ntime,omega,t,E)
        integer(ik),    intent(in)      :: nfreq, ntime
        real(rk),       intent(in)      :: omega(:), t(:)
        real(rk),       intent(inout)   :: E(:,:)

        real(rk),   allocatable        :: inv_E(:,:)
        integer(ik)                    :: ierr

        !
        ! Compute the inverse Fourier transform matrix
        !
        if (allocated(inv_E)) deallocate(inv_E)
        allocate(inv_E(ntime,ntime), stat=ierr)
        if (ierr /= 0) call AllocationError

        call calc_inv_E(nfreq,ntime,omega,t,inv_E)

        !
        ! E - Fourier transform matrix
        !
        E = inv(inv_E)

    end subroutine calc_E
    !************************************************************************************

    !> Calculate the pseudo spectral operator
    !!
    !! @author Mayank Sharma
    !! @date   1/4/2017
    !!
    !! @param[in]   nfreq - Number of HB frequencies
    !! @param[in]   ntime - Number of HB time levels (= 2nfreq + 1)
    !! @param[in]   omega - Array containing HB frequency values (size nfreq)
    !! @param[in]   t     - Array containing HB time levels (size ntime)
    !!
    !------------------------------------------------------------------------------------
    !subroutine calc_pseudo_spectral_operator(nfreq,ntime,omega,t,D)
    function calc_pseudo_spectral_operator(omega,t) result(D)
        real(rk),                   intent(in)      :: omega(:)
        real(rk),                   intent(in)      :: t(:)

        real(rk),       allocatable :: inv_E(:,:),diff_inv_E(:,:), E(:,:), D(:,:)
        character(:),   allocatable :: user_msg, dev_msg
        integer(ik)                 :: i,ierr, ntime, nfreq

        ntime = size(t)
        nfreq = size(omega)

        if (allocated(inv_E) .and. allocated(diff_inv_E) .and. allocated(E) &
            .and. allocated(D)) deallocate(inv_E,diff_inv_E,E,D)
        allocate(inv_E(ntime,ntime),diff_inv_E(ntime,ntime), &
                 E(ntime,ntime),D(ntime,ntime), stat=ierr)
        if (ierr /= 0) call AllocationError

        !
        ! D - pseudo spectral operator
        !
        call calc_inv_E(nfreq,ntime,omega,t,inv_E)
        call calc_diff_inv_E(nfreq,ntime,omega,t,diff_inv_E)

        user_msg = 'The size of an array being inverted here is ZERO. Check &
                    the frequencies you have entered in chidg.nml'
        dev_msg  = 'The inv subroutine expects a valid non-zero integer matrix size. Check &
                    in time_manager.f90'

        if (size(inv_E,1) == 0) call chidg_signal_two(FATAL, user_msg, size(inv_E,1), dev_msg)

        E = inv(inv_E)
        D = matmul(diff_inv_E,E)

    end function calc_pseudo_spectral_operator
    !************************************************************************************

end module mod_HB_matrices


C$Procedure      VNORM ( Vector norm, 3 dimensions )

      DOUBLE PRECISION FUNCTION VNORM ( V1 )

C$ Abstract
C
C      Compute the magnitude of a double precision, 3-dimensional
C      vector.
C
C$ Disclaimer
C
C     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE
C     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S.
C     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE
C     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE
C     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS"
C     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY
C     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A
C     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC
C     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE
C     SOFTWARE AND RELATED MATERIALS, HOWEVER USED.
C
C     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA
C     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT
C     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND,
C     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS,
C     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE
C     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY.
C
C     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF
C     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY
C     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE
C     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE.
C
C$ Required_Reading
C
C     None.
C
C$ Keywords
C
C      VECTOR
C
C$ Declarations

      DOUBLE PRECISION  V1 ( 3 )

C$ Brief_I/O
C
C      VARIABLE  I/O  DESCRIPTION
C      --------  ---  --------------------------------------------------
C       V1        I     Vector whose magnitude is to be found.
C
C$ Detailed_Input
C
C      V1      This may be any 3-dimensional, double precision vector.
C
C$ Detailed_Output
C
C      VNORM is the magnitude of V1 calculated in a numerically stable
C      way.
C
C$ Parameters
C
C     None.
C
C$ Particulars
C
C      VNORM finds the component of V1 whose magnitude is the largest.
C      If the absolute magnitude of that component indicates that a
C      numeric overflow would occur when it is squared, or if it
C      indicates that an underflow would occur when square (giving a
C      magnitude of zero) then the following expression is used:
C
C      VNORM = V1MAX * MAGNITUDE OF [ (1/V1MAX)*V1 ]
C
C      Otherwise a simpler expression is used:
C
C      VNORM = MAGNITUDE OF [ V1 ]
C
C      Beyond the logic described above, no further checking of the
C      validity of the input is performed.
C
C$ Examples
C
C      The following table show the correlation between various input
C      vectors V1 and VNORM:
C
C      V1                                    VNORM
C      -----------------------------------------------------------------
C      (1.D0, 2.D0, 2.D0)                     3.D0
C      (5.D0, 12.D0, 0.D0)                   13.D0
C      (-5.D-17, 0.0D0, 12.D-17)             13.D-17
C
C$ Restrictions
C
C      None.
C
C$ Exceptions
C
C      Error free.
C
C$ Files
C
C      None.
C
C$ Author_and_Institution
C
C      W.M. Owen       (JPL)
C
C$ Literature_References
C
C      None.
C
C$ Version
C
C-     SPICELIB Version 1.0.1, 10-MAR-1992 (WLT)
C
C         Comment section for permuted index source lines was added
C         following the header.
C
C-     SPICELIB Version 1.0.0, 31-JAN-1990 (WMO)
C
C-&

C$ Index_Entries
C
C     norm of 3-dimensional vector
C
C-&

      DOUBLE PRECISION V1MAX
C
C  Determine the maximum component of the vector.
C
      V1MAX = MAX (DABS(V1(1)), DABS(V1(2)), DABS(V1(3)))
C
C  If the vector is zero, return zero; otherwise normalize first.
C  Normalizing helps in the cases where squaring would cause overflow
C  or underflow.  In the cases where such is not a problem it not worth
C  it to optimize further.
C
      IF (V1MAX.EQ.0.D0) THEN
         VNORM = 0.D0
      ELSE
         VNORM = V1MAX * DSQRT (  (V1(1)/V1MAX)**2
     .                          + (V1(2)/V1MAX)**2
     .                          + (V1(3)/V1MAX)**2)
      END IF
C
      RETURN
      END


c
c
c
c     =================================================
      real(kind=8) function fdisc(x,y)
c     =================================================

      real(kind=8), intent(in) :: x,y
      real(kind=8) :: r0,r,a,xoff,yoff,x0,y0,rad
      integer :: k
c
c     # for computing cell averages for initial data that has a
c     # discontinuity along some curve.  fdisc should be negative to the
c     # left of the curve and positive to the right

      x0 = 0.5d0
      y0 = 0.5d0
      k = 12.d0
      r0 = 0.2d0
      a = 0.06d0

      r = sqrt((x-x0)**2 + (y-y0)**2)
      yoff = y-y0
      xoff = x-x0
      theta = atan2(yoff,xoff)

      rad = r0 + a*sin(k*theta)

      if (r < rad) then
         fdisc = -1.d0
      else
         fdisc =  1.d0
      endif

c
      return
      end


program main

        use ISO_FORTRAN_ENV

implicit none

        ! Rearrangement using a + b + c = p; a^2 + b^2 = c^2 gives us;
        ! b = (p^2 - 2pa)/(2p - 2a)
        ! So if we iterate up to p <= 1000, and across all a; for a < b;
        ! the solution for b should be natural if there is a solution

        integer (int64), parameter :: MAXIMUM = 1000;
        integer (int64) :: a, p, num_sol, max_sol, largest;

        num_sol = 0
        largest = 0
        max_sol = 0

        OUTER: &
        do p = 2, MAXIMUM, 1

                num_sol = 0

                INNER: &
                do a = 2, p/2, 1

                        if(mod(p**2 - 2*p*a, (2*(p - a))) == 0) then
                                num_sol = num_sol + 1;
                        endif

                end do inner

                if(num_sol > max_sol) then
                        max_sol = num_sol;
                        largest = p;
                endif

        end do outer

        print*,(largest);

end program main