      subroutine slvblk ( bloks, integs, nbloks, b, ipivot, x, iflag )
c    this program solves  the  linear system  a*x = b  where a is an
c  almost block diagonal matrix.  such almost block diagonal matrices
c  arise naturally in piecewise polynomial interpolation or approx-
c  imation and in finite element methods for two-point boundary value
c  problems.  the plu factorization method is implemented here to take
c  advantage of the special structure of such systems for savings in
c  computing time and storage requirements.
c
c		   parameters
c  bloks   a one-dimenional array, of length
c		    sum( integs(1,i)*integs(2,i) ; i = 1,nbloks )
c	   on input, contains the blocks of the almost block diagonal
c	   matrix  a  .  the array integs (see below and the example)
c	   describes the block structure.
c	   on output, contains correspondingly the plu factorization
c	   of  a  (if iflag .ne. 0).  certain of the entries into bloks
c	   are arbitrary (where the blocks overlap).
c  integs  integer array description of the block structure of	a .
c	     integs(1,i) = no. of rows of block i	 =  nrow
c	     integs(2,i) = no. of colums of block i	 =  ncol
c	     integs(3,i) = no. of elim. steps in block i =  last
c			   i  = 1,2,...,nbloks
c	   the linear system is of order
c		 n  =  sum ( integs(3,i) , i=1,...,nbloks ),
c	   but the total number of rows in the blocks is
c	       nbrows = sum( integs(1,i) ; i = 1,...,nbloks)
c  nbloks  number of blocks
c  b	   right side of the linear system, array of length nbrows.
c	   certain of the entries are arbitrary, corresponding to
c	   rows of the blocks which overlap (see block structure and
c	   the example below).
c  ipivot  on output, integer array containing the pivoting sequence
c	   used. length is nbrows
c  x	   on output, contains the computed solution (if iflag .ne. 0)
c	   length is n.
c  iflag   on output, integer
c	     = (-1)**(no. of interchanges during factorization)
c		    if	a  is invertible
c	     = 0    if	a  is singular
c
c		    auxiliary programs
c  fcblok (bloks,integs,nbloks,ipivot,scrtch,iflag)  factors the matrix
c	    a , and is used for this purpose in slvblk. its arguments
c	   are as in slvblk, except for
c	       scrtch = a work array of length max(integs(1,i)).
c
c  sbblok (bloks,integs,nbloks,ipivot,b,x)  solves the system a*x = b
c	   once  a  is factored. this is done automatically by slvblk
c	   for one right side b, but subsequent solutions may be
c	   obtained for additional b-vectors. the arguments are all
c	   as in slvblk.
c
c  dtblok (bloks,integs,nbloks,ipivot,iflag,detsgn,detlog) computes the
c	   determinant of  a  once slvblk or fcblok has done the fact-
c	   orization.the first five arguments are as in slvblk.
c	       detsgn  = sign of the determinant
c	       detlog  = natural log of the determinant
c
c	      ------ block structure of  a  ------
c  the nbloks blocks are stored consecutively in the array  bloks .
c  the first block has its (1,1)-entry at bloks(1), and, if the i-th
c  block has its (1,1)-entry at bloks(index(i)), then
c	  index(i+1) = index(i)  +  nrow(i)*ncol(i) .
c    the blocks are pieced together to give the interesting part of  a
c  as follows.	for i = 1,2,...,nbloks-1, the (1,1)-entry of the next
c  block (the (i+1)st block ) corresponds to the (last+1,last+1)-entry
c  of the current i-th block.  recall last = integs(3,i) and note that
c  this means that
c      a. every block starts on the diagonal of  a .
c      b. the blocks overlap (usually). the rows of the (i+1)st block
c	  which are overlapped by the i-th block may be arbitrarily de-
c	  fined initially. they are overwritten during elimination.
c    the right side for the equations in the i-th block are stored cor-
c  respondingly as the last entries of a piece of  b  of length  nrow
c  (= integs(1,i)) and following immediately in  b  the corresponding
c  piece for the right side of the preceding block, with the right side
c  for the first block starting at  b(1) . in this, the right side for
c  an equation need only be specified once on input, in the first block
c  in which the equation appears.
c
c	      ------ example and test driver ------
c    the test driver for this package contains an example, a linear
c  system of order 11, whose nonzero entries are indicated in the fol-
c  lowing schema by their row and column index modulo 10. next to it
c  are the contents of the  integs  arrray when the matrix is taken to
c  be almost block diagonal with  nbloks = 5, and below it are the five
c  blocks.
c
c		       nrow1 = 3, ncol1 = 4
c	    11 12 13 14
c	    21 22 23 24   nrow2 = 3, ncol2 = 3
c	    31 32 33 34
c  last1 = 2	  43 44 45
c		  53 54 55	      nrow3 = 3, ncol3 = 4
c	 last2 = 3	   66 67 68 69	 nrow4 = 3, ncol4 = 4
c			   76 77 78 79	    nrow5 = 4, ncol5 = 4
c			   86 87 88 89
c		  last3 = 1   97 98 99 90
c		     last4 = 1	 08 09 00 01
c				 18 19 10 11
c			last5 = 4
c
c	  actual input to bloks shown by rows of blocks of  a .
c      (the ** items are arbitrary, this storage is used by slvblk)
c
c  11 12 13 14	/ ** ** **  / 66 67 68 69  / ** ** ** **  / ** ** ** **
c  21 22 23 24 /  43 44 45 /  76 77 78 79 /  ** ** ** ** /  ** ** ** **
c  31 32 33 34/   53 54 55/   86 87 88 89/   97 98 99 90/   08 09 00 01
c							    18 19 10 11
c
c  index = 1	  index = 13  index = 22     index = 34     index = 46
c
c	  actual right side values with ** for arbitrary values
c  b1 b2 b3 ** b4 b5 b6 b7 b8 ** ** b9 ** ** b10 b11
c
c  (it would have been more efficient to combine block 3 with block 4)
c
      integer nbloks
      integer integs(3,nbloks),ipivot(1),iflag
      real bloks(1),b(1),x(1)
c     in the call to fcblok,  x  is used for temporary storage.
      call fcblok(bloks,integs,nbloks,ipivot,x,iflag)
      if (iflag .eq. 0) 		return
      call sbblok(bloks,integs,nbloks,ipivot,b,x)
					return
      end


      SUBROUTINE sla_ECLEQ (DL, DB, DATE, DR, DD)
*+
*     - - - - - -
*      E C L E Q
*     - - - - - -
*
*  Transformation from ecliptic coordinates to
*  J2000.0 equatorial coordinates (double precision)
*
*  Given:
*     DL,DB       dp      ecliptic longitude and latitude
*                           (mean of date, IAU 1980 theory, radians)
*     DATE        dp      TDB (loosely ET) as Modified Julian Date
*                                              (JD-2400000.5)
*  Returned:
*     DR,DD       dp      J2000.0 mean RA,Dec (radians)
*
*  Called:
*     sla_DCS2C, sla_ECMAT, sla_DIMXV, sla_PREC, sla_EPJ, sla_DCC2S,
*     sla_DRANRM, sla_DRANGE
*
*  P.T.Wallace   Starlink   March 1986
*
*  Copyright (C) 1995 Rutherford Appleton Laboratory
*
*  License:
*    This program is free software; you can redistribute it and/or modify
*    it under the terms of the GNU General Public License as published by
*    the Free Software Foundation; either version 2 of the License, or
*    (at your option) any later version.
*
*    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 (see SLA_CONDITIONS); if not, write to the
*    Free Software Foundation, Inc., 59 Temple Place, Suite 330,
*    Boston, MA  02111-1307  USA
*
*-

      IMPLICIT NONE

      DOUBLE PRECISION DL,DB,DATE,DR,DD

      DOUBLE PRECISION sla_EPJ,sla_DRANRM,sla_DRANGE

      DOUBLE PRECISION RMAT(3,3),V1(3),V2(3)

*  Spherical to Cartesian
      CALL sla_DCS2C(DL,DB,V1)

*  Ecliptic to equatorial
      CALL sla_ECMAT(DATE,RMAT)
      CALL sla_DIMXV(RMAT,V1,V2)

*  Mean of date to J2000
      CALL sla_PREC(2000D0,sla_EPJ(DATE),RMAT)
      CALL sla_DIMXV(RMAT,V2,V1)

*  Cartesian to spherical
      CALL sla_DCC2S(V1,DR,DD)

*  Express in conventional ranges
      DR=sla_DRANRM(DR)
      DD=sla_DRANGE(DD)

      END


      SUBROUTINE BANGLE(XYZ,I,J,K,ANGLE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION XYZ(3,*)
*********************************************************************
*
* BANGLE CALCULATES THE ANGLE BETWEEN ATOMS I,J, AND K. THE
*        CARTESIAN COORDINATES ARE IN XYZ.
*
*********************************************************************
      D2IJ = (XYZ(1,I)-XYZ(1,J))**2+
     1       (XYZ(2,I)-XYZ(2,J))**2+
     2       (XYZ(3,I)-XYZ(3,J))**2
      D2JK = (XYZ(1,J)-XYZ(1,K))**2+
     1       (XYZ(2,J)-XYZ(2,K))**2+
     2       (XYZ(3,J)-XYZ(3,K))**2
      D2IK = (XYZ(1,I)-XYZ(1,K))**2+
     1       (XYZ(2,I)-XYZ(2,K))**2+
     2       (XYZ(3,I)-XYZ(3,K))**2
      XY = SQRT(D2IJ*D2JK)
      TEMP = 0.5D0 * (D2IJ+D2JK-D2IK) / XY
      IF (TEMP .GT. 1.0D0) TEMP=1.0D0
      IF (TEMP .LT. -1.0D0) TEMP=-1.0D0
      ANGLE = ACOS( TEMP )
      RETURN
      END


!We at 99X Technology are interested in looking at how well you can adapt into any programming language.

!Your task to solve the below problem using the Fortran language. (Please note that you cannot use any other language for this problem)

!Given an array of integers, your task is print whether the number is odd or even.

!Input Format

!The first line contains an integer N, denoting the size of the array.
!The second line contains N space-separated integers representing the array's elements.

Constraints

!0 < N < 10000

!Output Format

!Print whether the number is odd or even

!Sample Input 0

!6
!2 3 8 9 10 12
!Sample Output 0

!Even Odd Even Odd Even Even

program EvenOROdd

    !variable declaration
    integer(kind=16), allocatable,dimension(:):: numbers
    integer  :: n,i

    read(*,*) n

    !array allocates specified memory
    allocate(numbers(n))

    if(n>0 .and. (n<10000)) then

        !Reading integers to the allocated array from user in one line
        read(*,*) (numbers(i),i=1,n)

        !Checking whether the numbers of the array are odd or even
        do i=1,n

                if(mod(numbers(i),2)== 0) then
                    write(*,"(A)", advance="no") "Even "  !Writing output on the same line
                else
                    write(*,"(A)", advance="no") "Odd "   !Writing output on the same line
                end if

        end do

    end if

end program EvenOROdd


c     DRSCPLTK
c>> 2001-06-17 DRSCPLTK Krogh Changed T computation.
c>> 1996-05-30 DRSCPLTK Krogh Added external statement.
c>> 1994-10-19 DRSCPLTK Krogh  Changes to use M77CON
c>> 1994-09-01 DRSCPLTK WVS Moved formats to top for C conversion
c>> 1994-08-09 DRSCPLTK WVS set up for CHGTYP
c>> 1992-04-29 DRSCPLTK CAO Replaced '1' in format.
c>> 1991-11-19 DRSCPLTK CLL
c>> 1987-12-09 DRSCPLTK Lawson  Initial Code.
c--S replaces "?": DR?CPLTK, ?CPLTK, ?CPLTE
c
c     DEMONSTRATION DRIVER FOR ELLIPTIC INTEGRALS.
c
c     EVALUATE THE LEGENDRE'S RELATION:
c     Z = PI/2 - (K*E1 + K1*E - K*K1) = 0
c
      external R1MACH, SCPLTK, SCPLTE
      real             R1MACH, SCPLTK, SCPLTE
      real             EM(6),K,K1,E,E1, ONE
      real             PI2, T, TPRIME, Z, ZERO
      integer I
      data PI2 / 1.5707963267948966192313217E0 /
      data EM / 0.001E0, .2E0, .4E0, .6E0, .8E0, .999E0 /
      data ZERO,ONE / 0.E0, 1.E0 /
c
  200 format(5X,A2,9X,A10,7X,A10,8X,A1/' ')
  300 format(2X,F6.3,2X,F15.8,2X,F15.8,3X,G10.2)
  400 format(3X,A1,6X,F15.8,2X,F15.8,3X,G10.2)
  500 format(2X,F6.3,9X,A8,2X,F15.8,3X,G10.2)
  600 format(/'  TPRIME = Machine epsilon =',E10.2)
  700 format('  T = 1. - TPRIME')
c
      TPRIME = R1MACH(4)
      T = ONE - TPRIME
c
      print 200,'EM','SCPLTK(EM)','SCPLTE(EM)','Z'
      print 300,ZERO,SCPLTK(ZERO),SCPLTE(ZERO)
c
      do 800 I = 1, 6
        K  = SCPLTK(EM(I))
        K1 = SCPLTK(1-EM(I))
        E  = SCPLTE(EM(I))
        E1 = SCPLTE(1-EM(I))
        Z  = PI2 - (K*E1 + K1*E - K*K1)
        print 300, EM(I), K, E, Z
  800 continue
      K  = SCPLTK( T )
      K1 = SCPLTK( TPRIME )
      E  = SCPLTE( T )
      E1 = SCPLTE( TPRIME )
      Z  = PI2 - (K*E1 + K1*E - K*K1)
      print 400, 'T', K, E, Z
      print 500, ONE, 'INFINITY', SCPLTE(ONE)
      print 600, TPRIME
      print 700
c
      end


subroutine get_backward_euler_lhs(t, dt, r, p, output)

!----------------------------------------------------------------
! Calculates
!     M'[r](p) = p + dt * G'[r](p),
! as appears on the left-hand side of Newton's method.
!
! Args:
!   t: Most recent time value.
!   dt: Time step size.
!   r: Newton iterate.
!   p: Newton perturbation.
!   output: Result of the operation.
!------------------------------------------------------------------------------

    !$ use omp_lib
    implicit none

    integer :: mx, mbc, meqn
    double precision :: x_lower, dx
    common /claw_config/ mx, mbc, x_lower, dx, meqn

    double precision, intent(in) :: t, dt
    double precision, intent(in), dimension(1-mbc:mx+mbc, meqn) :: r
    double precision, intent(inout), dimension(1-mbc:mx+mbc, meqn) :: p
    double precision, intent(out), dimension(1-mbc:mx+mbc, meqn) :: output

    integer :: ix, ieqn

    call apply_bcs(t + dt, r)
    call apply_linearized_bcs(r, p)
    call apply_linearized_pde_operator(t + dt, r, p, output)

    do ieqn = 1, meqn
        !$omp parallel do
        do ix = 1,mx
            output(ix, ieqn) = p(ix, ieqn) - dt * output(ix, ieqn)
        end do
    end do

end subroutine get_backward_euler_lhs


!=======================================================================
! Created by
!     Keurfon Luu <keurfon.luu@mines-paristech.fr>
!     MINES ParisTech - Centre de Géosciences
!     PSL - Research University
!=======================================================================

program benchmark

  use forlab, only: IPRE, RPRE, CLEN, progress_perc, split_argument, &
    num2str, rng, mean, median, std, tic, toc
  use benchmark_functions, only: BenchmarkFunction
  use stochoptim, only: Evolutionary
#ifdef do_mpi
  use mpi
#endif

  implicit none

  ! Inputs
  integer(kind = IPRE) :: n_dim, popsize, max_iter, max_run, seed
  real(kind = RPRE) :: w, c1, c2, gamma, F, CR, sigma, mu_perc
  character(len = :), allocatable :: solver, func

  ! Local variables
  integer(kind = IPRE) :: n_run
  real(kind = RPRE) :: min_fit, max_fit, mean_fit, median_fit, std_fit
  real(kind = RPRE), dimension(:), allocatable :: fit
  character(len = 18) :: attributes
  type(Evolutionary) :: ea
  type(BenchmarkFunction) :: bf

  ! MPI variables
  integer(kind = IPRE) :: master = 0, rank, ierr, iprv

  ! Initialize MPI
#ifdef do_mpi
  call mpi_init_thread(mpi_thread_funneled, iprv, ierr)
  call mpi_comm_rank(mpi_comm_world, rank, ierr)
#else
  rank = 0
#endif

  ! Read command line arguments
  call command_arguments()

  ! Initialize random number generator
  if ( seed .ge. 0 ) then
    call rng(seed)
  else
    call rng()
  end if

  ! Optimize max_run times
  bf = BenchmarkFunction(func, n_dim)
  ea = Evolutionary(bf % func, bf % lower, bf % upper, &
                    popsize = popsize, max_iter = max_iter, &
                    eps2 = 1d-30, constrain = .false., snap = .false.)

  allocate(fit(max_run))
  if ( rank .eq. master ) then
    print *
    call tic()
    call progress_perc(0, max_run, " Processing: ")
  end if
  do n_run = 1, max_run
    call ea % optimize(&
      solver = solver, &
      w = w, &
      c1 = c1, &
      c2 = c2, &
      gamma = gamma, &
      F = F, &
      CR = CR, &
      sigma = sigma, &
      mu_perc = mu_perc)
    fit(n_run) = ea % gfit
    if ( rank .eq. master ) call progress_perc(n_run, max_run, " Processing: ")
  end do

  ! Display results
  if ( rank .eq. master ) then
    min_fit = minval(fit)
    max_fit = maxval(fit)
    mean_fit = mean(fit)
    median_fit = median(fit)
    std_fit = std(fit)

    print *
    print *

    attributes = "function:"
    print *, adjustr(attributes) // " '" // trim(func) // "'"
    call ea % print_parameters()
    print *
    attributes = "max_run:"
    print *, adjustr(attributes) // " " // num2str(max_run)
    attributes = "min:"
    print *, adjustr(attributes) // " " // num2str(min_fit)
    attributes = "max:"
    print *, adjustr(attributes) // " " // num2str(max_fit)
    attributes = "mean:"
    print *, adjustr(attributes) // " " // num2str(mean_fit)
    attributes = "median:"
    print *, adjustr(attributes) // " " // num2str(median_fit)
    attributes = "std:"
    print *, adjustr(attributes) // " " // num2str(std_fit)

    print *
    call toc()
    print *
  end if

#ifdef do_mpi
  call mpi_finalize(ierr)
#endif

contains

  subroutine command_arguments()
    integer(kind = IPRE) :: i, n_argin
    character(len = CLEN) :: argin
    character(len = :), allocatable :: argname, argval

    solver = "cpso"
    func = "sphere"
    n_dim = 2
    popsize = 16
    w = 0.7298
    c1 = 1.49618
    c2 = 1.49618
    gamma = 1.
    F = 0.5
    CR = 0.1
    sigma = 0.5
    mu_perc = 0.5
    max_iter = 200
    max_run = 100
    seed = -1

    n_argin = command_argument_count()
    do i = 1, n_argin
      call get_command_argument(i, argin)
      call split_argument(argin, argname, argval)

      select case(argname)
      ! Number of dimensions
      case("n_dim")
        read(argval, *) n_dim

      ! Solver
      case("solver")
        solver = argval

      ! Function
      case("func")
        func = argval

      ! Population size
      case("popsize")
        read(argval, *) popsize

      ! Inertia weight
      case("w")
        read(argval, *) w

      ! Cognition parameter
      case("c1")
        read(argval, *) c1

      ! Sociability parameter
      case("c2")
        read(argval, *) c2

      ! Competitivity parameter
      case("gamma")
        read(argval, *) gamma

      ! Differential weight
      case("F")
        read(argval, *) F

      ! Crossover probability
      case("CR")
        read(argval, *) CR

      ! Step size
      case("sigma")
        read(argval, *) sigma

      ! Percentage of offsprings
      case("mu_perc")
        read(argval, *) mu_perc

      ! Maximum number of iterations
      case("max_iter")
        read(argval, *) max_iter

      ! Maximum number of iterations
      case("max_run")
        read(argval, *) max_run

      ! Random number seed
      case("seed")
        read(argval, *) seed

      case default
        print *, "Error: unknown argument '" // trim(argname) // "'"
        stop
      end select
    end do
    return
  end subroutine command_arguments

end program benchmark


program main2

    use omp_lib
    use random_util, only: init_random_seed
    use gamblers, only: kwalks, max_steps, walk

    implicit none
    real(kind=8) :: p, q, p1, p2, frac1wins, frac2wins
    integer :: wins(0:2)
    integer :: seed, i, j, nthreads, k, n1, n2, nsteps, winner, thread_num
    integer :: nsteps_total
    real(kind=8) :: nsteps_average, mean_length
    integer, allocatable :: nsteps_thread(:)
    integer(kind=8) :: tclock1, tclock2, clock_rate
    real(kind=8) :: t1, t2, elapsed_time

    open(unit=21, file='input_data.txt', status='old')
    read(21,*) n1
    read(21,*) n2
    read(21,*) p
    read(21,*) max_steps
    read(21,*) seed
    read(21,*) kwalks
    read(21,*) nthreads

    print "('n1 = ',i6)", n1
    print "('n2 = ',i6)", n2
    print "('p = ',f8.4)", p
    print "('kwalks = ',i6)", kwalks
    print "('max_steps = ',i9)", max_steps

    allocate(nsteps_thread(0:nthreads-1))
    nsteps_thread = 0

    !$ call omp_set_num_threads(nthreads)
    print "('nthreads = ',i2)", nthreads

    call init_random_seed(seed)

    wins = 0
    nsteps_total = 0

    !---- check the time for the main loop:

    call system_clock(tclock1)
    call cpu_time(t1)   ! start cpu timer

    !$omp parallel do private(k,nsteps,winner,thread_num) &
!   !$omp             reduction(+:nsteps_total) schedule(dynamic,1)
    !$omp             reduction(+:nsteps_total)
    do k=1,kwalks
        call walk(n1, n2, p, .false., nsteps, winner)
        wins(winner) = wins(winner) + 1
        !$ thread_num = omp_get_thread_num()
        nsteps_thread(thread_num) = nsteps_thread(thread_num) + nsteps
        nsteps_total = nsteps_total + nsteps
        enddo

    call cpu_time(t2)   ! end cpu timer
    print 10, t2-t1
 10 format("CPU time = ",f12.8, " seconds")

    call system_clock(tclock2, clock_rate)
    elapsed_time = float(tclock2 - tclock1) / float(clock_rate)
    print 11, elapsed_time
 11 format("Elapsed time = ",f12.8, " seconds")

    if (wins(0) > 0) then
        print 601, wins(0), kwalks
 601    format("Warning: ",i6, " walks out of ",i8, &
               " did not result in a win by either player")
        endif

    frac1wins = wins(1) / float(kwalks)
    frac2wins = wins(2) / float(kwalks)
    print 602, frac1wins,frac2wins
602 format(/,"Player 1 won ", f7.4," fraction of the time, Player 2 won ", &
           f7.4, " fraction of the time")

    q = 1.d0 - p
    p1 = (1.d0-(q/p)**n1) / (1.d0-(q/p)**(n1+n2))
    p2 = 1.d0 - p1
    print 603, p1, p2
603 format("True probabilities are P1 = ", f7.4," P2 = ",f7.4)

    nsteps_average = nsteps_total / float(kwalks)
    print 604, nsteps_average
604 format("The average path length is ",f9.2)

    mean_length = (n1/(q-p)) - ((n1+n2)/(q-p))*(1-(q/p)**n1)/(1-(q/p)**(n1+n2))
    print 605, mean_length
605 format("True mean path length is ",f9.2)

    print *, "Total number of steps taken by each thread:"
    do thread_num = 0,nthreads-1
        print 606, thread_num, nsteps_thread(thread_num)
606     format("  Thread ",i9," took ",i9," steps")
        enddo

end program main2


program gravitationalDisp
    implicit none

    real,parameter::g=9.81
    real::s
    real::t
    real::u
    t=5.0
    u=50
    s=u*t-g*(t**2)/2
    print *,"Time = ",t
    print *,"Disp = ",s
end program