xy_tomawac.f

Go to the documentation of this file.

!                       *********************
                        SUBROUTINE xy_tomawac
!                       *********************
!
     &( spec )
!
!***********************************************************************
! ARTEMIS   V7P2                                     Feb 2017
!***********************************************************************
!
!brief    READS IN THE COORDINATES OF THE OUTER MODEL GRID NODES.
!
!history  N.DURAND (HRW)
!+        March 2001
!+        
!+   Original version (applied to COWADIS)
!
!history  N.DURAND (HRW)
!+        Feb 2017
!+        V7P2
!+   Revisited to use the hermes module
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| SPEC           |<->| SPECTRUM STRUCTURE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_artemis
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(spectrum) , INTENT(INOUT) :: SPEC
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER                      :: IERR, I
      INTEGER                      :: NFIC1, TYP1, NPOIN1
!
      DOUBLE PRECISION,ALLOCATABLE :: X1(:),Y1(:)
!
      CHARACTER(LEN=8)             :: FFORMAT1
!
!-----------------------------------------------------------------------
!
!     FOR THE OUTER TOMAWAC MODEL
      nfic1 = art_files(wacres)%LU
      fformat1 = art_files(wacres)%FMT
      typ1 = triangle_elt_type
!
!-----------------------------------------------------------------------
!
!     NUMBER OF NODES IN THE TOMAWAC OUTER MESH
!
      CALL get_mesh_npoin(fformat1,nfic1,typ1,npoin1,ierr)
      CALL check_call(ierr,'XY_TOMAWAC:GET_MESH_NPOIN')
!     IF(DEBUG.GT.0) WRITE(LU,*) 'XY_TOMAWAC:NPOIN_OUTER:',NPOIN1
!
!     COORDINATES
!
      ALLOCATE(x1(npoin1),stat=ierr)
      CALL check_allocate(ierr,'XY_TOMAWAC:X1')
      ALLOCATE(y1(npoin1),stat=ierr)
      CALL check_allocate(ierr,'XY_TOMAWAC:Y1')
      CALL get_mesh_coord(fformat1,nfic1,1,2,npoin1,x1,ierr)
      CALL check_call(ierr, 'XY_TOMAWAC:GET_MESH_COORD:X_OUTER')
      CALL get_mesh_coord(fformat1,nfic1,2,2,npoin1,y1,ierr)
      CALL check_call(ierr, 'XY_TOMAWAC:GET_MESH_COORD:Y_OUTER')
!
!     X AND Y FOR EACH SPECTRUM/POINT IN SPEC
!
      DO i=1,spec%N
        spec%XOUTER(i) = x1(spec%NOUTER(i))
        spec%YOUTER(i) = y1(spec%NOUTER(i))
      ENDDO
!     IF(DEBUG.GT.0) WRITE(LU,*) 
!    &                'XY_TOMAWAC:SPEC%XOUTER:',SPEC%XOUTER
!     IF(DEBUG.GT.0) WRITE(LU,*) 
!    &                'XY_TOMAWAC:SPEC%YOUTER:',SPEC%YOUTER
!
      DEALLOCATE(x1,y1)
!
!-----------------------------------------------------------------------
!
      RETURN
      END