mod_coupler.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE mod_coupler
 
#if defined MODEL_COUPLING && defined MCT_LIB
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!
      USE mod_param
!
      implicit none
!
!-----------------------------------------------------------------------
!  Set several model coupling structures.
!-----------------------------------------------------------------------
!
!  Integer vector structure.
!
      TYPE t_integer
        integer, pointer :: val(:)
      END TYPE
!
!  String vector structure.
!
      TYPE t_string
        character (len=10), pointer :: code(:)
      END TYPE
!
!  Coupling field attributes structure.
!
      TYPE t_field
        integer :: fieldid              ! field ID
        integer :: gridid               ! associated grid ID
        integer :: maskid               ! associated land/sea mask ID
        integer :: gridtype             ! grid type (RHO-, U-, V-points)
        real(r8) :: addoffset           ! number added to data
        real(r8) :: scale               ! scaling factor
        real(r8) :: expmin              ! exported minimum value
        real(r8) :: expmax              ! exported maximum value
        real(r8) :: impmin              ! imported minimum value
        real(r8) :: impmax              ! imported maximum value
        character (len=40) :: code      ! field code
        character (len=40) :: variable  ! associated model variable
        character (len=80) :: name      ! long descriptive field name
        character (len=80) :: units     ! field units
      END TYPE t_field
!
!  Coupling model exchange mesh attributes structure.
!
      TYPE t_mesh
        integer :: gridid               ! grid ID
        integer :: gridtype             ! grid type (RHO-, U-, V-points)
        character (len=40) :: code      ! grid code
        character (len=40) :: variable  ! associated model variable
        character (len=80) :: name      ! long descriptive grid name
        character (len=80) :: units     ! grid units
      END TYPE t_mesh
!
!  Time clock.
!
      TYPE t_clock
        integer :: year                 ! year
        integer :: month                ! month
        integer :: day                  ! day
        integer :: hour                 ! hour
        integer :: minute               ! minute
        integer :: second               ! second
        integer :: yearday              ! day of the year
        integer :: timezone             ! time zone, hours offset
        character (len=30) :: string    ! time string
      END TYPE t_clock
!
!-----------------------------------------------------------------------
!  Set various variables used to couple ROMS to other modeling
!  systems.
!-----------------------------------------------------------------------
!
!  Number of models to couple.
!
      integer :: nmodels
!
!  Coupled model components IDs.
!
      integer :: atmid = 3
      integer :: wavid = 2
      integer :: ocnid = 1
!
!  Logical switch to report verbose import/export field ranges.
!
      logical :: lreport = .false.
!
!  Input coupled model order labels used to determine the values of
!  each model index in information variable.
!
      character (len=20), allocatable :: orderlabel(:)
!
!  Coupled model indices. Values are initilized here to zero and
!  assigned in "inp_par" using order labels codes.
!
      integer :: iatmos = 0            ! atmospheric model
      integer :: iocean = 0            ! ocean model
      integer :: iwaves = 0            ! wave model
!
!  Standard input file name for each coupled model.
!
      character (len=256), allocatable :: inpname(:)
!
!  Export/Import fields information file name.
!
      character (len=256) :: cplname
!
!  Number of parallel nodes assigned to each model in the coupled model.
!  Their sum must be equal to the total number of processors.
!
      integer, allocatable :: nthreads(:)
!
!  Assigned Pertsistent Execution Threads (PETs) for each coupled
!  model.
!
      TYPE (t_integer), allocatable :: pets(:)
!
!  Time interval (seconds) between coupling of models.  This is a symmetric
!  matrix.  For example, the time interval coupling between ocean and
!  atmosphere models is:
!
!     TimeInterval(Iocean,Iatmos) = TimeInterval(Iocean,Iatmos)
!
      real(r8), allocatable :: timeinterval(:,:)
!
!  Number of time-steps for how often to couple ROMS to other models.
!
!     CoupleSteps(:,ng) = MAX(1,INT(TimeInterval(Iocean,:)/dt(ng)))
!
      integer, allocatable :: couplesteps(:,:)
!
!  Export/Import fields information structure.  This information is read
!  from input CPLname file.
!
      integer, parameter :: maxnumberfields = 50
 
      TYPE (t_field) :: fields(maxnumberfields)
!
!  Number export and import fields for each coupled model.
!
      integer, allocatable :: nexport(:)
      integer, allocatable :: nimport(:)
!
!  Export/import fields IDs for each coupled model.
!
      TYPE (t_integer), allocatable :: exportid(:)
      TYPE (t_integer), allocatable :: importid(:)
!
!  Export/import fields codes for each coupled model.
!
      TYPE (t_string), allocatable :: export(:)
      TYPE (t_string), allocatable :: import(:)
!
!  Export fields attribute string.
!
      character (len=240), allocatable :: exportlist(:)
 
      CONTAINS
 
      SUBROUTINE allocate_coupler (Nnodes)
!
!=======================================================================
!                                                                      !
!  This routine allocates all variables in the module for all coupled  !
!  models. It also initialize variable when appropriate.               !
!                                                                      !
!=======================================================================
!
      USE mod_parallel
      USE mod_iounits
      USE mod_ncparam
      USE mod_scalars
!
!  Imported variable declarations.
!
      integer, intent(in) :: Nnodes
!
!  Local variable declarations.
!
      logical :: load
!
      integer, parameter :: inp = 20
!
      integer :: Nfields
      integer :: gtype, i, id, ifield, inode, lvar, model, ng, varid
      integer :: io_err
!
      real(r8) :: add_offset, scale
!
      character (len=40 ) :: code
      character (len=80 ) :: string
      character (len=256) :: io_errmsg
      character (len=MaxLen), dimension(5) :: Vinfo
!
!-----------------------------------------------------------------------
!  Read in coupling export/import variable information.
!-----------------------------------------------------------------------
!
!  Open input coupling variable information file.
!
      OPEN (inp, file=trim(cplname), form='formatted', status='old',    &
     &      iostat=io_err, iomsg=io_errmsg)
      IF (io_err.ne.0) THEN
        IF (myrank.eq.0) WRITE(stdout,50) trim(cplname), trim(io_errmsg)
        exit_flag=5
        RETURN
      END IF
!
!  Read in variable information.  Ignore blank and comment [char(33)=!]
!  input lines.
!
      varid=0
      DO WHILE (.true.)
        READ (inp,*,err=30,END=40) Vinfo(1)
        lvar=len_trim(vinfo(1))
!
!  Read in other variable information.
!
        IF ((lvar.gt.0).and.(vinfo(1)(1:1).ne.char(33))) THEN
          READ (inp,*,err=30) vinfo(2)
          READ (inp,*,err=30) vinfo(3)
          READ (inp,*,err=30) vinfo(4)
          READ (inp,*,err=30) vinfo(5)
          READ (inp,*,err=30) add_offset
          READ (inp,*,err=30) scale
!
!  Determine staggered C-grid variable.
!
          SELECT CASE (trim(adjustl(vinfo(5))))
            CASE ('p2dvar')
              gtype=p2dvar
            CASE ('r2dvar')
              gtype=r2dvar
            CASE ('u2dvar')
              gtype=u2dvar
            CASE ('v2dvar')
              gtype=v2dvar
            CASE ('p3dvar')
              gtype=p3dvar
            CASE ('r3dvar')
              gtype=r3dvar
            CASE ('u3dvar')
              gtype=u3dvar
            CASE ('v3dvar')
              gtype=v3dvar
            CASE ('w3dvar')
              gtype=w3dvar
            CASE ('b3dvar')
              gtype=b3dvar
            CASE DEFAULT
              gtype=0
          END SELECT
!
!  Load variable data into information arrays.
!
          varid=varid+1
          IF (varid.gt.maxnumberfields) THEN
            WRITE (stdout,60) maxnumberfields, varid
            stop
          END IF
          fields(varid) % code      = trim(adjustl(vinfo(1)))
          fields(varid) % variable  = trim(adjustl(vinfo(2)))
          fields(varid) % name      = trim(adjustl(vinfo(3)))
          fields(varid) % units     = trim(adjustl(vinfo(4)))
          fields(varid) % FieldID   = varid
          fields(varid) % GridType  = gtype
          fields(varid) % AddOffset = add_offset
          fields(varid) % scale     = scale
        END IF
      END DO
  30  WRITE (stdout,80) trim(adjustl(vinfo(1)))
      stop
  40  CLOSE (inp)
      nfields=varid
!
!-----------------------------------------------------------------------
!  Determine identification index for export and import fields.
!-----------------------------------------------------------------------
!
!  Allocate IDs structures.
!
      IF (.not.allocated(exportid)) THEN
        allocate ( exportid(nmodels) )
        DO model=1,nmodels
          allocate ( exportid(model)%val(nexport(model)) )
          exportid(model)%val=0
        END DO
      END IF
      IF (.not.allocated(importid)) THEN
        allocate ( importid(nmodels) )
        DO model=1,nmodels
          allocate ( importid(model)%val(nimport(model)) )
          importid(model)%val=0
        END DO
      END IF
      IF (.not.allocated(exportlist)) THEN
        allocate ( exportlist(nmodels) )
      END IF
!
!  Look fields information and extract Export/Import fields IDs for
!  each coupled model.
!
      DO model=1,nmodels
        DO ifield=1,nexport(model)
          DO i=1,nfields
            IF (trim(adjustl(fields(i)%code)).eq.                       &
     &          trim(adjustl(export(model)%code(ifield)))) THEN
              exportid(model)%val(ifield)=fields(i)%FieldID
            END IF
          END DO
        END DO
        DO ifield=1,nimport(model)
          DO i=1,nfields
            IF (trim(adjustl(fields(i)%code)).eq.                       &
     &          trim(adjustl(import(model)%code(ifield)))) THEN
              importid(model)%val(ifield)=fields(i)%FieldID
            END IF
          END DO
        END DO
      END DO
      DO model=1,nmodels
        exportlist(model)=' '
        DO ifield=1,nexport(model)
          id=exportid(model)%val(ifield)
          IF (id.gt.0) THEN
            code=adjustl(fields(id)%code)
            IF (ifield.eq.1) THEN
              exportlist(model)=trim(exportlist(model))//trim(code)
            ELSE
              exportlist(model)=trim(exportlist(model))//':'//trim(code)
            END IF
          ELSE
            WRITE (stdout,70) model, trim(exportlist(model)),           &
     &                        trim(cplname)
            stop
          END IF
        END DO
      END DO
!
!-----------------------------------------------------------------------
!  Assign processors to coupled models.
!-----------------------------------------------------------------------
!
!  Allocate structure.
!
      IF (.not.allocated(pets)) THEN
        allocate ( pets(nmodels) )
        DO model=1,nmodels
          allocate ( pets(model)%val(nthreads(model)) )
        END DO
      END IF
!
!  Assign parallel threads for each coupled model.  Start counting from
!  zero. That is, they are [0:Nnodes-1] available.
!
      inode=-1
      DO model=1,nmodels
        DO i=1,nthreads(model)
          inode=inode+1
          pets(model)%val(i)=inode
        END DO
      END DO
!
!  Report.
!
      IF ((inode+1).ne.nnodes) THEN
        IF (myrank.eq.0) THEN
          WRITE (stdout,80) inode, nnodes
        END IF
        stop
      ELSE
        IF (myrank.eq.0) THEN
          WRITE (stdout,90)
          DO model=1,nmodels
            IF (model.eq.iocean) THEN
              string='Ocean Model MPI nodes:'
            ELSE IF (model.eq.iwaves) THEN
              string='Waves Model MPI nodes:'
            ELSE IF (model.eq.iatmos) THEN
              string='Atmos Model MPI nodes:'
            END IF
            WRITE (stdout,100) trim(string),                            &
     &                         pets(model)%val(1),                      &
     &                         pets(model)%val(nthreads(model))
          END DO
        END IF
        WRITE (stdout,'(/)')
      END IF
      IF (myrank.eq.0) THEN
        DO model=1,nmodels
          IF (model.eq.iocean) THEN
            string='Ocean Export:'
          ELSE IF (model.eq.iwaves) THEN
            string='Waves Export:'
          ELSE IF (model.eq.iatmos) THEN
            string='Atmos Export:'
          END IF
          WRITE (stdout,110) trim(string), trim(exportlist(model))
        END DO
        WRITE (stdout,'(/)')
      END IF
 
!
 50   FORMAT (/,' MOD_COUPLER - Unable to open variable information',   &
     &        ' file: ',/,15x,a,/,15x,'ERROR: ',a,                      &
              /,15x,'Default file is located in source directory.')
 60   FORMAT (/,' MOD_COUPLER - too small dimension ',                  &
     &        'parameter, MV = ',2i5,/,15x,                             &
     &        'change file  mod_ncparam.F  and recompile.')
 70   FORMAT (/,' MOD_COUPLER - Unregistered export field for ',        &
     &          ' model = ',i1,/,15x,'ExportList = ',a,/,15x,           &
     &          ' check file = ',a)
 80   FORMAT (/,' MOD_COUPLER - Number assigned processors: ',          &
     &        i3.3,/,15x,'not equal to spawned MPI nodes: ',i3.3)
 90   FORMAT (/,' Model Coupling Parallel Threads:',/)
100   FORMAT (3x,a,3x,i3.3,' - ',i3.3)
110   FORMAT (3x,a,1x,a)
 
      END SUBROUTINE allocate_coupler
!
#endif
      END MODULE mod_coupler