w3agcmmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
!/ ------------------------------------------------------------------- /
MODULE w3agcmmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           J. Pianezze             |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :            Mar-2021 |
  !/                  +-----------------------------------+
  !/
  !/        Mar-2014 : Origination.                       ( version 4.18 )
  !/                   For upgrades see subroutines.
  !/        Apr-2016 : Add comments (J. Pianezze)         ( version 5.07 )
  !/        Mar-2021 : Add TAUA and RHOA coupling         ( version 7.13 )
  !/
  !/    Copyright 2009-2012 National Weather Service (NWS),
  !/       National Oceanic and Atmospheric Administration.  All rights
  !/       reserved.  WAVEWATCH III is a trademark of the NWS.
  !/       No unauthorized use without permission.
  !/
  !  1. Purpose :
  !
  !     Module used for coupling applications between atmospheric model and WW3 with OASIS3-MCT
  !
  !  2. Variables and types :
  !
  !  3. Subroutines and functions :
  !
  !      Name                   Type   Scope    Description
  !     ----------------------------------------------------------------
  !      SND_FIELDS_TO_ATMOS    Subr.  Public   Send fields to atmos model
  !      RCV_FIELDS_FROM_ATMOS  Subr.  Public   Receive fields from atmos model
  !     ----------------------------------------------------------------
  !
  !  4. Subroutines and functions used :
  !
  !      Name                 Type    Module     Description
  !     ----------------------------------------------------------------
  !      CPL_OASIS_SEND       Subr.   W3OACPMD   Send fields
  !      CPL_OASIS_RECV       Subr.   W3OACPMD   Receive fields
  !     ----------------------------------------------------------------
  !
  !  5. Remarks
  !  6. Switches :
  !  7. Source code :
  !
  !/ ------------------------------------------------------------------- /
  !
  IMPLICIT NONE
  !
  include "mpif.h"
  !
  PRIVATE
  !
  ! * Accessibility
  PUBLIC snd_fields_to_atmos
  PUBLIC rcv_fields_from_atmos
  !
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE snd_fields_to_atmos()
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           J. Pianezze             |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :            Apr-2016 |
    !/                  +-----------------------------------+
    !/
    !/    Mar-2014 : Origination.                  ( version 4.18 )
    !/    Apr-2016 : Add comments (J. Pianezze)    ( version 5.07 )
    !/
    !  1. Purpose :
    !
    !     Send coupling fields to atmospheric model
    !
    !  2. Method :
    !  3. Parameters :
    !  4. Subroutines used :
    !
    !     Name             Type    Module     Description
    !     -------------------------------------------------------------------
    !     CPL_OASIS_SND    Subr.   W3OACPMD   Send field to atmos/ocean model
    !     -------------------------------------------------------------------
    !
    !  5. Called by :
    !
    !     Name            Type    Module     Description
    !     ------------------------------------------------------------------
    !     W3WAVE          Subr.   W3WAVEMD   Wave model
    !     ------------------------------------------------------------------
    !
    !  6. Error messages :
    !  7. Remarks :
    !  8. Structure :
    !  9. Switches :
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3oacpmd,  ONLY: id_oasis_time, il_nb_snd, snd_fld, cpl_oasis_snd
    USE w3gdatmd,  ONLY: nseal, nsea
    USE w3adatmd,  ONLY: cx, cy, charn, hs, fp0, tws
    USE w3odatmd,  ONLY: undef, naproc, iaproc
    !
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    REAL(kind=8), dimension(nseal,1) :: rla_oasis_snd
    INTEGER                          :: ib_do
    LOGICAL                          :: ll_action
    REAL(kind=8), dimension(nseal)   :: tmp
    INTEGER                          :: jsea, isea
    !
    !----------------------------------------------------------------------
    ! * Executable part
    !
    DO ib_do = 1, il_nb_snd
      !
      ! Ocean sea surface current (m.s-1) (u-component)
      ! ---------------------------------------------------------------------
      IF (snd_fld(ib_do)%CL_FIELD_NAME == 'WW3_WSSU') THEN
        tmp(1:nseal) = 0.0
        DO jsea=1, nseal
          isea=iaproc+(jsea-1)*naproc
          IF(cx(isea) /= undef) tmp(jsea)=cx(isea)
        END DO
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
      ENDIF
      !
      ! Ocean sea surface current (m.s-1) (v-component)
      ! ---------------------------------------------------------------------
      IF (snd_fld(ib_do)%CL_FIELD_NAME == 'WW3_WSSV') THEN
        tmp(1:nseal) = 0.0
        DO jsea=1, nseal
          isea=iaproc+(jsea-1)*naproc
          IF(cy(isea) /= undef) tmp(jsea)=cy(isea)
        END DO
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
      ENDIF
      !
      ! Charnock Coefficient (-)
      ! ---------------------------------------------------------------------
      IF (snd_fld(ib_do)%CL_FIELD_NAME == 'WW3_ACHA') THEN
        tmp(1:nseal) = 0.0
        WHERE(charn(1:nseal) /= undef) tmp(1:nseal)=charn(1:nseal)
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
      ENDIF
      !
      ! Significant wave height (m)
      ! ---------------------------------------------------------------------
      IF (snd_fld(ib_do)%CL_FIELD_NAME == 'WW3__AHS') THEN
        tmp(1:nseal) = 0.0
        WHERE(hs(1:nseal) /= undef) tmp(1:nseal)=hs(1:nseal)
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
      ENDIF
      !
      ! Peak frequency (s-1)
      ! ---------------------------------------------------------------------
      IF (snd_fld(ib_do)%CL_FIELD_NAME == 'WW3___FP') THEN
        tmp(1:nseal) = 0.0
        WHERE(fp0(1:nseal) /= undef) tmp(1:nseal)=fp0(1:nseal)
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
      ENDIF
      !
      ! Peak period (s)
      ! ---------------------------------------------------------------------
      IF (snd_fld(ib_do)%CL_FIELD_NAME == 'WW3___TP') THEN
        tmp(1:nseal) = 0.0
        WHERE(fp0(1:nseal) /= undef) tmp(1:nseal)=1./fp0(1:nseal)
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
      ENDIF
      !
      ! Wind sea Mean period (s)
      ! ---------------------------------------------------------------------
      IF (snd_fld(ib_do)%CL_FIELD_NAME == 'WW3__FWS') THEN
        tmp(1:nseal) = 0.0
        WHERE(tws(1:nseal) /= undef) tmp(1:nseal)=tws(1:nseal)
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
      ENDIF
      !
 
    ENDDO
    !
    !/ ------------------------------------------------------------------- /
  END SUBROUTINE snd_fields_to_atmos
  !/ ------------------------------------------------------------------- /
  SUBROUTINE rcv_fields_from_atmos(ID_LCOMM, IDFLD, FXN, FYN, FAN)
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           J. Pianezze             |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :            Mar-2021 |
    !/                  +-----------------------------------+
    !/
    !/    Mar-2014 : Origination.                ( version 4.18 )
    !/    Apr-2015 : Modification (M. Accensi)   ( version 5.07 )
    !/    Apr-2016 : Add comments (J. Pianezze)  ( version 5.07 )
    !/    Mar-2021 : Add TAUA and RHOA coupling  ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Receive coupling fields from atmospheric model
    !
    !  2. Method :
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !     ID_LCOMM          Char.     I     MPI communicator
    !     IDFLD             Int.      I     Name of the exchange fields
    !     FXN               Int.     I/O    First exchange field
    !     FYN               Int.     I/O    Second exchange field
    !     FAN               Int.     I/O    Third exchange field
    !     ----------------------------------------------------------------
    !
    !  4. Subroutines used :
    !
    !     Name             Type    Module     Description
    !     -------------------------------------------------------------------
    !     CPL_OASIS_RCV    Subr.   W3OACPMD   Receive fields from atmos/ocean model
    !     W3S2XY           Subr.   W3SERVMD   Convert from storage (NSEA) to spatial grid (NX, NY)
    !     -------------------------------------------------------------------
    !
    !  5. Called by :
    !
    !     Name            Type    Module     Description
    !     ------------------------------------------------------------------
    !     W3FLDG          Subr.   W3FLDSMD   Manage input fields of depth,
    !                                        current, wind and ice concentration
    !     ------------------------------------------------------------------
    !
    !  6. Error messages :
    !  7. Remarks :
    !  8. Structure :
    !  9. Switches :
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    !
    USE w3oacpmd, ONLY: id_oasis_time, il_nb_rcv, rcv_fld, cpl_oasis_rcv
    USE w3gdatmd, ONLY: nx, ny, nseal, nsea, mapsf
    USE w3odatmd, ONLY: naproc, iaproc
    USE w3servmd, ONLY: w3s2xy
    !
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)              :: id_lcomm
    CHARACTER(LEN=3), INTENT(IN)     :: idfld
    REAL, INTENT(INOUT)              :: fxn(:,:), fyn(:,:), fan(:,:)
    !
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    LOGICAL                          :: ll_action
    INTEGER                          :: ib_do, ib_i, ib_j, il_err
    REAL(kind=8), dimension(nseal,1) :: rla_oasis_rcv
    REAL(kind=8), dimension(nseal)   :: tmp
    REAL, DIMENSION(1:NSEA)          :: snd_buff,rcv_buff
    !
    !----------------------------------------------------------------------
    ! * Executable part
    !
    rla_oasis_rcv(:,:) = 0.0
    !
    DO ib_do = 1, il_nb_rcv
      IF (idfld == 'WND') THEN
        !
        ! Wind speed at 10m (m.s-1) (u-component)
        ! ----------------------------------------------------------------------
        IF (rcv_fld(ib_do)%CL_FIELD_NAME == 'WW3__U10') THEN
          CALL cpl_oasis_rcv(ib_do, id_oasis_time, rla_oasis_rcv, ll_action)
          IF (ll_action) THEN
            tmp(1:nseal) = rla_oasis_rcv(1:nseal,1)
            snd_buff(1:nsea) = 0.0
            DO ib_i = 1, nseal
              ib_j = iaproc + (ib_i-1)*naproc
              snd_buff(ib_j) = tmp(ib_i)
            ENDDO
            !
            CALL mpi_allreduce(snd_buff(1:nsea), &
                 rcv_buff(1:nsea), &
                 nsea,     &
                 mpi_real, &
                 mpi_sum,  &
                 id_lcomm, &
                 il_err)
            !
            ! Convert from storage (NSEA) to spatial grid (NX, NY)
            CALL w3s2xy(nsea,nsea,nx,ny,rcv_buff(1:nsea),mapsf,fxn)
            !
          ENDIF
        ENDIF
        !
        ! Wind speed at 10m (m.s-1) (v-component)
        ! ----------------------------------------------------------------------
        IF (rcv_fld(ib_do)%CL_FIELD_NAME == 'WW3__V10') THEN
          CALL cpl_oasis_rcv(ib_do, id_oasis_time, rla_oasis_rcv, ll_action)
          IF (ll_action) THEN
            tmp(1:nseal) = rla_oasis_rcv(1:nseal,1)
            snd_buff(1:nsea) = 0.0
            DO ib_i = 1, nseal
              ib_j = iaproc + (ib_i-1)*naproc
              snd_buff(ib_j) = tmp(ib_i)
            END DO
            !
            CALL mpi_allreduce(snd_buff(1:nsea),       &
                 rcv_buff(1:nsea),       &
                 nsea,     &
                 mpi_real, &
                 mpi_sum,  &
                 id_lcomm, &
                 il_err)
            !
            ! Convert from storage (NSEA) to spatial grid (NX, NY)
            CALL w3s2xy(nsea,nsea,nx,ny,rcv_buff(1:nsea),mapsf,fyn)
            !
          ENDIF
        ENDIF
        !
      ENDIF
      IF (idfld == 'TAU') THEN
        !
        ! Atmospheric momentum (Pa) (u-component)
        ! ----------------------------------------------------------------------
        IF (rcv_fld(ib_do)%CL_FIELD_NAME == 'WW3_UTAU') THEN
          CALL cpl_oasis_rcv(ib_do, id_oasis_time, rla_oasis_rcv, ll_action)
          IF (ll_action) THEN
            tmp(1:nseal) = rla_oasis_rcv(1:nseal,1)
            snd_buff(1:nsea) = 0.0
            DO ib_i = 1, nseal
              ib_j = iaproc + (ib_i-1)*naproc
              snd_buff(ib_j) = tmp(ib_i)
            ENDDO
            !
            CALL mpi_allreduce(snd_buff(1:nsea), &
                 rcv_buff(1:nsea), &
                 nsea,     &
                 mpi_real, &
                 mpi_sum,  &
                 id_lcomm, &
                 il_err)
            !
            ! Convert from storage (NSEA) to spatial grid (NX, NY)
            CALL w3s2xy(nsea,nsea,nx,ny,rcv_buff(1:nsea),mapsf,fxn)
            !
          ENDIF
        ENDIF
        !
        ! Atmospheric momentum (Pa) (v-component)
        ! ----------------------------------------------------------------------
        IF (rcv_fld(ib_do)%CL_FIELD_NAME == 'WW3_VTAU') THEN
          CALL cpl_oasis_rcv(ib_do, id_oasis_time, rla_oasis_rcv, ll_action)
          IF (ll_action) THEN
            tmp(1:nseal) = rla_oasis_rcv(1:nseal,1)
            snd_buff(1:nsea) = 0.0
            DO ib_i = 1, nseal
              ib_j = iaproc + (ib_i-1)*naproc
              snd_buff(ib_j) = tmp(ib_i)
            END DO
            !
            CALL mpi_allreduce(snd_buff(1:nsea),       &
                 rcv_buff(1:nsea),       &
                 nsea,     &
                 mpi_real, &
                 mpi_sum,  &
                 id_lcomm, &
                 il_err)
            !
            ! Convert from storage (NSEA) to spatial grid (NX, NY)
            CALL w3s2xy(nsea,nsea,nx,ny,rcv_buff(1:nsea),mapsf,fyn)
            !
          ENDIF
        ENDIF
        !
      ENDIF
      IF (idfld == 'RHO') THEN
        !
        ! Air density (kg.m-3)
        ! ----------------------------------------------------------------------
        IF (rcv_fld(ib_do)%CL_FIELD_NAME == 'WW3_RHOA') THEN
          CALL cpl_oasis_rcv(ib_do, id_oasis_time, rla_oasis_rcv, ll_action)
          IF (ll_action) THEN
            tmp(1:nseal) = rla_oasis_rcv(1:nseal,1)
            snd_buff(1:nsea) = 0.0
            DO ib_i = 1, nseal
              ib_j = iaproc + (ib_i-1)*naproc
              snd_buff(ib_j) = tmp(ib_i)
            ENDDO
            !
            CALL mpi_allreduce(snd_buff(1:nsea), &
                 rcv_buff(1:nsea), &
                 nsea,     &
                 mpi_real, &
                 mpi_sum,  &
                 id_lcomm, &
                 il_err)
            !
            ! Convert from storage (NSEA) to spatial grid (NX, NY)
            CALL w3s2xy(nsea,nsea,nx,ny,rcv_buff(1:nsea),mapsf,fan)
            !
          ENDIF
        ENDIF
      ENDIF
    ENDDO
    !/ ------------------------------------------------------------------- /
  END SUBROUTINE rcv_fields_from_atmos
  !/ ------------------------------------------------------------------- /
  !/
END MODULE w3agcmmd
!/
!/ ------------------------------------------------------------------- /