subroutine calcOverlapAreas(nTurbines, turbineX, turbineY, rotorDiameter, wakeDiameters, &
                            wakeCenters, wakeOverlapTRel_mat)
!    calculate overlap of rotors and wake zones (wake zone location defined by wake
!    center and wake diameter)
!   turbineX,turbineY is x,y-location of center of rotor
!
!    wakeOverlap(TURBI,TURB,ZONEI) = overlap area of zone ZONEI of wake of turbine
!     TURB with rotor of downstream turbine
!    TURBI

    implicit none

    ! define precision to be the standard for a double precision ! on local system
    integer, parameter :: dp = kind(0.d0)

    ! in
    integer, intent(in) :: nTurbines
    real(dp), dimension(nTurbines), intent(in) :: turbineX, turbineY, rotorDiameter
    real(dp), dimension(nTurbines, nTurbines, 3), intent(in) :: wakeDiameters
    real(dp), dimension(nTurbines, nTurbines), intent(in) :: wakeCenters

    ! out
    real(dp), dimension(nTurbines, nTurbines, 3), intent(out) :: wakeOverlapTRel_mat

    ! local
    integer :: turb, turbI, zone
    real(dp), parameter :: pi = 3.141592653589793_dp, tol = 0.000001_dp
    real(dp) :: OVdYd, OVr, OVRR, OVL, OVz
    real(dp), dimension(nTurbines, nTurbines, 3) :: wakeOverlap

    wakeOverlapTRel_mat = 0.0_dp
    wakeOverlap = 0.0_dp

    OVdYd = wakeCenters(turbI, turb)-turbineY(turbI)    ! distance between wake center and rotor center
    OVr = rotorDiameter(turbI)/2                        ! rotor diameter

    OVRR = wakeDiameters(turbI, turb, zone)/2.0_dp        ! wake diameter
    OVdYd = abs(OVdYd)
    if (OVdYd >= 0.0_dp + tol) then
        ! calculate the distance from the wake center to the vertical line between
        ! the two circle intersection points
        OVL = (-OVr*OVr+OVRR*OVRR+OVdYd*OVdYd)/(2.0_dp*OVdYd)
    else
        OVL = 0.0_dp
    end if

    OVz = OVRR*OVRR-OVL*OVL

    ! Finish calculating the distance from the intersection line to the outer edge of the wake zone
    if (OVz > 0.0_dp + tol) then
        OVz = sqrt(OVz)
    else
        OVz = 0.0_dp
    end if

    if (OVdYd < (OVr+OVRR)) then ! if the rotor overlaps the wake zone

        if (OVL < OVRR .and. (OVdYd-OVL) < OVr) then
            wakeOverlap(turbI, turb, zone) = OVRR*OVRR*dacos(OVL/OVRR) + OVr*OVr*dacos((OVdYd-OVL)/OVr) - OVdYd*OVz
        else if (OVRR > OVr) then
            wakeOverlap(turbI, turb, zone) = pi*OVr*OVr
        else
            wakeOverlap(turbI, turb, zone) = pi*OVRR*OVRR
        end if
    else
        wakeOverlap(turbI, turb, zone) = 0.0_dp
    end if

    do turb = 1, nTurbines

        do turbI = 1, nTurbines

            wakeOverlap(turbI, turb, 3) = wakeOverlap(turbI, turb, 3)-wakeOverlap(turbI, turb, 2)
            wakeOverlap(turbI, turb, 2) = wakeOverlap(turbI, turb, 2)-wakeOverlap(turbI, turb, 1)

        end do

    end do

    wakeOverlapTRel_mat = wakeOverlap

    do turbI = 1, nTurbines
            wakeOverlapTRel_mat(turbI, :, :) = wakeOverlapTRel_mat(turbI, :, &
                                                         :)/((pi*rotorDiameter(turbI) &
                                                       *rotorDiameter(turbI))/4.0_dp)
    end do

    ! do turbI = 1, nTurbines
!         do turb = 1, nTurbines
!             do zone = 1, 3
!                 print *, "wakeOverlapTRel_mat[", turbI, ", ", turb, ", ", zone, "] = ", wakeOverlapTRel_mat(turbI, turb, zone)
!             end do
!         end do
!     end do

end subroutine calcOverlapAreas


MODULE SLAE
!
! Module for the solution of systems of linear equations.
!
  USE precise, ONLY: DEFAULTP
  IMPLICIT NONE
  INTEGER, PARAMETER, PRIVATE :: WP=DEFAULTP

CONTAINS

  SUBROUTINE gauss(A,B,X,ERROR)

! Gauss elimination with partial Pivot element search (row switching)
! Solves the system of linear equations
!     Ax = b
! A and b are changed by the routine!
!
  REAL(WP), INTENT(IN OUT) :: A(:,:)
  REAL(WP), INTENT(IN OUT) :: B(:)

  INTEGER, INTENT(IN OUT) :: ERROR
  REAL(WP), INTENT(OUT) :: X(:)
  REAL(WP) :: am, P
  INTEGER :: I, J, K, ITMP, NEQ, l
  INTEGER, ALLOCATABLE :: IDX(:)

  ! Initialize some local variables
  ERROR = 0
  NEQ = SIZE(B)
  ALLOCATE(IDX(NEQ))

  ! Initialize index array (the rows are not actually switched. Only
  ! the inices are interchanged
  DO i = 1, NEQ
     IDX(i) = i
  END DO

  ! Loop over the equations from first to next to last Eq
  DO K = 1, NEQ-1
     J = K
     ! Search for Pivot element (largest number in column below
     ! current position
     DO I = K+1, NEQ
        IF ( ABS(A(IDX(I),K)) > ABS(A(IDX(J),K))) J = I
     END DO
     ! Make row with Pivot element the current row
     ITMP = IDX(J)
     IDX(J) = IDX(K)
     IDX(K) = ITMP

     ! Return error condition if pivot element is too small
     IF (ABS(A(IDX(K),K)) < 0.00000000000001) THEN
        PRINT*, IDX(K), K, A(IDX(K),K)
        ERROR=-1
        RETURN
     ENDIF
     ! Gauss elimination procedure
     DO I = K+1, NEQ

        ! Divide rows by pivot element
        am = A(IDX(I),K) / A(IDX(K),K)

        ! Subtract pivot element row from rows below
        !DO J = K+1, NEQ
        DO J = 1, NEQ
           A(IDX(I),J) = A(IDX(I),J) - am*A(IDX(K),J)
        END DO
        B(IDX(I)) = B(IDX(I)) - am*B(IDX(K))
     !!! Poor man debugger; uncomment if you want to see the matrix changes
     !!do l = 1, neq
     !!   WRITE(6,'(5G12.6)') (A(IDX(l),J), J = 1, neq), B(IDX(l))
     !!END DO
     !!WRITE(6,*)
     END DO
  END DO

  ! Back substitution part
  ! Start with last unknown
  ! Walk your way back up from next to last to first row (unknown)
  DO K = NEQ, 1, -1
     X(K) = B(IDX(K))
     DO I = K+1, NEQ
        X(K) = X(K) - A(IDX(K),I)*X(I)
     END DO
     ! Compute unknown
     X(K) =  X(K) / A(IDX(K), K)
  END DO

  ! Done
  RETURN
  END SUBROUTINE gauss

  SUBROUTINE gauss_simple(A,B,X,error)
! Bare bone Gauss elimination
! Solves the system of linear equations
!     Ax = b
! A and b are changed by the routine!
! Whenever a diagonal element is zero this routine will fail to produce
! a solution

  REAL(WP), INTENT(IN OUT) :: A(:,:)
  REAL(WP), INTENT(IN OUT) :: B(:)

  INTEGER, INTENT(IN OUT) :: ERROR
  REAL(WP), INTENT(OUT) :: X(:)

  INTEGER :: i, k, J, N
  REAL(wp) :: md

  N = SIZE(B)
  ERROR = 0

  ! Gauss elimination (creation of upper triangular matrix)
  DO k = 1, N-1
     IF (ABS(a(k,k)) < 0.0000001) THEN
        error = -1
        RETURN
     ENDIF
     DO i = k+1, N
        md = a(i,k)/a(k,k)
        DO j = k+1, n
           a(i,j) = a(i,j) - md*a(k,j)
        END DO
        b(i) = b(i) - md*b(k)
     END DO
     !!! Poor man debugger; uncomment if you want to see the matrix changes
     !!DO i = 1, n
     !!   WRITE(6,'(5G12.6)') (A(i,J), J = 1, n), B(I)
     !!END do
  END DO

  ! Back substitution part
  DO k = n, 1, -1
     x(k) = b(k)
     DO I = K+1, N
        x(k) = x(k) - A(k,i)*X(I)
     END DO
     x(k) = x(k) / a(k,k)
  END DO
  RETURN
  END SUBROUTINE gauss_simple

  SUBROUTINE GSIT(A,B,EPS,OMEGA,MAXIT,X,ERROR)
!
! Gauss-Seidel over-relaxation algorithm for the iterative solution of
! systems of linear equations:
!                        A*X = B
!
! The matrix A is of size (NEQ,NEQ) and has to be diagonal dominant.
! B is the right hand side vector of size (NEQ).
! eps is a small real number specifying the required accuracy of
! the solution.
! OMEGA is the relaxation parameter (real). Must be in the open interval
! (0,2). If you do not know the problem dependend proper value, let
! omega=1.0 (no relaxation, pure Gauss-Seidel iteration).
! Start testing with omega=1.5, if you are of the adventurous kind.
! MaxIt is the maximum number of iterations allowd for solving the LGS.
! X contains the initial solution when the procedure is called and
! on return provides the solution vector X.
! Error returns the status of the subroutine:
!    error = -1 : Critical error condition. One of the main diagonal
!                 elements of the matrix is (almost) zero. The
!                 system can not be solved with this routine.
!    error = -2 : The solution did not converge to the required accuracy.
!                 The parameter MaxIt iterations was reached.
!    error > 0 :  The system is successfully solved and ERROR iterations
!                 have been used for the solution.
!
  INTEGER, INTENT(IN) :: MAXIT
  REAL(WP), INTENT(IN) :: A(:,:)
  REAL(WP), INTENT(IN) :: B(:)
  REAL(WP), INTENT(IN) :: EPS,OMEGA

  INTEGER, INTENT(IN OUT) :: ERROR
  REAL(WP), INTENT(OUT) :: X(:)

  INTEGER :: I, J
  INTEGER :: NEQ
  REAL(WP) :: Xold(SIZE(X))

  ! Initialize variables
  ERROR = 0
  NEQ = SIZE(B)  ! Number of equations

  ! Simple error check. None of the elements on the main diagonal
  ! of A is allowed to be zero
  DO i = 1, NEQ
    IF (ABS(A(i,i)) < 0.0000001) THEN
      ERROR = -1
      RETURN
    END IF
  END DO

  DO J = 1, MAXIT   ! LOOP OVER ITERATIONS
    Xold = X  ! Store last solution for convergence test
    ! The following loop contains the Gauss-Seidel over relaxation algorithm
    DO I = 1, NEQ
      X(i) = (1.-omega)*X(i) &
                  - omega*SUM(A(i,1:i-1)*X(1:i-1))/A(i,i) &
                      - omega*SUM(A(i,i+1:NEQ)*X(i+1:NEQ))/A(i,i) &
                          + omega*B(i)/A(i,i)
    END DO
    ! Check for convergence. If the absolute difference between
    ! the next to last (Xold) and the last iteration step is smaller
    ! than eps exit iteration loop
    IF (SQRT(SUM((X-Xold)**2))/SQRT(SUM(Xold**2)) < eps ) THEN
      error = j
      EXIT
    END IF
    ! This line should not be reached if the matrix is properly
    ! scaled
    error = -2  ! Return value for bad convergence, i.e. j=MaxIt
  END DO

  RETURN
  END SUBROUTINE gsit

   SUBROUTINE SIMQIT(A,R,N,NMAX,SING,AV,DX,X,iter)
!
! Iterative solution of a non-singular, REAL linear system of equations
! A X = R, WHERE A, X and R are (n by n), (n by 1) and (n by 1) matrices,
! respectively. (n by c) means: n rows, c columns.

! Method: Incomplete Gauss elimination: Those matrix coefficients
! the absolute
! value of which exceeds the column pivot element times the value
! AVERH are
! eliminated before a Gauss-Seidel iteration WITH column pivoting
! is applied.
! IF no convergence is encountered, another elimination step
! is performed
! WITH half the previous value of AVERH. The starting value of
! AVERH is AV.

! PARAMETER A (input; changed): Two-index array of size 1:NMAX >= n,
! 1: >= n + 2) containing the elements of the matrix A. FIRST INDEX
! COUNTS COLUMNS, LAST INDEX COUNTS ROWS.
! PARAMETER R (input; changed): One-index array containing the elements
!  of the   matrix R
! PARAMETER N (input): Number of unknowns
! PARAMETER NMAX (input): Maximum defined value of first index of A
! PARAMETER SING (input): Lower limit of absolute value of pivot
! elements. IF
!     a division by an element the absolute value of which is smaller
!     than SING
!     would be required, elimination is stopped WITH an error message
!     indicating
!     the indices of those equations which are responsible for the
!     difficulty.
!     It is recommended to generate the equation system such that
!     maximum
!     absolute values of the elements of A in each row and column DO
!      not differ
!     by orders of magnitude. THEN, for SING a value of 10**-5 times
!     that
!     maximum absolute value may be recommended.
! PARAMETER AV (input): See above under method. Recommended value:
!     SQRT(1/N).
! PARAMETER DX: The iteration stops IF the maximum absolute change of
!     any
!     unknown within one iteration step is smaller than DX.
! PARAMETER X (input and RESULT): array of size 1: >= n containing
!     an estimated
!     solution when calling the SUBROUTINE (IF no estimation is
!     available, 0 is
!     recommended), and the solution vector X after RETURN
! Parameter iter (output): integer, number of iterations needed
!

   USE precise, ONLY: DEFAULTP
   IMPLICIT NONE
   INTEGER, PARAMETER :: WP=DEFAULTP

   INTEGER IS, ITER, IZ, IZPIV, IZ1, N, NMAX
   REAL(wp) AA,AV, AVERH, ALIMIT, BMAX, DX, DXMAX, DXMAXV, SAVEAIJ, SING
   !REAL(wp) A(NMAX,N+2), R(N), X(N)
   REAL(wp), DIMENSION(:,:) :: A
   REAL(wp), DIMENSION(:) :: R, X
! Initial values for R and (n+2)nd column of A (equation numbers)
   DO IS=1,N
      A(IS,N+2)=IS+0.5
   END DO
   DO IZ=1,N
      DO IS=1,N
         R(IZ)=R(IZ)-X(IS)*A(IS,IZ)
      END DO
   END DO
   AVERH=AV*1.4
   iter=1
3 CONTINUE
      AVERH=AVERH/1.4
      iter=iter+1
      !PRINT*, "simqit: iter=", iter
!     For all rows
      !!PRINT*, A(N,:)
      DO IZ = 1,N
!     Search for pivot element
         !PRINT*, IZ
	 BMAX=0.
	 DO  IZ1 = IZ,N
	    IF(ABS(A(IZ,IZ1)).GT.BMAX)THEN
	       IZPIV = IZ1
	       BMAX = ABS(A(IZ,IZ1))
	    ENDIF
         END DO
         !!PRINT*, BMAX
	 IF (BMAX.LT.SING) THEN
	    WRITE(*,*)'Equation system is singular: Bmax=',BMAX
	    STOP
	 ENDIF
!        Exchange of pivot and IZ rows; normalization of pivot row
	 ALIMIT = BMAX*AVERH
	 BMAX=SIGN(BMAX,A(IZ,IZPIV))
	 IF (IZPIV.EQ.IZ) THEN
	    DO IS=1,N
               A(IS,IZ)=A(IS,IZ)/BMAX
            END DO
	 ELSE
	    DO IS = 1,N
               SAVEAIJ=A(IS,IZPIV)
	       A(IS,IZPIV)=A(IS,IZ)
               A(IS,IZ)=SAVEAIJ/BMAX
            END DO
	 ENDIF
	 SAVEAIJ=A(IZPIV,N+2)
	 A(IZPIV,N+2)=A(IZ,N+2)
	 A(IZ,N+2)=SAVEAIJ
	 SAVEAIJ=R(IZPIV)
	 R(IZPIV)=R(IZ)
	 R(IZ)=SAVEAIJ/BMAX
!     Elimination of large coefficients
	 DO IZ1=IZ+1,N
	    AA=-A(IZ,IZ1)
	    IF (ABS(AA).GT.ALIMIT) THEN
	       DO IS=1,N
                  A(IS,IZ1)=A(IS,IZ1)+AA*A(IS,IZ)
               END DO
	       R(IZ1)   =R(IZ1)   +AA*R(IZ)
	    ENDIF
         END DO
      END DO
!     Determination of changes of X stored in A(IZ,N+1)
      DXMAXV=1.E30
60    CONTINUE
      DXMAX=0
      DO IZ=N,1,-1
	 A(IZ,N+1)=R(IZ)
	 DO IS=IZ+1,N
            A(IZ,N+1)=A(IZ,N+1)-A(IS,IZ)*A(IS,N+1)
         END DO
	 DXMAX=MAX(DXMAX,ABS(A(IZ,N+1)))
         X(IZ)=X(IZ)+A(IZ,N+1)
      END DO
      IF(DXMAX.LT.DX) RETURN
!     Update of absolute value vector R
      DO IZ=1,N
	 R(IZ)=0.
	 DO IS=1,IZ-1
            R(IZ)=R(IZ)-A(IS,N+1)*A(IS,IZ)
         END DO
      END DO
      IF(DXMAX.GT.0.8*DXMAXV) GOTO 3
      DXMAXV=DXMAX
      GOTO 60
   END SUBROUTINE simqit

END MODULE SLAE


module mydefs

    implicit none

    integer, parameter :: rk = selected_real_kind(15,300)
    integer, parameter :: ik = selected_int_kind(5)
    integer, parameter :: iw1=15, iw2=16, iw3=17, iw4=18
    real(rk), parameter :: pi = 3.141592653589793238462643383279502884197_rk
    real(rk), parameter :: autoaa = 0.529177_rk

contains

    real(rk) function rad(ang)

    real(rk), intent(inout) :: ang
    real(rk) :: den

    den = 180.000000_rk
    rad = ang * pi / den

    end function rad

    real(rk) function deg(ang)

    real(rk), intent(inout) :: ang
    real(rk) :: den

    den = 180.000000_rk
    deg = ang * den / pi

    end function deg

end module mydefs


module factorial_mod
contains
   ! computes the factorial of n
   integer function factorial(n)
      implicit none
      integer, intent(in) :: n
      integer r
      integer i
      if(n < 0) then
         write(*,*) 'Received negative input'
         stop
      end if
      r = 1
      do i = 1,n
         r = r*i
      end do
      factorial=r
   end function factorial
end module factorial_mod


!-------------------------------------------------------------------
!..AN IMPLICIT FD SOLVER FOR THE 1-D LINEAR CONVECTION EQUATION
!-------------------------------------------------------------------
Module vars
  integer, parameter :: imax=401, ntout=1
  integer :: ntmax
  real, dimension(imax) :: wave_n
  real, dimension(imax) :: a, b1, c
  real :: sigma, d, dx=0.1, x1 , b=0.025, pi= 3.1415926 !ACOS(-1.)
End module

program IMPLICIT_FDE
   use vars

   call INIT             !..Read the input data, and initialize the wave
   DO nt = 1,ntmax       !..Start the solution loop

      do i = 2, imax-1
         a(i) = -(sigma/2.)-d
         b1(i) = 2.*d + 1.
         c(i) = (sigma/2.)-d
      enddo

      call THOMAS(imax, 2, imax-1, a, b1, c, wave_n(:))

!..Output intermediate solutions
      if( MOD(nt,ntout) .eq. 0 .or. nt .eq. ntmax ) call IO(nt)
   ENDDO

   stop
end program IMPLICIT_FDE

!------------------------------------------------------------------------
subroutine INIT
  use vars

  write(*,'(/(a))',advance='no')'  Enter sigma, d and ntmax : '
  read(*,*) sigma, d,  ntmax
  x1=-imax*dx/2.
   x = x1
   do i = 1,imax             !..Initialize the wave
      wave_n(i) = exp(-b * log(2.) * (x/dx)**2)
      x = x+dx
   enddo
  call IO(0)

  return
end subroutine INIT

!-------------------------------------------------------------------
subroutine  IO(nt)
   use vars
   character :: fname*32,string*6,ext*3
   write(string,'(f5.3)') float(nt)/1000
   read(string,'(2x,a3)') ext
   fname = 'wave-'//ext//'.dat'
   open(1,file=fname,form='formatted')
   !write(1,*)'ZONE'
   x = x1
   do i=1,imax
     write(1,'(2e14.6)')x, wave_n(i)
     x = x+dx
   enddo
   close(1)
   return
end
!-------------------------------------------------------------------
subroutine  THOMAS(imax, il, iu, a, b, c, f)
   integer ::  imax, il ,iu, ilp1, iupil
   real, dimension(imax) :: a, b, c, f, x
   real :: z
   x(il) = c(il) / b(il)
   f(il) = f(il) / b(il)
   ilp1 = il+1
   do i = ilp1, iu
      z= 1. / (b(i)- a(i)*x(i-1))
      x(i)= c(i) * z
      f(i)= ( f(i) - a(i) * f(i-1) ) * z

   ENDDO
   iupil = iu + il
   do ii = ilp1, iu
      i = iupil - ii
      f(i) = f(i) - x(i) * f(i+1)
   ENDDO

   return
   end


module mGf90
  use cholf90
  use gasdevf90
  implicit none

contains
 real function multigauss(R,mu,n) result(G)
!!$ Generates a one dimensional array of length n containing multivariate Gaussian pseudo-random numbers
!!$ where R is the lower-triangular Cholesky factor of the covariance matrix of the desired distribution
!!$ and mu is a one dimensional array of length n, containing the mean value for each random variable.
!!$ R must be a one dimensional array, containing the lower-triangular matrix stored by row, starting from the
!!$ uppermost, leftmost entry (first row, first column).
   implicit none
   integer, intent(in) :: n
   real, intent(in) :: R(n*(n+1)/2)
   real, intent(in) :: mu(n)
   real :: Nu(n)
   dimension :: G(n)
   integer :: i, j

   if( n*(n+1)/2 .ne. size(R) ) then
      write(6,*) ' n*(n+1)/2 != size(R) in multiGauss '
      write(6,*) ' Cholesky factor matrix has size ', size(R)
      write(6,*) ' but you are requesting a vector of size ',n
      stop
   else

!!$ generate an array of independent Gaussian variates
      do j = 1, n
         Nu(j) = gasdev()
      end do

!!$ start with the desired mean, and add the product of
!!$ [the lower-triangular Cholesky factor of the covariance matrix] x [ the vector of iid Gaussian variates]
      do i = 1, n
         G(i) = mu(i)
         do j =  1,i
            G(i) = G(i) + R( i*(i-1)/2 + j ) * Nu(j)
         end do
      end do

   end if
   return
 end function multigauss
end module mGf90


subroutine gausspp(a, b, l, deter)
  implicit none

  real, dimension(:,:), intent(inout) :: a
  real, dimension(:), intent(inout) :: b
  integer, dimension(:), intent(inout) :: l
  real, intent(out) :: deter

  real :: piv, z
  integer :: i, j, k, m, n, p, li, lk

  n = size(b)

  deter = 1

  l = (/(i,i=1,n)/)

  do k=1, n-1
    piv=a(l(k),k)
    p = k
    do i = k+1, n
      if(abs(piv) < abs(a(l(i), k))) then
        piv = a(l(i), k)
        p = i
      end if
    end do

    if(abs(piv) < 1.e-12) then
      print*, 'Pivote nulo na etapa: ', k
      print*, 'A matriz do sistema e singular! '
      stop
    end if

    deter=deter*piv

    if(p /= k) then

      deter = -deter

      m = l(k)
      l(k) = l(p)
      l(p) = m
    end if

    piv = a(l(k), k)
    lk = l(k)

    do i=k+1, n
      li = l(i)
      z=a(li,k)/piv

      do j=k+1,n
        a(li, j) = a(li, j) - z*a(lk, j)
      end do

      b(li)=b(li)-z*b(lk)
    end do
    print*, 'Etapa',k, l(:)
  end do
    piv = a(l(n),n)

    if(abs(piv)<1.e-12) then
      print*, 'Pivote nulo na etapa: ', n
      print*, 'A matriz do sisema e singular!'
      stop
    end if

   deter = deter*piv

end subroutine


PROGRAM LAPLACE
    INTEGER, PARAMETER :: XSIZE=11,YSIZE=11
    REAL(8), DIMENSION(1:XSIZE,1:YSIZE) :: PHIOLD,PHINEW,ERROR
    REAL :: MAXDELTA
    REAL(8) :: ERRORSUM,NSQ=XSIZE*YSIZE

    REAL(8), PARAMETER :: CONVERGENCE = EPSILON(ERRORSUM)
    INTEGER :: ITERATIONS = 0

    INTEGER :: I,J

    DO I=1,XSIZE
        DO J=1,YSIZE
            PHINEW(I,J) = (I*I-J*J)/(NSQ)
        END DO
    END DO

    PHINEW(2:XSIZE-1,2:YSIZE-1)=0

    open(10,file='gs_11.csv')

    GAUSS_ITERATION: DO
        ITERATIONS = ITERATIONS+1
        PHIOLD=PHINEW

        DO I=2,XSIZE-1
            DO J=2,YSIZE-1
                PHINEW(I,J)=0.25*(&
                    &PHINEW(I-1,J)+&
                    &PHINEW(I+1,J)+&
                    &PHINEW(I,J-1)+&
                    &PHINEW(I,J+1))
            END DO
        END DO
        ERROR = PHIOLD-PHINEW
        ERRORSUM = SQRT(SUM(ERROR*ERROR)/NSQ)
        write(10,*) ERRORSUM, ITERATIONS
        IF (ERRORSUM < 2*CONVERGENCE) EXIT GAUSS_ITERATION

     END DO GAUSS_ITERATION

    close(10)
END PROGRAM LAPLACE


program exo4_3

    ! A program which reads an integer value limit and
    ! prints the coefficients of the first limit lines of this Pascal triangle.
    implicit none
    integer :: limit, k, n, iter_n, iter_k

    write(6, '(a)', advance='no') "Pascal triangle - Numbe of rows: "
    read(5, '(i3)') limit
    do iter_n = 0, limit-1
        n = iter_n
        do iter_k = 0, n
            k = iter_k
            write(6, '(i3)', advance='no') pascal_rule(n, k)
        end do
        print *, ''
    end do

contains
    recursive integer function factorial(number) result(facto)
        integer, intent(in) :: number
        if ( number .eq. 0 .or. number .eq. 1 ) then
            facto = 1
        else
            facto = number * factorial(number-1)
        end if
    end function factorial

    ! This function implements "n choose k" => nCk = n! / ((n - k)!k!)
    integer function pascal_rule(n, k) result(binomial_coefficient)
        integer, intent(in) :: n,k
        binomial_coefficient = factorial(n) / (factorial(n-k) * factorial(k))
    end function pascal_rule

end program exo4_3


program tarefa5

    ! Definindo a variáveis com precisão dupla
    real*8 :: dlnx, dx, derro, dlogx

    ! definindo precisão e erro inicial
    eprec = 10e-5
    erro = 2*eprec
    slnx = 0e0
    n = 0

    ! Recebe o valor de x
    print *, 'Digite um x Real, 0 < x < 2:'
    read (*,*) x

    ! verifica se está dentro do raio de convergencia
    if ((x.le.0) .or. (2e0.le.x)) then
        print *, 'x está fora do raio de convergencia'
        ! sai do programa
        stop
    end if

    slogx = log(x)

    ! calcula a aproximação até atingir o erro eprec
    ! ou até que não haja mais variação no erro
    do while ((erro.ge.eprec) .and. (erro.ne.abs(slogx - slnx)))
        erro = abs(slogx - slnx)
        n = n + 1
        slnx = slnx -(1e0 - x)**n/n
    end do

    print *, 'Precisão Simples'
    print *, 'Num iter: ', n
    print *, 'log(x):   ', slogx
    print *, 'Aprox:    ', slnx
    print *, 'erro:    ', erro

    ! valores iniciais para a precisão dupla
    dx = x
    derro = 0d0
    dlnx = 0d0
    n = 0

    dlogx = dlog(dx)

    ! calcula a aproximação até que não haja mais variação do erro
    do while (derro.ne.abs(dlogx - dlnx))
        derro = abs(dlogx - dlnx)
        n = n + 1
        dlnx = dlnx -(1 - dx)**n/n
    end do

    print *, ''
    print *, ''
    print *, 'Precisão Dupla'
    print *, 'Num iter: ', n-1
    print *, 'dlog(x):   ', dlogx
    print *, 'Aprox:    ', dlnx
    print *, 'erro:    ', derro

end program tarefa5