mod_arrays.F

Go to the documentation of this file.

#include "cppdefs.h"
      MODULE mod_arrays
!
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This module is used to allocate, initialize, and deallocate ROMS    !
!  state arrays for each nested and/or multiple connected grids.       !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_scalars
!
#if defined AVERAGES    || \
   (defined ad_averages && defined adjoint) || \
   (defined rp_averages && defined tl_ioms) || \
   (defined tl_averages && defined tangent)
      USE mod_average,  ONLY : allocate_average,                        &
     &                         deallocate_average,                      &
     &                         initialize_average
#endif
      USE mod_boundary, ONLY : allocate_boundary,                       &
     &                         deallocate_boundary,                     &
     &                         initialize_boundary
      USE mod_clima,    ONLY : allocate_clima,                          &
     &                         deallocate_clima,                        &
     &                         initialize_clima
#ifdef SOLVE3D
      USE mod_coupling, ONLY : allocate_coupling,                       &
     &                         deallocate_coupling,                     &
     &                         initialize_coupling
#endif
#ifdef DIAGNOSTICS
      USE mod_diags,    ONLY : allocate_diags,                          &
     &                         deallocate_diags,                        &
     &                         initialize_diags
#endif
#ifdef GRID_EXTRACT
      USE mod_extract,  ONLY : allocate_extract,                        &
     &                         deallocate_extract,                      &
     &                         initialize_extract
#endif
      USE mod_forces,   ONLY : allocate_forces,                         &
     &                         deallocate_forces,                       &
     &                         initialize_forces
#if defined FOUR_DVAR || defined VERIFICATION
      USE mod_fourdvar, ONLY : deallocate_fourdvar,                     &
     &                         initialize_fourdvar
#endif
      USE mod_grid,     ONLY : allocate_grid,                           &
     &                         deallocate_grid,                         &
     &                         initialize_grid
#ifdef ICE_MODEL
      USE mod_ice,      ONLY : allocate_ice,                            &
     &                         deallocate_ice,                          &
     &                         initialize_ice
#endif
      USE mod_iounits,  ONLY : deallocate_iounits
      USE mod_mixing,   ONLY : allocate_mixing,                         &
     &                         deallocate_mixing,                       &
     &                         initialize_mixing
#ifdef NESTING
      USE mod_nesting,  ONLY : allocate_nesting,                        &
     &                         deallocate_nesting,                      &
     &                         initialize_nesting
#endif
      USE mod_ocean,    ONLY : allocate_ocean,                          &
     &                         deallocate_ocean,                        &
     &                         initialize_ocean
#if defined SEDIMENT || defined BBL_MODEL
      USE mod_sedbed,   ONLY : allocate_sedbed,                         &
     &                         deallocate_sedbed,                       &
     &                         initialize_sedbed
#endif
      USE mod_sources,  ONLY : allocate_sources,                        &
     &                         deallocate_sources
#if defined SSH_TIDES || defined UV_TIDES
      USE mod_tides,    ONLY : allocate_tides,                          &
     &                         deallocate_tides,                        &
     &                         initialize_tides
#endif
#ifdef BBL_MODEL
      USE mod_bbl,      ONLY : allocate_bbl,                            &
     &                         deallocate_bbl,                          &
     &                         initialize_bbl
#endif
#if defined PIO_LIB && defined DISTRIBUTE
      USE set_pio_mod,  ONLY : set_iodecomp
#endif
!
      implicit none
!
      PUBLIC :: roms_allocate_arrays
      PUBLIC :: roms_deallocate_arrays
      PUBLIC :: roms_initialize_arrays
!
#if defined AD_SENSITIVITY   || defined I4DVAR_ANA_SENSITIVITY || \
    defined opt_observations || defined sensitivity_4dvar      || \
    defined so_semi
      logical :: lallocateclima = .true.
#else
      logical :: lallocateclima = .false.
#endif
!
      CONTAINS
!
      SUBROUTINE roms_allocate_arrays (allocate_vars)
!
!=======================================================================
!                                                                      !
!  This routine allocates ROMS state variables.                        !
!                                                                      !
!=======================================================================
!
!  Imported variable declarations
!
      logical, intent(in) :: allocate_vars
!
!  Local variable declarations.
!
      integer :: ng, thread, tile
      integer :: imins, imaxs, jmins, jmaxs
      integer :: lbi, ubi, lbj, ubj, lbij, ubij
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", ROMS_allocate_arrays"
 
#ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn on allocation time wall clock.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, inlm, 1, __line__, myfile)
        END DO
!$OMP BARRIER
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Allocate model type-derived structures and its variables.
!-----------------------------------------------------------------------
!
      IF (allocate_vars) then
#ifdef DISTRIBUTE
        tile=myrank
#else
        tile=0
#endif
        DO ng=1,ngrids
!$OMP MASTER
          lbi=bounds(ng)%LBi(tile)
          ubi=bounds(ng)%UBi(tile)
          lbj=bounds(ng)%LBj(tile)
          ubj=bounds(ng)%UBj(tile)
          lbij=bounds(ng)%LBij
          ubij=bounds(ng)%UBij
#if defined AVERAGES    || \
   (defined ad_averages && defined adjoint) || \
   (defined rp_averages && defined tl_ioms) || \
   (defined tl_averages && defined tangent)
          CALL allocate_average (ng, lbi, ubi, lbj, ubj)
#endif
          CALL allocate_boundary (ng)
#ifdef BBL_MODEL
          CALL allocate_bbl (ng, lbi, ubi, lbj, ubj)
#endif
          IF (lallocateclima.or.lclimatology(ng)) THEN
            CALL allocate_clima (ng, lbi, ubi, lbj, ubj)
          END IF
#ifdef SOLVE3D
          CALL allocate_coupling (ng, lbi, ubi, lbj, ubj)
#endif
#ifdef DIAGNOSTICS
          CALL allocate_diags (ng, lbi, ubi, lbj, ubj)
#endif
#ifdef GRID_EXTRACT
          CALL allocate_extract (ng, extractflag(ng),                   &
     &                           xtr_bounds(ng)%LBi(tile),              &
     &                           xtr_bounds(ng)%UBi(tile),              &
     &                           xtr_bounds(ng)%LBj(tile),              &
     &                           xtr_bounds(ng)%UBj(tile))
#endif
          CALL allocate_forces (ng, lbi, ubi, lbj, ubj)
          CALL allocate_grid (ng, extractflag(ng),                      &
     &                        lbi, ubi, lbj, ubj, lbij, ubij)
#ifdef ICE_MODEL
          CALL allocate_ice (ng, lbi, ubi, lbj, ubj, .true.)
#endif
          CALL allocate_mixing (ng, lbi, ubi, lbj, ubj)
          CALL allocate_ocean (ng, lbi, ubi, lbj, ubj)
#if defined SEDIMENT || defined BBL_MODEL
          CALL allocate_sedbed (ng, lbi, ubi, lbj, ubj)
#endif
#if defined SSH_TIDES || defined UV_TIDES
          CALL allocate_tides (ng, lbi, ubi, lbj, ubj)
#endif
          IF (luvsrc(ng).or.lwsrc(ng).or.any(ltracersrc(:,ng))) THEN
            CALL allocate_sources (ng)
          END IF
!$OMP END MASTER
!$OMP BARRIER
        END DO
 
#ifdef NESTING
!
!  Allocate and initialized contact points boundaty structure. It
!  needs to be delayed to the end because we need "LBC_apply" to
!  allocated in "mod_boundary" for all nested grid.
!
!$OMP MASTER
        CALL allocate_nesting
!$OMP END MASTER
!$OMP BARRIER
#endif
 
#if defined PIO_LIB && defined DISTRIBUTE
!
!  Allocate and initialize PIO single and double precision data
!  decomposition for mapping between computational and I/O processes.
!  It needs to done after all parameters have been allocated and
!  initialize. In particular, we need tidal constituents and state
!  propagator  parameters.
!
        CALL set_iodecomp
#endif
 
        lallocatedmemory=.true.
 
      END IF
 
#ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn off allocation time wall clock.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_off (ng, inlm, 1, __line__, myfile)
        END DO
!$OMP BARRIER
      END DO
#endif
!
      RETURN
      END SUBROUTINE roms_allocate_arrays
!
      SUBROUTINE roms_deallocate_arrays
!
!=======================================================================
!                                                                      !
!  This routine deallocates ROMS state objects, arrays and vectors.    !
!                                                                      !
!=======================================================================
!
      USE mod_param, ONLY : ngrids
!
!  Local variable declarations.
!
      integer :: ng
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", ROMS_deallocate_arrays"
!
!-----------------------------------------------------------------------
!  Deallocate all structures.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
!$OMP MASTER
#if defined AVERAGES    || \
   (defined ad_averages && defined adjoint) || \
   (defined rp_averages && defined tl_ioms) || \
   (defined tl_averages && defined tangent)
        CALL deallocate_average (ng)
#endif
        CALL deallocate_boundary (ng)
#ifdef BBL_MODEL
        CALL deallocate_bbl (ng)
#endif
        IF (lallocateclima.or.lclimatology(ng)) THEN
          CALL deallocate_clima (ng)
        END IF
#ifdef SOLVE3D
        CALL deallocate_coupling (ng)
#endif
#ifdef DIAGNOSTICS
        CALL deallocate_diags (ng)
#endif
#ifdef GRID_EXTRACT
        CALL deallocate_extract (ng)
#endif
        CALL deallocate_forces (ng)
        CALL deallocate_grid (ng)
#ifdef ICE_MODEL
        CALL deallocate_ice (ng)
#endif
        CALL deallocate_mixing (ng)
        CALL deallocate_ocean (ng)
#if defined SEDIMENT || defined BBL_MODEL
        CALL deallocate_sedbed (ng)
#endif
#if defined SSH_TIDES || defined UV_TIDES
        CALL deallocate_tides (ng)
#endif
        IF (luvsrc(ng).or.lwsrc(ng).or.any(ltracersrc(:,ng))) THEN
          CALL deallocate_sources (ng)
        END IF
!$OMP END MASTER
!$OMP BARRIER
      END DO
 
#ifdef NESTING
!
!  Deallocate nesting variables and structures.
!
!$OMP MASTER
      CALL deallocate_nesting
!$OMP END MASTER
!$OMP BARRIER
#endif
 
#if defined FOUR_DVAR || defined VERIFICATION
!
!  Deallocate observations arrays and object.
!
      CALL deallocate_fourdvar
#endif
!
!  Deallocate I/O derived-type structures.
!
      CALL deallocate_iounits
!
!  Deallocate main configuration dimensions and associated parameters.
!
      CALL deallocate_param
!
      RETURN
      END SUBROUTINE roms_deallocate_arrays
!
      SUBROUTINE roms_initialize_arrays
!
!=======================================================================
!                                                                      !
!  This routine initialize ROMS state variables. In shared-memory it   !
!  important for the first-touch policy in memory.                     !
!                                                                      !
!=======================================================================
!
!  Local variable declarations.
!
      integer :: ng, thread, tile
!
      integer, parameter :: model = 0
!
      character (len=*), parameter :: myfile =                          &
     &  __FILE__//", ROMS_initialize_arrays"
 
#ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn on allocation time wall clock.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_on (ng, inlm, 1, __line__, myfile)
        END DO
!$OMP BARRIER
      END DO
#endif
!
!-----------------------------------------------------------------------
!  Intialize variables within structures for each grid.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
#ifdef NESTING
        IF (ng.eq.1) THEN
          CALL initialize_nesting
        END IF
#endif
        DO tile=first_tile(ng),last_tile(ng),+1
#if defined AVERAGES    || \
   (defined ad_averages && defined adjoint) || \
   (defined rp_averages && defined tl_ioms) || \
   (defined tl_averages && defined tangent)
          CALL initialize_average (ng, tile)
#endif
#ifdef BBL_MODEL
          CALL initialize_bbl (ng, tile)
#endif
          CALL initialize_boundary (ng, tile, model)
 
          IF (lallocateclima.or.lclimatology(ng)) THEN
            CALL initialize_clima (ng, tile)
          END IF
#ifdef SOLVE3D
          CALL initialize_coupling (ng, tile, model)
#endif
#ifdef DIAGNOSTICS
          CALL initialize_diags (ng, tile)
#endif
#ifdef GRID_EXTRACT
          CALL initialize_extract (ng, tile, model)
#endif
          CALL initialize_forces (ng, tile, model)
          CALL initialize_grid (ng, tile, model)
#ifdef ICE_MODEL
          CALL initialize_ice (ng, tile, model)
#endif
          CALL initialize_mixing (ng, tile, model)
          CALL initialize_ocean (ng, tile, model)
#if defined SEDIMENT || defined BBL_MODEL
          CALL initialize_sedbed (ng, tile, model)
#endif
#if defined SSH_TIDES || defined UV_TIDES
          CALL initialize_tides (ng, tile)
#endif
        END DO
!$OMP BARRIER
      END DO
 
#if defined FOUR_DVAR || defined VERIFICATION
!
!  Finish allocating observation arrays.  Then, initialize observation
!  arrays. Notice that some of the module variables are allocated in
!  the call to "allocate_fourdvar" in "read_phypar".
!
      CALL initialize_fourdvar
#endif
 
#ifdef PROFILE
!
!-----------------------------------------------------------------------
!  Turn off allocation time wall clock.
!-----------------------------------------------------------------------
!
      DO ng=1,ngrids
        DO thread=thread_range
          CALL wclock_off (ng, inlm, 1, __line__, myfile)
        END DO
!$OMP BARRIER
      END DO
#endif
!
      RETURN
      END SUBROUTINE roms_initialize_arrays
!
      END MODULE mod_arrays