stwc2.f

Go to the documentation of this file.

!                   ****************
                    SUBROUTINE stwc2
!                   ****************
!
     &(imin,imax,n,dir2,sdir)
!
!***********************************************************************
! ARTEMIS   V7P4                                     Nov 2017
!***********************************************************************
!
!brief    COMPUTES THE ENERGY DENSITY BASED ON A TOMAWAC SPECTRUM.
!
!history  N.DURAND (HRW)
!+        November 2017
!+        V7P4
!+   New. Wrapper around calls to STIRLING and LISSAGE, when linear
!+   interpolation (STWC1) is not sufficient
!
!history  N.DURAND (HRW)
!+        January 2019
!+        V8P0
!+   Added USE BIEF_DEF since TYPE SPECTRUM is now defined in BIEF_DEF
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IMIN           |-->| DIRECTION INDEX FOR TETMIN
!| IMAX           |-->| DIRECTION INDEX FOR TETMAX
!| N              |-->| NUMBER OF FINER RESOLUTION POINTS
!| DIR2           |<--| ARTEMIS DIR COMPONENTS
!| SDIR           |<->| ARTEMIS SPECTRUM, INTEGRATED FOR EACH DIR COMPONENT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief_def, ONLY: spectrum
      USE declarations_artemis
      USE declarations_special
      IMPLICIT NONE
!
!=======================================================================
!
      INTEGER                       :: IDD,IMIN,IMAX,N
      DOUBLE PRECISION              :: SDIR(n),DIR2(n)
      DOUBLE PRECISION,ALLOCATABLE  :: SDIR2(:)
      DOUBLE PRECISION              :: DTETA2
!
      INTEGER                       :: LISS
      INTEGER                       :: IERR
!
!-----------------------------------------------------------------------
!
      ALLOCATE(sdir2(n),stat=ierr)
      CALL check_allocate(ierr,'STWC2:SDIR2')
!
!=======================================================================
!     TOMAWAC SPECTRUM IS GIVEN AT DISCRETE FREQUENCIES AND DIRECTIONS
!     THAT ARE COARSER THAN REQUIRED TO GIVE A SMOOTH ESTIMATE OF ENERGY
!     IN SPECTRUM
!     => REQUIRES INTERPOLATION (WITHIN RANGE) WITH STIRLING,
!        FOLLOWED BY SMOOTHING WITH LISSAGE
!-----------------------------------------------------------------------
!
      DO idd = 1,n
        dir2(idd)  = 0.d0
        sdir2(idd) = 0.d0
      ENDDO
!
      IF(imax.LT.imin) THEN
        DO idd = imin,ndir
          dir2(idd-imin+1)  = s_tom%DIR(idd)-360.0d0
          sdir2(idd-imin+1) = sdir(idd)
        ENDDO
        DO idd = 1,imax
          dir2(ndir-imin+1+idd)  = s_tom%DIR(idd)
          sdir2(ndir-imin+1+idd) = sdir(idd)
        ENDDO
        CALL stirling( ndir-imin+1+imax, dir2, sdir2,
     &                n, dteta2, sdir )
!
      ELSE
        DO idd = imin,imax
          dir2(idd-imin+1)  = s_tom%DIR(idd)
          sdir2(idd-imin+1) = sdir(idd)
        ENDDO
        CALL stirling( imax-imin+1, dir2, sdir2,
     &                n, dteta2, sdir )
      ENDIF
!
      DO idd = 1,n
        dir2(idd) = dir2(1)+float(idd-1)*dteta2
      ENDDO
!
      DO liss = 1,250
        CALL lissage( n, sdir, sdir2)
        CALL ov('X=Y     ', sdir, sdir2, sdir2, 0.d0, n)
      ENDDO
!     DO IDD = 1,N
!       WRITE(LU,*) DIR2(IDD),SDIR(IDD)
!     ENDDO
!
!-----------------------------------------------------------------------
!
      DEALLOCATE(sdir2)
!
!=======================================================================
!
      RETURN
      END