get_tomspec_value1.f

Go to the documentation of this file.

!                   *****************************
                    SUBROUTINE get_tomspec_value1
!                   *****************************
!
     &(spec)
!
!***********************************************************************
! ARTEMIS   V7P3                                     Aug 2017
!***********************************************************************
!
!brief    READS IN THE TOMAWAC ENERGY SPECTRA.
!
!history  N.DURAND (HRW)
!+        09/03/2001
!+
!+   Original version
!
!history  T.ELLAM (HRW)
!+        13/03/2002
!+
!+   Modified to read in serafin format.spe
!
!history  N.DURAND (HRW)
!+        June 2014
!+
!+   Streamlined for V7P0
!
!history  N.DURAND (HRW)
!+        Feb 2017
!+        V7P2
!+   Revisited to use the hermes module
!+   Covers nesting option 1 only (original reading routines superseded)
!
!history  N.DURAND (HRW)
!+        August 2017
!+        V7P3
!+   DEGRAD now defined in DECLARATIONS_ARTEMIS
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| SPEC           |<->| SPECTRUM STRUCTURE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_artemis
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(spectrum)   , INTENT(INOUT)        :: SPEC
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER                      :: IERR, I, IFF, IDD
      INTEGER                      :: NFIC, TYP
      INTEGER                      :: IDEC
      INTEGER                      :: RECORD
!
      DOUBLE PRECISION             :: EPS
      DOUBLE PRECISION,ALLOCATABLE :: X1(:),Y1(:),STOCK(:)
!
      CHARACTER(LEN=8)             :: FFORMAT
      CHARACTER(LEN=16),ALLOCATABLE :: VARNAME(:),VARUNIT(:)
!
      INTRINSIC dsqrt, datan, datan2
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      ALLOCATE(varname(spec%N),stat=ierr)
      CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:VARNAME')
      ALLOCATE(varunit(spec%N),stat=ierr)
      CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:VARUNIT')
!
      ALLOCATE(x1(nf*ndir),stat=ierr)
      CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:X1')
      ALLOCATE(y1(nf*ndir),stat=ierr)
      CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:Y1')
      ALLOCATE(stock(ndir),stat=ierr)
      CALL check_allocate(ierr,'GET_TOMSPEC_VALUE1:STOCK')
!
!=======================================================================
!
      nfic = art_files(wacspe)%LU
      fformat = art_files(wacspe)%FMT
!     THE SUPPORT MESH FOR TOMAWAC SPECTRA IS MADE OF QUADRANGLES
      typ = quadrangle_elt_type
!
!-----------------------------------------------------------------------
!
!     ONLY ONE TOMAWAC SPECTRUM IS ALLOWED WHEN NESTING OPTION 1
!
!     IF MORE THAN ONE FOUND IN SPECTRUM FILE, WARNS THE USER THAT
!     THE FIRST IN FILE IS CONSIDERED
!
      IF(spec%N.GT.1) THEN
        WRITE(lu,*) 'WARNING: TOO MANY VARIABLES IN ',
     &         art_files(wacspe)%NAME,
     &         'ONLY THE FIRST VARIABLE IN THE FILE WILL BE READ'
      ENDIF
!
!-----------------------------------------------------------------------
!
!     NODE NUMBER FOR EACH SPECTRUM/POINT IN SPEC
!
      CALL get_data_var_list(fformat,nfic,spec%N,varname,varunit,ierr)
      CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_DATA_VAR_LIST')
!     THE 1ST SPECTRUM/POINT IN SPEC EVEN IF THERE ARE MORE THAN 1
      READ (varname(1)(9:16),'(I8)') spec%NOUTER(1)
!
!-----------------------------------------------------------------------
!
!     "X AND Y COORDINATES" OF THE SPECTRA IN SPEC
!
      CALL get_mesh_coord(fformat,nfic,1,2,nf*ndir,x1,ierr)
      CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_MESH_COORD:X')
      CALL get_mesh_coord(fformat,nfic,2,2,nf*ndir,y1,ierr)
      CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_MESH_COORD:Y')
!
!     COMPUTES THE DISCRETE FREQUENCIES FROM "X AND Y"
!
      DO i = 1,nf
        spec%FRE(i) = dsqrt(x1((i-1)*ndir+1)**2+y1((i-1)*ndir+1)**2)
!       IF(DEBUG.GT.0) WRITE(*,*) SPEC%FRE(I)
      ENDDO
!
!     COMPUTES THE DISCRETE DIRECTIONS FROM "X AND Y"
!     CONVENTION: FROM X, COUNTER-CLOCKWISE, TOWARDS
!     THE CALCULATION MEANS THAT DIRECTIONS ARE NO LONGER IN TOMAWAC CONVENTION
!     BUT RATHER DIRECTLY IN ARTEMIS CONVENTION
!
      DO i = 1,ndir
        spec%DIR(i) = datan2(y1(i),x1(i))
        spec%DIR(i) = spec%DIR(i)/degrad
!       IN RANGE [0;360]
        IF (spec%DIR(i).LT.0d0) THEN
          spec%DIR(i) = 360.d0 + spec%DIR(i)
        ENDIF
!       IF(DEBUG.GT.0) WRITE(*,*) SPEC%DIR(I)
      ENDDO
!
!     RE-ORDERS DIRECTIONS FROM 0 to 360 WHEN NESTING OPTION 1
!     STARTS BY FINDING THE SMALLEST DIRECTION IN [0;360] => IDEC
      idec=0
      eps=360.d0
      DO i = 1,ndir
!       STOCKS THE DIRECTION
        stock(i)=spec%DIR(i)
        IF (spec%DIR(i).LT.eps) THEN
          idec=i
          eps=spec%DIR(i)
        ENDIF
      ENDDO
!
!     ORDERS SPEC%DIR FROM 0 to 360
      DO i = 1,ndir
        IF (i.GT.idec) THEN
          idd=ndir+idec-i+1
        ELSE
          idd=idec-i+1
        ENDIF
        spec%DIR(idd)=stock(i)
      ENDDO
      spec%DIR(ndir+1)=spec%DIR(1)+360.d0
!
!-----------------------------------------------------------------------
!
!     ENERGY DENSITIES FOR 1ST SPECTRUM/POINT IN SPEC ( HENCE ADR(1) ),
!     AND FOR RECORD TPSTWC
!
      CALL get_data_timestep(fformat,nfic,record,tpstwc,ierr)
      CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_DATA_TIMESTEP')
!
      CALL get_data_value(fformat,nfic,record,varname(1),x1,
     &                    nf*ndir,ierr)
      CALL check_call(ierr,'GET_TOMSPEC_VALUE1:GET_DATA_VALUE')
!
      DO iff=1,nf
        DO idd=1,ndir
          spec%ADR(1)%SOUTER(iff,idd) = x1((iff-1)*ndir+idd)
        ENDDO
!       CLOSING THE LOOP
        spec%ADR(1)%SOUTER(iff,ndir+1) = spec%ADR(1)%SOUTER(iff,1)
      ENDDO
!
!-----------------------------------------------------------------------
!
!     RE-ORDERS ENERGY DENSITIES WHEN NESTING OPTION 1
!     IN LINE WITH RE_ORDERING OF DIRECTIONS ABOVE
!
      DO iff = 1,nf
        DO i = 1,ndir
          stock(i)=spec%ADR(1)%SOUTER(iff,i)
        ENDDO
        DO i = 1,ndir
          IF (i.GT.idec) THEN
            idd=ndir+idec-i+1
          ELSE
            idd=idec-i+1
          ENDIF
          spec%ADR(1)%SOUTER(iff,idd)=stock(i)
        ENDDO
        spec%ADR(1)%SOUTER(iff,ndir+1)=spec%ADR(1)%SOUTER(iff,1)
      ENDDO
!
!=======================================================================
!
      DEALLOCATE(x1,y1,stock)
      DEALLOCATE(varname,varunit)
!
!-----------------------------------------------------------------------
!
!     PRINTOUT FORMATS:
!
      WRITE(lu,301) tpstwc
!
301   FORMAT(/,1x,'GET_TOMSPEC_VALUE1 : READING TIME STEP ',1f9.2,'S')
!
!-----------------------------------------------------------------------
!
!     USER DEFINED FUNCTION TOTNRJ FOR CHECKS ONLY
!
!     IF(DEBUG.GT.0) CALL TOTNRJ(SPEC,1)
!
!-----------------------------------------------------------------------
!
      RETURN
      END