stwc1.f

Go to the documentation of this file.

!                   ********************************
                    DOUBLE PRECISION FUNCTION stwc1
!                   ********************************
!
     &(f,dir,spec,i)
!
!***********************************************************************
! ARTEMIS   V8P1
!***********************************************************************
!
!brief    COMPUTES THE ENERGY DENSITY BASED ON A TOMAWAC SPECTRUM.
!
!history  C. PEYRARD (LNHE)
!+        07/2014
!+        V7P0
!+   Interpolation of TOMAWAC spectrum for required F and DIR
!
!history  N. DURAND (HRW)
!+        Feb 2017
!+        V7P2
!+   bug fix last line (STWC= )
!
!history  N.DURAND (HRW)
!+        August 2017
!+        V7P3
!+   STWC updated to reflect use of new spectrum structure and for
!+   CHAINTWC.EQ.1
!
!history  N.DURAND (HRW)
!+        January 2019
!+        V8P0
!+   Added USE BIEF_DEF since TYPE SPECTRUM is now defined in BIEF_DEF
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| F              |-->| FREQUENCY FOR WHICH ENERGY DENSITY IS CALCULATED (Hz)
!| DIR            |-->| DIRECTION FOR WHICH ENERGY DENSITY IS CALCULATED (°)
!| SPEC           |-->| SPECTRUM STRUCTURE
!| I              |-->| NUMBER OF THE SPECTRAL POINT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief_def, ONLY: spectrum
      USE declarations_artemis
      USE declarations_special
      IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
      TYPE(spectrum)   , INTENT(IN) :: SPEC
      DOUBLE PRECISION              :: F,DIR
      INTEGER                       :: I
!
      DOUBLE PRECISION              :: F1,F2,D1,D2,EPS,TET
      DOUBLE PRECISION              :: SPF1D1,SPF2D1,SPF1D2,SPF2D2
      DOUBLE PRECISION              :: SPF1D,SPF2D
!
      INTEGER                       :: IFF,INDF,IFF1,IDD,INDD,IDD1
!
      INTRINSIC                     :: exp
!
!-----------------------------------------------------------------------
!     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) AS FOLLOWS
!
!     known at frequencies (f1<f2) and directions (d1<d2)
!     INTERPOLATION :
!     Sp(f,d) =  Sp(f1,d) + (f-f1)*(Sp(f2,d)-Sp(f1,d))/(f2-f1)
!     with
!     Sp(f1,d)=  Sp(f1,d1) + (d-d1)*(Sp(f1,d2)-Sp(f1,d1))/(d2-d1)
!     Sp(f2,d)=  Sp(f2,d1) + (d-d1)*(Sp(f2,d2)-Sp(f2,d1))/(d2-d1)
!
!-----------------------------------------------------------------------
!
!     FINDS CLOSEST F1 AND F2
!
      eps=1e-5
      indf=0
      f1=0.d0
      f2=0.d0
      DO iff=1,nf-1
        IF((spec%FRE(iff)-eps.LE.f).AND.(spec%FRE(iff+1)+eps.GE.f))THEN
          f1=spec%FRE(iff)
          f2=spec%FRE(iff+1)
          iff1=iff
          indf=1
        ENDIF
      ENDDO
!
!     FINDS CLOSEST D1 AND D2
!
!     LOCAL VARIABLE TET TO HAVE THE DIRECTION THAT MAY BE CHANGED
      tet = dir
      IF (tet+eps.LE.spec%DIR(1)) tet=tet+360.d0
      indd=0
      d1=0.d0
      d2=0.d0
      DO idd=1,ndir
        IF ((spec%DIR(idd).LE.tet).AND.(spec%DIR(idd+1).GE.tet)) THEN
          d1=spec%DIR(idd)
          d2=spec%DIR(idd+1)
          idd1=idd
          indd=1
        ENDIF
      ENDDO
!
! ----------------------------------------------------------------------
!
!     COMPUTES ENERGY DENSITY AT REQUIRED F AND DIR
!
      IF ((indd*indf).EQ.0) THEN
        stwc1 = 0.d0
        WRITE(lu,*) '--------------------WARNING----------------------'
        WRITE(lu,*) 'SUBROUTINE STWC1: YOU ASK FOR A PERIOD/DIRECTION '
        WRITE(lu,*) 'OUTSIDE THE RANGE OF THE TOMAWAC SPECTRUM        '
        IF(indf.EQ.0) THEN
          WRITE(lu,*) 'F = ',f
          WRITE(lu,*) 'FMIN, FMAX =' ,spec%FRE(1),spec%FRE(nf)
        ENDIF
        IF(indd.EQ.0) WRITE(lu,*) 'DIR = ',tet
!
        CALL plante(1)
        stop
!
      ELSE
!
!     Sp(f1,d1), Sp(f2,d1), Sp(f1,d2), Sp(f2,d2)
!
        spf1d1=spec%ADR(i)%SOUTER(iff1  ,idd1  )
        spf2d1=spec%ADR(i)%SOUTER(iff1+1,idd1  )
        spf1d2=spec%ADR(i)%SOUTER(iff1  ,idd1+1)
        spf2d2=spec%ADR(i)%SOUTER(iff1+1,idd1+1)
!
!     Sp(f1,d), Sp(f2,d)
!
        spf1d= spf1d1 + (tet-d1)*(spf1d2-spf1d1)/(d2-d1)
        spf2d= spf2d1 + (tet-d1)*(spf2d2-spf2d1)/(d2-d1)
!
!     Sp(f,d) =  Sp(f1,d) + (f-f1)*(Sp(f2,d)-Sp(f1,d))/(f2-f1)
!
        stwc1 = spf1d  + (f-f1)*(spf2d-spf1d)/(f2-f1)
!
      ENDIF
!-----------------------------------------------------------------------
!
      RETURN
      END