mct_driver.h

Go to the documentation of this file.

      PROGRAM mct_driver
!
!git $Id$
!=======================================================================
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                            Hernan G. Arango   !
!==================================================== John C. Warner ===
!                                                                      !
!  Master program to couple ROMS to other models using the Model       !
!  Coupling Toolkit (MCT) library.                                     !
!                                                                      !
!  The following models are coupled to ROMS:                           !
!                                                                      !
#ifdef WRF_COUPLING
!  WRF, Weather Research and Forecasting model:                        !
!       http://www.wrf-model.org                                       !
!                                                                      !
#endif
#ifdef SWAN_COUPLING
!  SWAN, Simulating WAves Nearshore model:                             !
!        http://vlm089.citg.tudelft.nl/swan/index.htm                  !
!                                                                      !
#endif
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_coupler
      USE mod_iounits
      USE mod_scalars
!
      USE m_mctworld,        ONLY : mctworld_clean => clean
 
#ifdef WRF_COUPLING
      USE mct_coupler_mod,   ONLY : finalize_ocn2atm_coupling
#endif
#if defined SWAN_COUPLING || defined REFDIF_COUPLING
      USE mct_coupler_mod,   ONLY : finalize_ocn2wav_coupling
#endif
      USE roms_kernel_mod,   ONLY : roms_initialize
      USE roms_kernel_mod,   ONLY : roms_run
      USE roms_kernel_mod,   ONLY : roms_finalize
#if defined PIO_LIB && defined DISTRIBUTE
      USE set_pio_mod,       ONLY : finalize_pio
#endif
!
      implicit none
!
!  Local variable declarations.
!
      logical, save :: first
 
      integer :: mycolor, mycomm, myerror, mykey, nnodes
      integer :: ng, provided, required
 
      real(r4) :: couplingtime             ! single precision
!
!-----------------------------------------------------------------------
!  Initialize distributed-memory (MPI) configuration
!-----------------------------------------------------------------------
!
!  Initialize MPI execution environment.
!
#ifdef MULTI_THREAD
      required=mpi_thread_multiple
      CALL mpi_init_thread (required, provided, myerror)
      IF (myerror.ne.0) THEN
        print '(/,a)',' ROMS: Unable to initialize multi-threaded MPI'
        exit_flag=6
      END IF
#else
      CALL mpi_init (myerror)
      IF (myerror.ne.0) THEN
        print '(/,a)',' ROMS: Unable to initialize MPI'
        exit_flag=6
      END IF
#endif
!
!  Get rank of the local process in the group associated with the
!  comminicator.
!
      CALL mpi_comm_size (mpi_comm_world, nnodes, myerror)
      CALL mpi_comm_rank (mpi_comm_world, myrank, myerror)
!
!  Set temporarily the ocean communicator to current handle before
!  splitting so the input coupling script name can be broadcasted to
!  all the nodes.
!
      ocn_comm_world=mpi_comm_world
!
!  Read in coupled model parameters from standard input.
!
      CALL read_couplepar (inlm)
!
!  Allocate several coupling variables.
!
      CALL allocate_coupler (nnodes)
!
!  Split the communicator into coupled models sub-groups based
!  on color and key.
!
      mykey=0
      IF ((pets(iocean)%val(1).le.myrank).and.                          &
     &    (myrank.le.pets(iocean)%val(nthreads(iocean)))) THEN
        mycolor=ocnid
      END IF
#ifdef ATM_COUPLING
      IF ((pets(iatmos)%val(1).le.myrank).and.                          &
     &    (myrank.le.pets(iatmos)%val(nthreads(iatmos)))) THEN
        mycolor=atmid
      END IF
#endif
#ifdef WAV_COUPLING
      IF ((pets(iwaves)%val(1).le.myrank).and.                          &
     &    (myrank.le.pets(iwaves)%val(nthreads(iwaves)))) THEN
        mycolor=wavid
      END IF
#endif
      CALL mpi_comm_split (mpi_comm_world, mycolor, mykey, mycomm,      &
     &                     myerror)
!
!-----------------------------------------------------------------------
!  Run coupled models according to the processor rank.
!-----------------------------------------------------------------------
!
#if defined SWAN_COUPLING
      IF (mycolor.eq.wavid) THEN
        couplingtime=real(timeinterval(iocean,iwaves))
        CALL swan_initialize (mycomm, inpname(iwaves))
        CALL swan_run (couplingtime)
        CALL swan_finalize
      END IF
#elif defined REFDIF_COUPLING
      IF (mycolor.eq.wavid) THEN
        couplingtime=real(timeinterval(iocean,iwaves))
        CALL refdif_initialize (mycomm)
        CALL refdif_run (couplingtime, inpname(iwaves))
        CALL refdif_finalize
      END IF
#endif
#ifdef WRF_COUPLING
      IF (mycolor.eq.atmid) THEN
        couplingtime=real(timeinterval(iocean,iatmos))
!!      CALL module_wrf_top_mp_wrf_init (MyCOMM)
!!      CALL module_wrf_top_mp_wrf_run (TimeInterval(Iocean,Iwaves))
!!      CALL module_wrf_top_mp_wrf_finalize
        CALL module_wrf_top_wrf_init (mycomm)
        CALL module_wrf_top_wrf_run (couplingtime)
        CALL module_wrf_top_wrf_finalize
      END IF
#endif
      IF (mycolor.eq.ocnid) THEN
        first=.true.
        IF (exit_flag.eq.noerror) THEN
          CALL roms_initialize (first, mpicomm=mycomm)
          run_time=0.0_r8
          DO ng=1,ngrids
            run_time=max(run_time, dt(ng)*ntimes(ng))
          END DO
        END IF
        IF (exit_flag.eq.noerror) THEN
          CALL roms_run (run_time)
        END IF
        CALL roms_finalize
#if defined PIO_LIB && defined DISTRIBUTE
        CALL finalize_pio
#endif
#if defined SWAN_COUPLING || defined REFDIF_COUPLING
        CALL finalize_ocn2wav_coupling
#endif
#ifdef WRF_COUPLING
        CALL finalize_ocn2atm_coupling
#endif
      END IF
!
!-----------------------------------------------------------------------
!  Terminates all the mpi-processing and coupling.
!-----------------------------------------------------------------------
!
      CALL mpi_barrier (mpi_comm_world, myerror)
      CALL mctworld_clean ()
      CALL mpi_finalize (myerror)
 
      stop
 
      END PROGRAM mct_driver