#include "eiscor.h"
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! DOFFQR (Double Orthogonal hessenberg Factored Fast QR)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! This routine computes the eigenvalues and optionally eigen(Schur)vectors of
! an orthogonal upper hessenberg matrix that is stored as a product of
! givens rotations and a diagonal matrix.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! INPUT VARIABLES:
!
!  COMPZ           CHARACTER
!                    'N': no eigenvectors
!                    'I': eigenvectors, initializing Z to the identity
!                    'V': eigenvectors, assume Z already initialized
!
!  N               INTEGER
!                    dimension of matrix
!
!  Q               REAL(8) array of dimension (2*(N-1))
!                    array of generators for givens rotations
!
!  D               REAL(8) array of dimension (2*N)
!                    array of generators for complex diagonal matrix
!                    on output contains the eigenvalues
!
! OUTPUT VARIABLES:
!
!  Z               COMPLEX(8) array of dimension (N,N)
!                    if COMPZ = 'N' unused
!                    if COMPZ = 'I' stores eigenvectors in Z
!                    if COMPZ = 'V' update Z to store eigenvectors
!
!  ITS             INTEGER array of dimension (N-1)
!                    Contains the number of iterations per deflation
!
!  INFO            INTEGER
!                    INFO = 1 implies failure to converge
!                    INFO = 0 implies successful computation
!                    INFO = -1 implies COMPZ is invalid
!                    INFO = -2 implies N, Q, or D is invalid
!                    INFO = -3 implies Z is invalid
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine DOFFQR(COMPZ,N,Q,D,Z,ITS,INFO)

  implicit none

  ! input variables
  character, intent(in) :: COMPZ
  integer, intent(in) :: N
  integer, intent(inout) :: INFO, ITS(N-1)
  real(8), intent(inout) :: Q(2*N-1), D(2*N), Z(N,N)

  ! compute variables
  integer :: ii, jj, kk, ind, m
  integer :: start_index, stop_index, zero_index, it_max, it_count
  real(8) :: block(2,2)
  complex(8) :: temp(2,2), eigs(2)

  ! initialize INFO
  INFO = 0

  ! check COMPZ
  if ((COMPZ.NE.'N').AND.(COMPZ.NE.'I').AND.(COMPZ.NE.'V')) then
    INFO = -1

    ! print error in debug mode
    if (DEBUG) then
      call UARERR(__FILE__,__LINE__,"COMPZ must be 'N', 'I' or 'V'",INFO,INFO)
    end if

    return
  end if

  ! check factorization
  call DOFCHF(N,Q,D,INFO)

  ! print error in debug mode
  if (DEBUG) then
    call UARERR(__FILE__,__LINE__,"Invalid factorization",INFO,INFO)
  end if

  if (INFO.NE.0) then
    INFO = -2
    return
  end if

    ! check Z
    if (COMPZ.EQ.'V') then

      call DARACH2(N,N,Z,INFO)

      ! print error in debug mode
      if (DEBUG) then
        call UARERR(__FILE__,__LINE__,"Z is invalid",INFO,INFO)
      end if

      if (INFO.NE.0) then
        INFO = -3
        return
      end if

    end if

  ! initialize storage
  ITS = 0

  if (COMPZ.EQ.'I') then
    Z = 0d0
    do ii=1,n
      Z(ii,ii) = 1d0
    end do
  end if

  ! initialize indices
  start_index = 1
  stop_index = N-1
  zero_index = 0
  it_max = 20*N
  it_count = 0

  ! loop for bulgechasing
  do kk=1,it_max

    ! check for completion
    if(stop_index <= 0)then
      exit
    end if

    ! check for deflation
    call DOFGRD(N,start_index,stop_index,zero_index,Q,D,it_count,ITS,INFO)

    ! check INFO in debug mode
    if (DEBUG) then
      call UARERR(__FILE__,__LINE__,"DOFGRD failed",INFO,INFO)
      if (INFO.NE.0) then
        return
      end if
    end if

    ! if 1x1 block remove and check again
    if(stop_index == zero_index)then

      ! update indices
      stop_index = stop_index - 1
      zero_index = 0
      start_index = 1

    ! if 2x2 block remove and check again
    else if(stop_index == start_index)then

      ! get 2x2 block
      call DOFTDB(N,stop_index,Q,D,block,INFO)

      ! check INFO in debug mode
      if (DEBUG) then
        call UARERR(__FILE__,__LINE__,"DOFTDB failed",INFO,INFO)
        if (INFO.NE.0) then
          return
        end if
      end if

      ! detm > 0
      if ((block(1,1)*block(2,2) - block(2,1)*block(1,2)) > 0) then

        ! store eigenvalues
        D(2*(stop_index-1)+1) = block(1,1)
        D(2*(stop_index-1)+2) = block(1,2)
        D(2*(stop_index-1)+3) = block(2,2)
        D(2*(stop_index-1)+4) = block(2,1)

      ! detm < 0
      else

        ! compute eigenvalues and eigenvectors
        call DTTEEV(block,eigs,temp,INFO)

        ! check INFO in debug mode
        if (DEBUG) then
          call UARERR(__FILE__,__LINE__,"DTTEEV failed",INFO,INFO)
          if (INFO.NE.0) then
            return
          end if
        end if

        ! store eigenvalues
        D(2*(stop_index-1)+1) = sign(1d0,dble(eigs(1)))
        D(2*(stop_index-1)+2) = 0d0
        D(2*(stop_index-1)+3) = sign(1d0,dble(eigs(2)))
        D(2*(stop_index-1)+4) = 0d0

        ! update eigenvectors
        if (COMPZ.NE.'N') then

          block(1,1) = dble(temp(1,1))
          block(2,1) = dble(temp(2,1))
          block(1,2) = dble(temp(1,2))
          block(2,2) = dble(temp(2,2))

          Z(:,stop_index:(stop_index+1)) = matmul(Z(:,stop_index:(stop_index+1)),block)
        end if

      end if

      ! update Q
      Q(2*(stop_index-1)+1) = 1d0
      Q(2*(stop_index-1)+2) = 0d0

      ! update indices
      stop_index = stop_index-2
      zero_index = 0
      start_index = 1

    ! if greater than 2x2 chase a bulge and check again
    else

      ! chase bulge
      call DOFDFI(COMPZ,N,start_index,stop_index,Q,D,Z,it_count,INFO)

      ! check INFO in debug mode
      if (DEBUG) then
        call UARERR(__FILE__,__LINE__,"DOFDFI failed",INFO,INFO)
        if (INFO.NE.0) then
          return
        end if
      end if

    end if

    ! if it_max hit
    if (kk == it_max) then
      INFO = 1
      ITS(stop_index) = it_count
      return
    end if

  end do

end subroutine DOFFQR


MODULE m_interpclocks

! ----------------------------------------------------------------------
! MODULE: m_interpclocks.f03
! ----------------------------------------------------------------------
! Purpose:
!  Module for calling the interp_clocks subroutine used for
!  GNSS satellite clocks errors interpolation
!
! Subroutines contained within the module:
! - interp_clocks.f03
! ----------------------------------------------------------------------
! Author :	Dr. Thomas Papanikolaou at Geoscience Australia
! Created:	27 May 2020
! ----------------------------------------------------------------------

      IMPLICIT NONE
      !SAVE

Contains

SUBROUTINE interp_clocks (ORB_matrix, CLKmatrix, PRNmatrix, CLKmatrix_int)

! ----------------------------------------------------------------------
! SUBROUTINE: interp_clocks.f90
! ----------------------------------------------------------------------
! Purpose:
!  GNSS sp3 clocks interpolation based on Lagrange polynomials
! ----------------------------------------------------------------------
! Input arguments:
! - ORBmatrix:      Satellite Orbits' allocatable array (3-dimensional)
! - CLKmatrix:		Satellite Clocks' allocatable array (3-dimensional)
!					CLKmatrix(i,j,isat) = [MJD Sec_of_day clock]
!					If clock error (sdev) is available (when Position and Velocity vector are written in orbit sp3 format)
!					CLKmatrix(i,j,isat) = [MJD Sec_of_day clock clock_sdev]
! - PRNmatrix:      Satellites' PRN numbers allocatable array
!
! Output arguments:
! - CLKmatrix_int:  Interpolated Satellite Clocks' allocatable array (3-dimensional)
! ----------------------------------------------------------------------
! Author :	Dr. Thomas Papanikolaou at Geoscience Australia
! Created:	27 May 2020
! ----------------------------------------------------------------------

      USE mdl_precision
      USE mdl_num
      USE m_sp3
      USE m_lagrange
      !USE m_orb_outlier
      !USE m_interporb_nom
      !USE m_interporb_filt
      USE m_writearray
      USE m_interpclock_nom
      IMPLICIT NONE

! ----------------------------------------------------------------------
! Dummy arguments declaration
! ----------------------------------------------------------------------
! IN
      REAL (KIND = prec_q), INTENT(IN), DIMENSION(:,:,:), ALLOCATABLE :: ORB_matrix, CLKmatrix
	  CHARACTER (LEN=3), ALLOCATABLE, INTENT(IN) :: PRNmatrix(:)
! OUT
      REAL (KIND = prec_q), INTENT(OUT), DIMENSION(:,:,:), ALLOCATABLE :: CLKmatrix_int
! ----------------------------------------------------------------------

! ----------------------------------------------------------------------
! Local variables declaration
! ----------------------------------------------------------------------
      INTEGER (KIND = prec_int2) :: AllocateStatus, DeAllocateStatus
      CHARACTER (LEN=300) :: fname_write
      REAL (KIND = prec_q), DIMENSION(:,:), ALLOCATABLE :: clock_matrix
! ----------------------------------------------------------------------
      INTEGER (KIND = prec_int8) :: i, interv_in, NPint
      INTEGER (KIND = prec_int8) :: Nepochs_orb, Nepochs_clk, Nelements_clk, Nsat_clk
      INTEGER (KIND = prec_int8) :: sz1, sz2, sz3
      INTEGER (KIND = prec_int8) :: orb_rate, clk_rate

! remove warning
orb_rate = 0.d0
clk_rate = 0.d0

! ----------------------------------------------------------------------
sz1 = size(ORB_matrix, DIM = 1)
Nepochs_orb = sz1

sz1 = size(CLKmatrix, DIM = 1)
Nepochs_clk = sz1

sz2 = size(CLKmatrix, DIM = 2)
Nelements_clk = sz2

sz3 = size(CLKmatrix, DIM = 3)
Nsat_clk = sz3
! ----------------------------------------------------------------------

! ----------------------------------------------------------------------
! Orbits rate
      DO i = 1 , Nepochs_orb - 1
		if ( INT(ORB_matrix(i+1,1,1)) - INT(ORB_matrix(i,1,1)) == 0 ) then
			orb_rate = INT( ORB_matrix(i+1,2,1) - ORB_matrix(i,2,1) )
			EXIT
		end if
	  End Do

! Clocks rate
      DO i = 1 , Nepochs_clk - 1
		if ( INT(CLKmatrix(i+1,1,1)) - INT(CLKmatrix(i,1,1)) == 0 ) then
			clk_rate = INT( CLKmatrix(i+1,2,1) - CLKmatrix(i,2,1) )
			EXIT
		end if
	  End Do
! ----------------------------------------------------------------------

! ----------------------------------------------------------------------
IF (clk_rate == orb_rate) THEN

! Allocatable arrays for the interpolated orbit array
ALLOCATE (CLKmatrix_int(Nepochs_clk, Nelements_clk, Nsat_clk) , STAT = AllocateStatus)

CLKmatrix_int(:,:,:) = CLKmatrix(:,:,:)

ELSE

interv_in = orb_rate
NPint = 12
CALL interpclock_nom (ORB_matrix, CLKmatrix, PRNmatrix, interv_in, NPint, CLKmatrix_int)

END IF
! ----------------------------------------------------------------------

End subroutine

END Module


      SUBROUTINE INPUT
C
C THIS ROUTINE INPUTS OR DETERMINES NECESSARY CONSTANTS, CALLS
C THE ROUTINES WHICH CALCULATE GAUSSIAN LATITUDES, WEIGHTS, BASIS
C FUNCTIONS (ASSOCIATED LEGENDRE POLYNOMIALS) AND DERIVATIVES, AND
C CALLS ROUTINES TO DO THE INITIAL SETUP FOR THE FAST FOURIER
C TRANSFORM PROCEDURE (IN THIS CASE SET99).
C
C CALLED BY: STSWM
C CALLS: CALP, CEPS, EPSLON, GLAT, GLON, GLATS, SET99
C
C REVISIONS:
C 7-13-92 CHANGE TO CCM CODING CONVENTIONS (R. JAKOB)
C
C---- Model Parameters -------------------------------------------------
C
      INCLUDE 'params.i'
C
C---- Common Blocks ----------------------------------------------------
C
C TRANSFORM ARRAYS
      INCLUDE 'trnsfm.i'
C CONSTANTS & TIMESTEPS
      INCLUDE 'consts.i'
C PLOT DATA
      INCLUDE 'complt.i'
C
C------ Local Parameters -----------------------------------------------
C
      REAL PI
      PARAMETER (PI=3.141592653589793)
C
C------ Local Variables ------------------------------------------------
C
C*    The following arrays contain information required for calculation*
C*    of the Legendre Polynomials and derivatives using the method     *
C*    proposed by Belousov (1962).  The length of the three recurrence *
C*    coefficient matrices used in this procedure is given by the      *
C*    relation LRM + 1 = ((MM+1)*(KK+1)-(MM**2+MM)/2).  The length of  *
C*    each row is stored in the array LROW(0:KK,1).  If the Belousov   *
C*    algorithm is not selected, LRM can be set to 0 to save static    *
C*    storage.  This is also where we store EPSIL which is used in a   *
C*    simpler polynomial recurrence relationship as well as in the     *
C*    calculation of the polynomial derivatives.
C*    The arrays are passed from subroutine CEPS to CALP.
C*                                                                     *
      REAL CMN(LRM+1), DMN(LRM+1), EMN(LRM+1), EPSIL(NALP)
      INTEGER LROW(0:KK,2)
C
C     TEMPORARIES
C
      INTEGER I,J,N,NL,IGROUP,LATMIN
      REAL RLAT
C
C----- External Functions ----------------------------------------------
C
C     MACHINE EPSILON FUNCTION
C
      EXTERNAL EPSLON
      REAL EPSLON
C
C     LAT./LONG. GRID
C
      EXTERNAL GLAT, GLON
      REAL GLAT, GLON
C                                                                     *
C----- Namelist Input Blocks -------------------------------------------
C
      NAMELIST /EXPDEF/ DT, SITS, AFC, TAUE, TAUO, GPHFRQ, SPCFRQ,
     $                  FORCED, MOMENT, EGYFRQ, ERRFRQ, ICOND
C
      NAMELIST /PHYVAR/ A, OMEGA, GRAV, HDC, ALPHA
C
      NAMELIST /PLTDEF/ LCONT, LPSP, LOP, LCP, LG, LU, LV, LZ, LD, LVV,
     $                  LVVG, LGPHS, POLAT, POLNG, POROT
      NAMELIST /FNAMES/ FNIN, FNOUT
C
C----- Executable Statements -------------------------------------------
C
C     THE FOLLOWING PHYSICAL CONSTANTS ARE DEFINED AS:
C        A      => RADIUS OF THE EARTH
C        OMEGA  => ANGULAR VELOCITY OF THE EARTH
C        GRAV   => GRAVITATIONAL CONSTANT
C        HDC    => LINEAR HORIZONTAL DIFFUSION COEFFICIENT
C        ALPHA  => ROTATION ANGLE OF COORDINATE SYSTEM
C
      A      = 6.37122E6
      OMEGA  = 7.292E-5
      GRAV   = 9.80616
      HDC    = 0.0E00
      ALPHA  = ATAN(1.0)
C
C     OTHER CONSTANTS/VARIABLES REQUIRED FOR MODEL INTEGRATION:
C        DT     => TIME STEP IN SECONDS
C        AFC    => ASSELIN FILTER PARAMETER
C        TAU    => CURRENT MODEL TIME (IN HOURS)
C        TAUO   => FREQUENCY OF PRINTED OUTPUT (IN HOURS)
C        TAUE   => END OF MODEL RUN (IN HOURS)
C        SITS   => LOGICAL FLAG FOR SEMI-IMPLICIT TIME DIFFERENCING
C        GPHFRQ => FREQUENCY OF DETAILED GRAPHICAL OUTPUT (IN HOURS)
C        EPS    => MACHINE ACCURACY OF FLOATING POINT REPRESENTATION
C        NSTEP  => CURRENT MODEL TIME STEP (NSTEP=0 INITIALLY)
C        FORCED => LOGICAL FLAG .TRUE. IF CALL TO FORCING IN ROUTINE COMP1
C        MOMENT => LOGICAL FLAG .TRUE. FOR MOMENTUM FORCING
C        EGYFRQ => FREQUENCY OF MODEL ENERGETICS EVALUATION (IN HOURS)
C        ERRFRQ => FREQUENCY OF L2-ERROR ANALYSIS (IN HOURS)
C        SPCFRQ => FREQUENCY OF SPECTRAL ANALYSIS (IN HOURS)
C        ICOND  => TYPE OF INITIAL CONDITIONS (DEFAULT = 2)
C                  (ARE SET UP IN SUBROUTINE INIT)
C        FTOPO  => LOGICAL FLAG .TRUE. IF SURFACE TOPOGRAPHY (CASE 5)
C
      EPS    = EPSLON(1.0)
      DT     = 2400.0
      AFC    = 0.000
      TAUO   = 999.0
      TAUE   = 120.0
      SITS   = .TRUE.
      GPHFRQ = 24.0
      FORCED = .FALSE.
      MOMENT = .FALSE.
      EGYFRQ = 3.0
      ERRFRQ = 24.0
      SPCFRQ = 999.0
      ICOND  = 2
      FTOPO  = .FALSE.
C
C     GET EXPERIMENT NUMBER FROM EXECUTION ENVIRONMENT
C       (NONSTANDARD)
C
      CALL GETENV('EXPERIMENT',CHEXP)
      IF (CHEXP .EQ. '    ') THEN
         WRITE(0,590)
  590    FORMAT(/,' STSWM: ''EXPERIMENT'' HAS NOT BEEN DEFINED IN',/,
     $            ' ENVIRONMENT; ASSUMING EXPERIMENT=0000')
         CHEXP = '0000'
      ENDIF
      WRITE(6,670) CHEXP
  670 FORMAT(/,' EXPERIMENT ',A4)
C
C     CHECK TRUNCATION PARAMETERS FOR CONSISTENCY
C
      IF ((KK .LT. NN) .OR. (KK .LT. MM)) THEN
         WRITE(0,600) KK,NN,MM
  600    FORMAT (/,' STSWM: FATAL ERROR IN SUBROUTINE INPUT ',/,
     $          ' TRUNCATION PARAMETER KK MUST BE GREATER OR EQUAL'
     $          ' THAN NN AND MM IN FILE ''PARAMS.i'':',/,
     $          ' KK = ',I4,' NN = ',I4,' MM = ',I4)
         STOP
      ENDIF
      IF (KK .GT. MM+NN) THEN
         WRITE(0,605) KK,MM+NN
  605    FORMAT (/,' STSWM: FATAL ERROR IN SUBROUTINE INPUT ',/,
     $          ' TRUNCATION PARAMETER KK MUST BE LESS THAN OR'
     $          ' EQUAL MM+NN IN FILE ''PARAMS.i'':',/,
     $          ' KK = ',I4,' MM+NN = ',I4)
         STOP
      ENDIF
C
C     DETERMINE TRUNCATION TYPE
C
      IF (NN .EQ. KK) THEN
         IF (NN .EQ. MM) THEN
C
C           TRIANGULAR TRUNCATION MM=NN=KK
C
            WRITE(6,20) MM
            WRITE(STRUNC,'(''T-'',I4)') MM
         ELSE
C
C           TRAPEZOIDAL TRUNCATION (NN .GT. MM)
C
            WRITE(6,24) MM,NN
            STRUNC = 'TRAPEZ'
         ENDIF
      ELSE
C
C        NN .LT. KK
C
         IF (KK .EQ. NN+MM) THEN
            IF (NN .EQ. MM) THEN
C
C              RHOMBOIDAL TRUNCATION
C
               WRITE(6,22) MM
               WRITE(STRUNC,'(''R-'',I4)') MM
            ELSE
C
C           PARALLELOGRAMIC TRUNCATION
C
               WRITE(6,23) MM,NN
               STRUNC = 'PARALL'
            ENDIF
         ELSE
C
C           PENTAGONAL TRUNCATION
C
            WRITE(6,26) MM,NN,KK
            STRUNC = 'PENTAG'
         ENDIF
      ENDIF
   20 FORMAT (/,' SPECTRAL TRUNCATION TYPE: TRIANGULAR',
     $        /,' M = N = K = ',I4)
   22 FORMAT (/,' SPECTRAL TRUNCATION TYPE: RHOMBOIDAL',
     $        /,' K = N + M, M = N = ',I4)
   23 FORMAT (/,' SPECTRAL TRUNCATION TYPE: PARALLELOGRAMMIC',
     $        /,' K = N + M, M = ',I4,' N = ',I4)
   24 FORMAT (/,' SPECTRAL TRUNCATION TYPE: TRAPEZOIDAL',
     $        /,' N = K > M, M = ',I4,' N = ',I4)
   26 FORMAT (/,' SPECTRAL TRUNCATION TYPE: PENTAGONAL',
     $        /,' M = ',I4,' N = ',I4,' K = ',I4)
C
C     CHECK GRIDPOINT RESOLUTION
C
      IF (NLON .LT. 3*MM+1) THEN
         WRITE(0,610) NLON,MM
  610    FORMAT (/,' STSWM: FATAL ERROR IN SUBROUTINE INPUT ',/,
     $          ' UNALIASED EVALUATION OF QUADRATIC TERMS REQUIRES',
     $          ' (NLON .GE. 3*MM+1) IN FILE ''PARAMS.i'':',/,
     $          ' NLON = ',I4,' MM = ',I4)
         STOP
      ENDIF
      IF (NN .EQ. KK) THEN
         LATMIN = (3*NN+1)/2
      ELSE
         LATMIN = (3*NN+2*MM+1)/2
      ENDIF
      IF (NLAT .LT. (3*NN+1)/2) THEN
         WRITE(0,620) NLAT,LATMIN
  620    FORMAT (/,' STSWM: FATAL ERROR IN SUBROUTINE INPUT ',/,
     $          ' UNALIASED EVALUATION OF QUADRATIC TERMS REQUIRES',
     $          ' (NLAT .GE. LATMIN) IN FILE ''PARAMS.i'':',/,
     $          ' NLAT = ',I4,' LATMIN = ',I4)
         STOP
      ENDIF
      IF (MOD(NLAT,2) .EQ. 1) THEN
         WRITE(0,630) NLAT
  630    FORMAT (/,' STSWM: FATAL ERROR IN SUBROUTINE INPUT ',/,
     $          ' NLAT MUST BE EVEN TO TAKE ADVANTAGE OF HEMISPHERIC',
     $          ' SYMMETRY PROPERTIES IN FILE ''PARAMS.i'':',/,
     $          ' NLAT = ',I4)
         STOP
      ENDIF
      WRITE (6,640) NLAT, NLON
  640 FORMAT (/,' NUMBER OF GRIDPOINTS IN MODEL'
     $        /,' NORTH-SOUTH GAUSSIAN GRID: NLAT = ',I4,
     $        /,' EAST-WEST EQUIDISTANT GRID: NLON = ',I4)
C
C     PRINT MACHINE EPSILON
C
      WRITE (6,645) EPS
  645 FORMAT (/,' MACHINE EPSILON (1.0 + EPS > 1.0) = ',1PE16.9)
C
C     DETERMINE GUASSIAN LATITUDES AND ASSOCIATED WEIGHTS
C
C     GET LATITUDES AND WGHTS
C
      CALL GLATS(NLAT, EPS, THTA, WTS)
C
C     CALCULATE THE STRUCTURE OF ASSOCIATED LEGENDRE POLYNOMIAL ARRAY,
C     EPSILON ARRAY, AND OTHER REQUIRED RECURRENCE COEFFICIENT MATRICES
C
      CALL CEPS(CMN,DMN,EMN,EPSIL,LROW,LDIAG)
C
C     CALCULATE THE ASSOCIATED LEGENDRE POLYNOMIALS AND DERIVATIVES
C
      CALL CALP(CMN,DMN,EMN,EPSIL,LROW,LDIAG,ALP,DALP)
C
C     CALCULATE ANNP1(KK), A2NNP1(0:KK), AND WTACSJ(1:NLAT)
C     FOR LATER USE IN VARIOUS TRANFORM PROCEDURES.
C
      A2NNP1(0) = 0.0
      DO 70 N=1,KK
         ANNP1(N)  = A/REAL(N*(N+1))
         A2NNP1(N) = REAL(N*(N+1))/A**2
   70 CONTINUE
C
      DO 80 NL=1,NLAT
         RLAT = GLAT(NL)
         WTACSJ(NL) = 1.0/(A*COS(RLAT)**2)
   80 CONTINUE
C
C     CALL ROUTINE TO FACTOR TRANSFORM LENGTH NLON AND CREATE TRIG TABLE
C
C     CALL FFTFAX (NLON,IFAX,TRIGS)
C     REPLACE BY NEW INITIALIZATION:
      CALL SET99(TRIGS,IFAX,NLON)
      IF (IFAX(1) .EQ. 99) THEN
         WRITE (0,100)
  100    FORMAT (/,' STSWM: FATAL ERROR IN ROUTINE INPUT:',/,
     $    ' FAILURE OF ECMFFT LIBRARY ROUTINE SET99 (FFT SETUP)',/,
     $    ' PARAMETER NLON IN FILE ''PARAMS.i'' MUST HAVE ONLY',
     $    ' PRIME FACTORS 2,3 OR 5 !')
         STOP
      ENDIF
C
C     DETERMINE LATITUDE AND LONGITUDE OF GAUSSIAN GRID,
C     RLOND AND RLATD IN DEGREES, FOR PLOTTING ROUTINES.
C     EXTRA POINT RLOND(NLON+1) IS REQUIRED FOR PLOTS
C     ***** N.B. MUCH OF THE FOLLOWING CODE IS NOT RELEVENT *****
C     *****      WITHOUT THE NCAR SYSTEM PLOT PACKAGE       *****
C
      DO 150 I=1,NLON
         RLOND(I) = GLON(I)*180.0/PI
  150 CONTINUE
      RLOND(NLON+1) = RLOND(NLON) + (RLOND(NLON)-RLOND(NLON-1))
     $                              - 100.*EPS
C
      DO 160 J=1,NLAT
         RLATD(J) = GLAT(J)*180./PI
  160 CONTINUE
C
C     SPECIAL VALUE FEATURE OF CONTOUR PLOT PACKAGE
C
      SPVAL  = 1.0E36
      SPV(1) = 1.0E36
      SPV(2) = 1.0E36
C
C     SCALING PARAMETER FOR VECTOR PLOTS IN CPMVXY
C
      VVSF   = 1.0E-3
C
C     INITIALIZE USER SELECTABLE CONTROL VARIABLES FOR PLOTTING ROUTINES
C     SEE COMMON BLOCK /COMPLT/ FOR DEFINITIONS
C
      LCONT  = .TRUE.
      LPSP   = .FALSE.
      LOP    = .TRUE.
      LCP    = .FALSE.
      LG     = .TRUE.
      LU     = .FALSE.
      LV     = .FALSE.
      LZ     = .FALSE.
      LD     = .FALSE.
      LVV    = .TRUE.
      LVVG   = .FALSE.
      LGPHS  = .TRUE.
C
C     CENTER LATITUDE, LONGITUDE AND ROTATION ANGLE FOR PLOTS
C     (DEFAULT VALUES IN DEGREES)
C
      POLAT = 0.0
      POLNG = 0.0
      POROT = 0.0
C
C     DEFAULT FILENAMES FOR INPUT/OUTPUT OF SPECTRAL COEFFICIENTS
C
      FNIN  = 'VDGDATA.cdf'
      FNOUT = 'REFDATA.cdf'
C
C     READ NAMELIST INFORMATION
C     (COMMON BUT NOT UNIVERSAL FORTRAN EXTENSION)
C
      WRITE(6,200)
  200 FORMAT(/,' READING NAMELIST PARAMETERS FROM STANDARD INPUT:',/)
C
      IGROUP = 1
      READ (5,PHYVAR,ERR=1000)
C
      IGROUP = 2
      READ (5,EXPDEF,ERR=1000)
C
      IGROUP = 3
      READ (5,PLTDEF,ERR=1000)
C
      IGROUP = 4
      READ (5,FNAMES,ERR=1000)
C
      GO TO 580
C
 1000 WRITE (0,1010) IGROUP
 1010 FORMAT(/, ' STSWM: FATAL ERROR IN SUBROUTINE INPUT ',/,
     $      ' ERROR READING NAMELIST GROUP NUMBER ', I1)
      STOP
C
  580 CONTINUE
C
C     CHECK MAP PROJECTION FLAGS (ONLY ONE TRUE)
C
      IF ((LOP .AND. LPSP) .OR. (LOP .AND. LCP)
     $    .OR. (LCP .AND. LPSP)) THEN
         WRITE(0,650)
  650    FORMAT(/,' STSWM: ILLEGAL SPECIFICATION OF MAP PROJECTION',
     $          /,' IN NAMELIST INPUT FILE: AT MOST ONE OF LPSP,',
     $          /,' LOP, LCP MAY BE .TRUE.')
         STOP
      ENDIF
C
C     COMPUTE CORIOLIS PARAMETER FOR ROTATED COORDINATES
C
C     f = 2.0*OMEGA*(-COS(LAMBDA)*COS(THETA)*SIN(ALPHA)+
C                    SIN(THETA)*COS(ALPHA))
C     TRANSFORM INTO SPECTRAL SPACE:
C
C     WAVE M=0, N=1
      CORSC1 = SQRT(8.0/3.0)*OMEGA*COS(ALPHA)
C     WAVE M=1, N=1
      CORSC2 = - SQRT(4.0/3.0)*OMEGA*SIN(ALPHA)
C
      RETURN
C
      END


*************************************************************************
* Programa de cálculo para la PWVD                                      *
*                                                                       *
* Con opción de aplicar un filtro digital pasa-altas                    *
* Basado en el código de Shin y Jeon (1993)                             *
*************************************************************************

*************************************************************************
* Se pide el nombre de entrada de una serie de tiempo con extensión .dat*
* que consta de dos columnas. En la primera es la historia de tiempos y *
* en la segunda es la historia de las amplitudes.                       *
*                                                                       *
* Variables del programa:                                               *
*                                                                       *
*  dp: número de datos muestreados,                                     *
*  mm: parámetro de salida de tiempo,                                   *
*  nn: parámetro de salida de frecuencia,                               *
*  mt: parámetro de la ventana Gaussiana en el tiempo,                  *
*  nf: parámetro de la ventana Gaussiana en la frecuencia,              *
*  inname: nombre de la serie de tiempo de entrada,                     *
*  mvopt: opción la cual decide si remueve o no el valor medio de la    *
*         señal,                                                        *
*  df: resolución en la frecuencia,                                     *
*  dt: intervalo de muestro.                                            *
*                                                                       *
* Arreglos de datos:                                                    *
*                                                                       *
*  tin(i): datos de tiempo muestreados,                                 *
*  ain(i): datos de la magnitud de la amplitud muestreada,              *
*  fain(i): datos filtrados,                                            *
*  wdf(i,j): arreglo reducido de la PWVD,                               *
*  bk(i): pesos del filtro,                                             *
*  s(i): señal analítica,                                               *
*  c(i): auto-correlación o datos resultantes de la FFT                 *
*************************************************************************

*************************************************************************
*                     Inicialización del programa                       *
*                                                                       *
      program PWVD
*                                                                       *
*************************************************************************
*************************************************************************
*                     Declaración de variables                          *
*                                                                       *
* -Para series de tiempo más grandes que 2048 muestras cambie np.       *
*                                                                       *
      integer dp,dp2,mvopt,redopt,mm,nn,nf,mt
      parameter (np = 4096)
      real pi,tin(np),ain(np),wdf(256,128),dt,fain(np),bk(1100)
      complex s(np*2),c(np*2)
      character*25 inname
      character as
      pi=atan(1.)*4.
*                                                                       *
*************************************************************************
*************************************************************************
*                      Impresiones de pantalla                          *
*                                                                       *
      print*,'***********************************************'
      print*,'*             Cálculo de la PWVD              *'
      print*,'***********************************************'
*                                                                       *
      print*
      print*,'***********************************************'
      print*,'Ingrese el nombre de la señal de entrada       '
      print*
      read(5,901) inname
      print*
      print*,'***********************************************'
      print*,'¿Cuál es el número total de muestras?          '
      print*
      read(5,902) dp
      print*
*                                                                       *
      dp2=dp*2
*                                                                       *
      do 100 i=1,dp2
 100     s(i)=cmplx(0.,0.)
*                                                                       *
      print*,'***********************************************'
      print*,'Desea remover el valor medio de la señal       '
      print*
      print*,'1 para sí, 0 para no                           '
      print*
      read(5,902) mvopt
      print*
*                                                                       *
      print*,'***********************************************'
      print*,'¿Desea aplicar el filtro digital? (Y/N)        '
      print*
      read(*,903) as
      print*
*                                                                       *
      if(as.eq.'Y'.or.as.eq.'y') then
         print*,'***********************************************'
         print*,'Ingrese la frecuencia de corte (Hz)            '
         print*
         read(*,*) bw
         print*
      endif
*                                                                       *
      fmin = 0.
*                                                                       *
      print*,'***********************************************'
      print*,'Ingrese el tamaño de salida de la PWVD en      '
      print*,'Tiempo vs. Frecuencia                          '
      print*,'_______________________________________________'
      print*,'Ingrese 1 para 64 por 32                       '
      print*,'Ingrese 2 para 128 por 64                      '
      print*,'Ingrese 3 para 128 por 128                     '
      print*,'Ingrese 4 para 256 por 128                     '
      print*
      read(5,902) redopt
      print*
      if(redopt.eq.1) then
         mm = dp/32
         nn = dp2/64
      elseif(redopt.eq.2) then
         mm = dp/64
         nn = dp2/128
      elseif(redopt.eq.3) then
         mm = dp/128
         nn = dp2/128
      else
         mm = dp/128
         nn = dp2/256
      endif
*                                                                       *
      print*,'***********************************************'
      print*,'Ingrese los parámetros de la ventana Gaussiana '
      print*
      print*,'Parámetro de frecuencia:                       '
      print*
      read(5,902) nf
      print*
      print*,'Parámetro de tiempo:                           '
      print*
      read(5,902) mt
      print*
*                                                                       *
*************************************************************************
*************************************************************************
*                      Cálculos                                         *
*                                                                       *
* Leé los datos de la señal de entrada:
*
      open(4, file = inname, status = 'old')
      call indata(dp, tin, ain)
      print*,'***********************************************'
      print*,'* Lectura de datos completada                  '
      print*
      close(4)
*                                                                       *
* Calcula el incremento del tiempo de muestreo:                         *
*                                                                       *
      call dtcalc(dp, tin, dt)
      print*,'* Cálculo de la delta de tiempo finalizado     '
      print*
*                                                                       *
* Calcula el valor medio de la señal:                                   *
*                                                                       *
      if(mvopt.eq.1) then
         call mean(dp, ain)
         print*,'* Cálculo del valor medio terminado         '
         print*
      endif
*                                                                       *
* -Modificaciones a la señal-                                           *
*                                                                       *
* Aplicación del filtro digital:                                        *
*                                                                       *
      if(as.eq.'Y'.or.as.eq.'y') then
         mo = dp/2
*                                                                       *
         call filter(mo, bw, dt, bk)
*                                                                       *
         do 160 i = 1,dp
 160        fain(i) = 0.
*                                                                       *
         do 200 i = 1,dp
            do 170 k = -mo,mo
               j=k
               if(k.lt.0) then
                  j=k*(-1)
               endif
               j = j+1
               ll = i-k
               if(ll.lt.1) then
                  ll = ll+dp
               elseif(ll.gt.dp) then
                  ll = ll-dp
               endif
               bb = -bk(j)
               if(k.eq.0) then
                  bb = 1-bk(j)
               endif
               fain(i) = fain(i)+bb*ain(ll)
 170        continue
 200     continue
*                                                                       *
         do 210 i = 1,dp
 210        ain(i) = fain(i)
*                                                                       *
        print*,'* Aplicación del filtro digital terminado   '
        print*
        endif
*                                                                       *
*                                                                       *
* Aplicación de la ventana de Hamming                                   *
*                                                                       *
      call hammg(dp, dt, pi, ain)
      print*,'* Aplicación de la ventana de Hamming terminada'
      print*
*                                                                       *
* Conversión a una señal analítca                                       *
*                                                                       *
      call anal(dp, pi, ain, s)
      print*,'* Terminada la conversión a señal analítica    '
      print*
*
* Escribe los archivos de salida de las distribuciones                  *
*                                                                       *
      open(9, file = 'rwdf.out', status = 'new')
      open(10, file  = 'rswdf.out', status = 'new')
*
* Calcúla los parámetros de salida                                      *
*                                                                       *
      ttime = dp*dt
      df = 1./(4.*dp*dt)
      fmax = 2.*dp*df
      nx = dp2/nn
      ny = dp/mm
      write(9,904) tin(1), ttime, fmin, fmax
      write(9,*) nx, ny
*                                                                       *
* Cálculo de la PWVD                                                    *
*                                                                       *
      print*,'***********************************************'
      print*,'*              Calculando PWVD...             *'
      print*,'***********************************************'
      print*
      call wigner(dp, dt, pi, s, c, mm, nn, wdf, mt, nf)
*                                                                       *
      print*,'***********************************************'
      print*,'*              Cálculo finalizado             *'
      print*,'***********************************************'
      print*
      close(9)
*                                                                       *
* Escribe los resutados                                                 *
*                                                                       *
      write(10,904) tin(1), ttime, fmin, fmax
      write(10,*) nx, ny
      do 500 i = 1,dp/mm
         do 500 j = 1,dp2/nn
            write(10,905) wdf(j,i)
 500     continue
*                                                                       *
901   format(a25)
902   format(i6)
903   format(a1)
904   format(e12.5,/,e12.5,/,e12.5,/,e12.5)
905   format(2x,e12.5)
*                                                                       *
      close(10)
      print*,'***********************************************'
      print*,'*      ¡Éxito! Ejecución de PVWD terminada    *'
      print*,'***********************************************'
      print*
*                                                                       *
      stop
      end
*                                                                       *
*************************************************************************
*                   Subrutinas de ejecución                             *
*************************************************************************
*                                                                       *
* Subrutina de ingreso de datos                                         *
*                                                                       *
      subroutine indata(dp, tin, ain)
*                                                                       *
      integer dp
      real tin(*), ain(*)
*                                                                       *
      do 100 j = 1,dp
         read(4,*) tin(j), ain(j)
 100  continue
      return
      end
*                                                                       *
* Subrutina de cálculo del incremento de tiempo
*                                                                       *
      subroutine dtcalc(dp, tin, dt)
*                                                                       *
      integer dp
      real tin(*), dt
*                                                                       *
      dtsum = 0.0
*                                                                       *
      do 100 i = 1,dp-1
         delt = tin(i+1) - tin(i)
         dtsum = dtsum + delt
 100  continue
*                                                                       *
      dt = dtsum/float(dp-1)
*                                                                       *
      return
      end
*                                                                       *
* Subrutina de cálculo de la media de los datos                         *
*                                                                       *
      subroutine mean(dp, ain)
*                                                                       *
      integer dp
      real ain(*), meanv
*                                                                       *
      asum = 0.0
*                                                                       *
      do 100 i = 1,dp
         asum = asum + ain(i)
 100  continue
*                                                                       *
      meanv = asum/dp
*                                                                       *
      do 200 i = 1,dp
         ain(i) = ain(i) - meanv
 200  continue
*                                                                       *
      return
      end
*                                                                       *
* Subrutina de cálculo de elementos del filtro digital                  *
*                                                                       *
      subroutine filter(mo, b, t, bk)
*                                                                       *
      dimension bk(*),d(3)
      data d0/0.35577019/,d(1)/0.2436983/,d(2)/0.07211497/,
     *d(3)/0.00630165/
*                                                                       *
      pi = atan(1.)*4
      m = mo
      fact = 2.*b*t
      bk(1) = fact
      fact = fact*pi
*                                                                       *
      do 5 i = 1,m
         fi = i
 5       bk(i+1) = sin(fact*fi)/(pi*fi)
*                                                                       *
      bk(m+1) = bk(m+1)/2.
      sumg = bk(1)
*                                                                       *
      do 15 i = 1,m
         sum = d0
         fact = pi*float(i)/float(m)
         do 10 k = 1,3
 10         sum = sum + 2.*d(k)*cos(fact*float(k))
         bk(i+1) = bk(i+1)*sum
 15      sumg = sumg + 2.*bk(i+1)
*                                                                       *
         m1 = m+1
*                                                                       *
         do 20 i = 1,m1
 20         bk(i) = bk(i)/sumg
*                                                                       *
         return
         end
*                                                                       *
* Subrutina del cálculo de la ventana de Hamming                        *
*                                                                       *
      subroutine hammg(dp, dt, pi, ain)
*                                                                       *
      integer dp
      real pi, ain(*), dt, mtime, del1, del2, const
*                                                                       *
      mtime = (dp-1)*dt
      del1 = 0.1*mtime
      del2 = 0.9*mtime
      const = pi/del1
*                                                                       *
      do 100 j = 1,dp
         t = (j-1)*dt
         if(t.le.del1) then
            ain(j) = ain(j)*(.54-.46*cos(const*t))
         elseif((t.ge.del2).and.(t.le.mtime)) then
            ain(j) = ain(j)*(.54-.46*cos(const*(mtime-t)))
         endif
 100  continue
*                                                                       *
      return
      end
*                                                                       *
* Subrutina de conversión a señal analítica
*                                                                       *
      subroutine anal(dp, pi, ain, s)
*                                                                       *
      integer dp
      real pi, ain(*), sum, sumb, val, sval
      complex s(*)
*                                                                       *
      do 100 i = 1,dp
         sum = 0.0
         do 200 j = 1,dp
            sumb = 0.0
            if(i-j.eq.0) go to 200
            n = i-j
            val = pi*n/2.
            sval = sin(val)
            sumb = ain(j)*sval*sval/val
 200     sum = sum+sumb
      s(i) = cmplx(ain(i), sum)
 100  continue
*                                                                        *
      return
      end
*                                                                        *
* Subrutina de cálculo de la distribución de Wigner
*                                                                        *
      subroutine wigner(dp, dt, pi, s, c, mm, nn, wdf, mt, nf)
*                                                                        *
      integer dp, dp2
      real pi, dt, coef, wdf(256,128), hg(-100:100,-100:100)
      complex s(*), dum, c(*)
*                                                                        *
      dp2 = dp*2
      coef = 2.0*dt
      df = 1./(4.*dp*dt)
      nf2 = nf*2
      mt2 = mt*2
      f1 = float(mt)
      f2 = float(nf)
*
*  Cálculo anidado de la función de ventana Gaussiana                     *
*
      val = 1./((2.*pi)**2*f1*f2*df*dt)
*                                                                         *
      do 20 j = -mt2,mt2
         q1 = float(j)
         do 10 i = -nf2,nf2
            q2 = float(i)
            cf = -((q1*q1)/(2.*f1*f1))-((q2*q2)/(2.*f2*f2))
            hg(i,j) = val*exp(cf)
 10      continue
 20   continue
*                                                                         *
      do 100 i = 1,256
         do 100 j = 1,128
 100        wdf(i,j) = 0.
*                                                                         *
      do 5000 j = 1,dp
         do 1000 i = 1,dp+1
            if(j.ge.i) then
               dum = s(j-i+1)
            else
               dum = cmplx(0.,0.)
            endif
            c(i) = coef*(s(j+i-1)*conjg(dum))
            if(i.ne.1.and.i.ne.dp+1) then
               c(dp2-i+2) = conjg(c(i))
            endif
            open(11, file = 'corr.out', status = 'new')
         write(11,1400) real(c(i))
 1000    continue
*                                                                          *
      call fft(dp, pi, c)
      ik = mod((j-1), mm)
      if(ik.eq.0) then
         do 1500 i = 1,dp2,nn
            write(9,1400) real(c(i))
 1400       format(2x,e12.5)
 1500    continue
      endif
*                                                                           *
      m1 = 0
*                                                                           *
      do 4000 m = 1,dp,mm
         m1 = m1+1
         n1 = 0
         if(abs(j-m).le.mt2) then
            do 3000 n = 1,dp2,nn
               n1 = n1+1
               do 2500 kk = n-nf2,n+nf2
                  k1 = kk
                  if(kk.lt.1) k1 = kk+dp2
                  if(kk.gt.dp2) k1 = kk-dp2
                  wdf(n1,m1) = wdf(n1,m1)+real(c(k1))*hg(kk-n,j-m)*df*dt
 2500          continue
 3000       continue
          endif
 4000  continue
 5000  continue
       return
       end
*                                                                            *
* Subrutina de cálculo de la transformada rápida de Fourier                  *
*                                                                            *
      subroutine fft(dp, pi, c)
*                                                                            *
      integer dp, dp2, val, coef, coef1
      real pi
      complex dum, c(*), dum3, dum2
*                                                                            *
      dp2 = dp*2
      const = float(dp2)
      val = alog(const)/alog(2.)+.1
      j=1
*                                                                            *
      do 40 i = 1,dp2-1
         if(i.ge.j) go to 10
         dum3 = c(j)
         c(j) = c(i)
         c(i) = dum3
 10   k = dp
 20   if(k.ge.j) go to 30
      j = j-k
      k=k/2
      go to 20
 30   j = j+k
 40   continue
      do 70 n = 1,val
         coef = 2**n
         coef1 = coef/2
         dum2 = cmplx(1.,0.)
         theta = pi/float(coef1)
         dum = cmplx(cos(theta), -sin(theta))
         do 60 j = 1,coef1
            do 50 i = j,dp2,coef
               ii = i+coef1
               dum3 = c(ii)*dum2
               c(ii) = c(i)-dum3
               c(i) = c(i)+dum3
 50         continue
            dum2 = dum2*dum
 60      continue
 70   continue
      return
      end
*                                                                           *
*****************************************************************************


! mpiexec -np 4 bin/Debug/WGFM_test2.exe
program mainWGF
    use meshread_mod
    use linalg_mod
    use WMFIE_matrices
    use spherePEC_mod
    use mpi
    implicit none

    real(8), parameter :: pi = 4d0 * atan(1d0)
    complex(8), parameter :: IU = (0d0, 1d0)

    ! Variables
    type(Mesh) :: msh, msh_evl

    complex(8), allocatable :: Zmat(:, :)      ! WMFIE matrix
    complex(8), allocatable :: Dpot(:, :, :)   ! WMFIE potencial

    complex(8), allocatable :: Esrc(:, :)
    complex(8), allocatable :: Msrc(:)
    complex(8), allocatable :: Ivec(:)

    complex(8), allocatable :: Eexact(:, :)       ! Exact electric field solution
    complex(8), allocatable :: Esol(:, :)         ! WMFIE electric field solution

    real(8) :: ExNorm, Error1
    integer :: nEvl

    ! MPI variables
    integer :: ierr, N_procs, id

    ! Parameters
    real(8), parameter :: ep0 = 1d0 / (35950207149.4727056d0 * PI)  ! vacuum permittivity [F/m]
    real(8), parameter :: mu0 = PI * 4d-7                           ! vacuum permeability [H/m]
    real(8), parameter :: k0 = 2*PI          ! free-space wavenumber [1/m]

    real(8), parameter :: ep1_r = 1d0          ! upper half-space relative permittivity
    real(8), parameter :: ep1 = ep0*ep1_r     ! upper half-space permittivity [F/m]
    real(8), parameter :: mu1 = mu0           ! upper half-space permeability [H/m]

    real(8), parameter :: w = k0 / sqrt(ep0 * mu0)   ! angular frequency [rad/s]
    real(8), parameter :: k1 = w * sqrt(ep1 * mu1)  ! upper half-space wavenumber [1/m]

    character(len=100), parameter :: file_msh = 'meshes/hemisphere_plane/hemisphere_plane_A4_h015.msh'
    character(len=100), parameter :: file_evl_msh = 'meshes/eval_msh/dome.msh'
    real(8), parameter :: sph_radius = 1d0      ! hemisphere radius
    real(8), parameter :: win_radius = 4d0    ! Window radius
    real(8), parameter :: win_cparam = 0.7d0    ! Window 'c' parameter

    ! Planewave parameters
    integer, parameter :: n_terms = 100     ! number of terms in Mie series
    real(8), parameter :: alpha = PI/30d0      ! planewave angle of incidence in (0, pi)
    logical, parameter :: TE_mode = .true.  ! planewave mode: TEmode = .true.
                                            !                 TMmode = .false.

    !************************************************************************************
    ! MPI init
    call mpi_init(ierr)
    call mpi_comm_size(MPI_COMM_WORLD, N_procs, ierr)
    call mpi_comm_rank(MPI_COMM_WORLD, id, ierr)
    print *, "Total processes:", N_procs, "Process id:", id

    ! Set window type and size
    call set_circ_window(win_radius, win_cparam)

    ! Load mesh
    call load_gmsh(file_msh, msh)

    ! Load eval mesh
    call load_gmsh(file_evl_msh, msh_evl)
    nEvl = size(msh_evl%POS, 1)

    ! Compute WMFIE matrix
    if (id == 0) print *, "WMFIE matrix, ", 'nEdges: ', msh%nbEdg
    call genWMFIE(Zmat, msh, k1)
    if (id == 0) print *, "done"

    if (id == 0) then
        ! Compute source field
        call halfsphere_on_plane_source_field(alpha, k1, msh, Esrc, TE_mode)

        ! WMFIE RHS
        call genRHS_WMFIE(msh, Esrc, Msrc)

        ! Solve
        allocate(Ivec(msh%nbEdg))
        print *, "solving"
        call diagPrecond(Zmat, Msrc)
        call gmres_solver(Ivec, Zmat, Msrc)
        deallocate(Msrc, Zmat)
        print *, "done"
    end if

    ! Compute WMFIE potencial
    if (id == 0) print *, "Potencial"
    call genWMFIEPot(Dpot, nEvl, msh_evl%POS, msh, k1)
    if (id == 0) print *, "done"

    ! Compute exact solution
    if (id == 0) then
        print *, "Exact solution"
        call halfsphere_on_plane_scattered_field(msh_evl%POS, k1, sph_radius,  &
                                             alpha, n_terms, Eexact, TE_mode)
        ExNorm = maxval(sqrt(abs(Eexact(:,1))**2+abs(Eexact(:,2))**2+abs(Eexact(:,3))**2))
        print *, "done"
    endif

    ! Compute WMFIE solution
    if (id == 0) then
        allocate(Esol(nEvl, 3))
        Esol(:,1) = matmul(Dpot(:,:,1), Ivec)
        Esol(:,2) = matmul(Dpot(:,:,2), Ivec)
        Esol(:,3) = matmul(Dpot(:,:,3), Ivec)

        ! Error
        Esol = Esol - Eexact
        Error1 = maxval(sqrt(abs(Esol(:,1))**2+abs(Esol(:,2))**2+abs(Esol(:,3))**2))

        print *, 'nEdges ', 'h ',' Error WMFIE: '
        print *, msh%nbEdg, msh%h, Error1 / ExNorm

        ! Save errors to evl mesh
        call saveToMesh(ESol/ExNorm, file_evl_msh, "error", 'nodes', 'norm')
    end if

    call MPI_Finalize(ierr)
end program