New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bdy_oce.F90 in NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/BDY – NEMO

source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/BDY/bdy_oce.F90 @ 10297

Last change on this file since 10297 was 10297, checked in by smasson, 5 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2a: add report calls of mppmin/max/sum, see #2133

  • Property svn:keywords set to Id
File size: 10.5 KB
RevLine 
[911]1MODULE bdy_oce
2   !!======================================================================
3   !!                       ***  MODULE bdy_oce   ***
4   !! Unstructured Open Boundary Cond. :   define related variables
5   !!======================================================================
[1125]6   !! History :  1.0  !  2001-05  (J. Chanut, A. Sellar)  Original code
7   !!            3.0  !  2008-04  (NEMO team)  add in the reference version     
[2528]8   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
[3294]9   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
[9656]10   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for new model
11   !!            4.0  !  2018     (C. Rousset) SI3 compatibility
[911]12   !!----------------------------------------------------------------------
13   USE par_oce         ! ocean parameters
[2715]14   USE lib_mpp         ! distributed memory computing
[911]15
16   IMPLICIT NONE
17   PUBLIC
18
[7646]19   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets
20   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V)
21
[3294]22   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary
[5836]23      INTEGER ,          DIMENSION(jpbgrd) ::  nblen
24      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim
25      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi
26      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj
27      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr
28      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap
29      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw
30      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd
31      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout
32      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu
33      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv
[3294]34   END TYPE OBC_INDEX
35
[4292]36   !! Logicals in OBC_DATA structure are true if the chosen algorithm requires this
37   !! field as external data. If true the data can come from external files
38   !! or model initial conditions. If false then no "external" data array
39   !! is required for this field.
40
[3294]41   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
[5836]42      INTEGER          , DIMENSION(2)   ::  nread
43      LOGICAL                           ::  ll_ssh
44      LOGICAL                           ::  ll_u2d
45      LOGICAL                           ::  ll_v2d
46      LOGICAL                           ::  ll_u3d
47      LOGICAL                           ::  ll_v3d
48      LOGICAL                           ::  ll_tem
49      LOGICAL                           ::  ll_sal
[7646]50      LOGICAL                           ::  ll_fvl
[5836]51      REAL(wp), POINTER, DIMENSION(:)   ::  ssh
52      REAL(wp), POINTER, DIMENSION(:)   ::  u2d
53      REAL(wp), POINTER, DIMENSION(:)   ::  v2d
54      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d
55      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d
56      REAL(wp), POINTER, DIMENSION(:,:) ::  tem
57      REAL(wp), POINTER, DIMENSION(:,:) ::  sal
[9570]58#if defined key_si3
[5836]59      LOGICAL                           ::   ll_a_i
[9019]60      LOGICAL                           ::   ll_h_i
61      LOGICAL                           ::   ll_h_s
[5836]62      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology
[9019]63      REAL(wp), POINTER, DIMENSION(:,:) ::   h_i    !: Now ice  thickness climatology
64      REAL(wp), POINTER, DIMENSION(:,:) ::   h_s    !: now snow thickness
[3294]65#endif
[6140]66#if defined key_top
67      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply
68      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor
69      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer
70      LOGICAL                             :: dmp     !: obc damping term
71#endif
[3294]72   END TYPE OBC_DATA
73
[911]74   !!----------------------------------------------------------------------
75   !! Namelist variables
76   !!----------------------------------------------------------------------
[7646]77   LOGICAL, PUBLIC            ::   ln_bdy                   !: Unstructured Ocean Boundary Condition
78
[3294]79   CHARACTER(len=80), DIMENSION(jp_bdy) ::   cn_coords_file !: Name of bdy coordinates file
80   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of bdy mask file
[1125]81   !
[3294]82   LOGICAL, DIMENSION(jp_bdy) ::   ln_coords_file           !: =T read bdy coordinates from file;
83   !                                                        !: =F read bdy coordinates from namelist
84   LOGICAL                    ::   ln_mask_file             !: =T read bdymask from file
85   LOGICAL                    ::   ln_vol                   !: =T volume correction             
[1125]86   !
[3294]87   INTEGER                    ::   nb_bdy                   !: number of open boundary sets
[7646]88   INTEGER                    ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run)
[3294]89   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme
90   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P
91   !                                                        !  = 1 the volume will be constant during all the integration.
[4292]92   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn2d       ! Choice of boundary condition for barotropic variables (U,V,SSH)
93   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn2d_dta   !: = 0 use the initial state as bdy dta ;
[3294]94                                                            !: = 1 read it in a NetCDF file
95                                                            !: = 2 read tidal harmonic forcing from a NetCDF file
96                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files
[4292]97   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn3d       ! Choice of boundary condition for baroclinic velocities
98   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn3d_dta   !: = 0 use the initial state as bdy dta ;
[3294]99                                                            !: = 1 read it in a NetCDF file
[4292]100   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_tra         ! Choice of boundary condition for active tracers (T and S)
101   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ;
[3294]102                                                            !: = 1 read it in a NetCDF file
[5836]103   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping
104   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping
105   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp             !: Damping time scale in days
106   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp_out         !: Damping time scale in days at radiation outflow points
[3651]107
[9657]108   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice         ! Choice of boundary condition for sea ice variables
109   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_dta     !: = 0 use the initial state as bdy dta ;
110                                                            !: = 1 read it in a NetCDF file
[5836]111   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice
112   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice
113   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice
[3294]114   !
115   
[911]116   !!----------------------------------------------------------------------
117   !! Global variables
118   !!----------------------------------------------------------------------
[4292]119   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdytmask   !: Mask defining computational domain at T-points
120   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyumask   !: Mask defining computational domain at U-points
121   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyvmask   !: Mask defining computational domain at V-points
[911]122
[3294]123   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary
124
[911]125   !!----------------------------------------------------------------------
[3294]126   !! open boundary data variables
[911]127   !!----------------------------------------------------------------------
128
[3294]129   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions
130                                                                          !: =1 => some data to be read in from data files
[3651]131   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy)
[7646]132   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_z      !: workspace for reading in global depth arrays (unstr.  bdy)
133   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_dz     !: workspace for reading in global depth arrays (unstr.  bdy)
[3651]134   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy)
[7646]135   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_z     !: workspace for reading in global depth arrays (struct. bdy)
136   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_dz    !: workspace for reading in global depth arrays (struct. bdy)
[4354]137!$AGRIF_DO_NOT_TREAT
[3294]138   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
[4292]139   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process)
[4354]140!$AGRIF_END_DO_NOT_TREAT
[2715]141   !!----------------------------------------------------------------------
[9598]142   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2715]143   !! $Id$
[10068]144   !! Software governed by the CeCILL license (see ./LICENSE)
[2715]145   !!----------------------------------------------------------------------
146CONTAINS
147
148   FUNCTION bdy_oce_alloc()
149      !!----------------------------------------------------------------------
150      USE lib_mpp, ONLY: ctl_warn, mpp_sum
151      !
152      INTEGER :: bdy_oce_alloc
153      !!----------------------------------------------------------------------
154      !
[4292]155      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),     & 
[3294]156         &      STAT=bdy_oce_alloc )
[4354]157      !
158      ! Initialize masks
[7753]159      bdytmask(:,:) = 1._wp
160      bdyumask(:,:) = 1._wp
161      bdyvmask(:,:) = 1._wp
[4354]162      !
[10297]163      IF( lk_mpp             )   CALL mpp_sum ( 'bdy_oce', bdy_oce_alloc )
[2715]164      IF( bdy_oce_alloc /= 0 )   CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.')
165      !
166   END FUNCTION bdy_oce_alloc
167
[911]168   !!======================================================================
169END MODULE bdy_oce
[3294]170
Note: See TracBrowser for help on using the repository browser.