w3igcmmd.F90

Go to the documentation of this file.

 
 
#include "w3macros.h"
 
!/ ------------------------------------------------------------------- /
MODULE w3igcmmd
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           G. Boutin               |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :          Aug-2016   |
  !/                  +-----------------------------------+
  !/
  !/        Aug-2016 : Origination (G. Boutin)         ( version 5.10 )
  !/
  !/    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 ice model and WW3 with OASIS3-MCT
  !
  !  2. Variables and types :
  !
  !  3. Subroutines and functions :
  !
  !      Name                   Type   Scope    Description
  !     ----------------------------------------------------------------
  !      SND_FIELDS_TO_ICE    Subr.  Public   Send fields to ice model
  !      RCV_FIELDS_FROM_ICE Subr.  Public   Receive fields from ice 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_ice
  PUBLIC rcv_fields_from_ice
  !
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE snd_fields_to_ice()
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           G. Boutin               |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :            Aug-2016 |
    !/                  +-----------------------------------+
    !/
    !/    Aug-2016 : Origination (G. Boutin)    ( version 5.10 )
    !/
    !  1. Purpose :
    !
    !     Send coupling fields to ice model
    !
    !  2. Method :
    !  3. Parameters :
    !  4. Subroutines used :
    !
    !     Name             Type    Module     Description
    !     -------------------------------------------------------------------
    !     CPL_OASIS_SND    Subr.   W3OACPMD   Send field to ice/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 w3wdatmd,  ONLY: icef
    USE w3adatmd,  ONLY: tauice
    USE w3odatmd,  ONLY: undef, naproc, iaproc
    !
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    REAL(kind=8), dimension(nseal,1) :: rla_oasis_snd
    INTEGER                          :: ib_do, ndso
    LOGICAL                          :: ll_action
    REAL(kind=8), dimension(nseal)   :: tmp
    INTEGER                          :: jsea, isea
    !
    !----------------------------------------------------------------------
    ! * Executable part
    !
    DO ib_do = 1, il_nb_snd
 
      SELECT CASE(snd_fld(ib_do)%CL_FIELD_NAME)
 
        !
        ! Ice floe diameters (m)
        ! ---------------------------------------------------------------------
      CASE ('WW3_ICEF')
        tmp(1:nseal) = 0.0
        DO jsea=1, nseal
          isea=iaproc+(jsea-1)*naproc
          IF(icef(isea) /= undef) tmp(jsea)=icef(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)
 
      CASE ('WW3_TWIX')
        tmp(1:nseal) = 0.0
        WHERE(tauice(1:nseal,1) /= undef) tmp(1:nseal)=tauice(1:nseal,1)
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
 
      CASE ('WW3_TWIY')
        tmp(1:nseal) = 0.0
        WHERE(tauice(1:nseal,2) /= undef) tmp(1:nseal)=tauice(1:nseal,2)
        rla_oasis_snd(:,1) = dble(tmp(1:nseal))
        CALL cpl_oasis_snd(ib_do, id_oasis_time, rla_oasis_snd, ll_action)
 
      END SELECT
 
 
    ENDDO
    !
    !/ ------------------------------------------------------------------- /
  END SUBROUTINE snd_fields_to_ice
  !/ ------------------------------------------------------------------- /
  SUBROUTINE rcv_fields_from_ice(ID_LCOMM, IDFLD, FXN, FYN, FAN)
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           G. Boutin             |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :          April-2016 |
    !/                  +-----------------------------------+
    !/
    !/    Aug-2016 : Origination (G. Boutin)  ( version 5.10 )
    !/
    !  1. Purpose :
    !
    !     Receive coupling fields from ice 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 ice/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, ndso
    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 == 'IC5') THEN
        SELECT CASE (rcv_fld(ib_do)%CL_FIELD_NAME)
          !
          ! Ice floe diameters (m)
          ! ----------------------------------------------------------------------
        CASE ('WW3__IC5')
 
          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,fan)
            !
          END IF
        END SELECT
        !
        ! Ice Concentration
        ! ----------------------------------------------------------------------
      ELSE IF (idfld == 'ICE') THEN
        SELECT CASE (rcv_fld(ib_do)%CL_FIELD_NAME)
        CASE ('WW3__ICE')
          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,fan)
            !
          END IF
        END SELECT
        ! Ice Thickness
        ! ----------------------------------------------------------------------
      ELSE IF (idfld == 'IC1') THEN
        SELECT CASE (rcv_fld(ib_do)%CL_FIELD_NAME)
        CASE ('WW3__IC1')
          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,fan)
          ENDIF
          !
        END SELECT
 
      END IF
    END DO
    !
 
    !/ ------------------------------------------------------------------- /
  END SUBROUTINE rcv_fields_from_ice
  !/ ------------------------------------------------------------------- /
  !/
END MODULE w3igcmmd
!/
!/ ------------------------------------------------------------------- /