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 branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90 @ 3191

Last change on this file since 3191 was 3191, checked in by davestorkey, 12 years ago
  1. Bug fix for BDY and fldread.F90.
  2. Update history comments for BDY.
  3. Remove redundant namelist variables in BDY.
  • Property svn:keywords set to Id
File size: 7.9 KB
Line 
1MODULE bdy_oce
2   !!======================================================================
3   !!                       ***  MODULE bdy_oce   ***
4   !! Unstructured Open Boundary Cond. :   define related variables
5   !!======================================================================
6   !! History :  1.0  !  2001-05  (J. Chanut, A. Sellar)  Original code
7   !!            3.0  !  2008-04  (NEMO team)  add in the reference version     
8   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
9   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
10   !!----------------------------------------------------------------------
11#if defined key_bdy 
12   !!----------------------------------------------------------------------
13   !!   'key_bdy'                      Unstructured Open Boundary Condition
14   !!----------------------------------------------------------------------
15   USE par_oce         ! ocean parameters
16   USE bdy_par         ! Unstructured boundary parameters
17   USE lib_mpp         ! distributed memory computing
18
19   IMPLICIT NONE
20   PUBLIC
21
22   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary
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   , POINTER, DIMENSION(:,:)   ::  nbw
30      REAL   , POINTER, DIMENSION(:)     ::  flagu
31      REAL   , POINTER, DIMENSION(:)     ::  flagv
32   END TYPE OBC_INDEX
33
34   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
35      REAL, POINTER, DIMENSION(:)     ::  ssh
36      REAL, POINTER, DIMENSION(:)     ::  u2d
37      REAL, POINTER, DIMENSION(:)     ::  v2d
38      REAL, POINTER, DIMENSION(:,:)   ::  u3d
39      REAL, POINTER, DIMENSION(:,:)   ::  v3d
40      REAL, POINTER, DIMENSION(:,:)   ::  tem
41      REAL, POINTER, DIMENSION(:,:)   ::  sal
42#if defined key_lim2
43      REAL, POINTER, DIMENSION(:)     ::  frld
44      REAL, POINTER, DIMENSION(:)     ::  hicif
45      REAL, POINTER, DIMENSION(:)     ::  hsnif
46#endif
47   END TYPE OBC_DATA
48
49   !!----------------------------------------------------------------------
50   !! Namelist variables
51   !!----------------------------------------------------------------------
52   CHARACTER(len=80), DIMENSION(jp_bdy) ::   cn_coords_file !: Name of bdy coordinates file
53   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of bdy mask file
54   !
55   LOGICAL, DIMENSION(jp_bdy) ::   ln_coords_file           !: =T read bdy coordinates from file;
56   !                                                        !: =F read bdy coordinates from namelist
57   LOGICAL                    ::   ln_mask_file             !: =T read bdymask from file
58   LOGICAL                    ::   ln_vol                   !: =T volume correction             
59   !
60   INTEGER                    ::   nb_bdy                   !: number of open boundary sets
61   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme
62   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P
63   !                                                        !  = 1 the volume will be constant during all the integration.
64   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d                 ! Choice of boundary condition for barotropic variables (U,V,SSH)
65   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d_dta           !: = 0 use the initial state as bdy dta ;
66                                                            !: = 1 read it in a NetCDF file
67                                                            !: = 2 read tidal harmonic forcing from a NetCDF file
68                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files
69   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d                 ! Choice of boundary condition for baroclinic velocities
70   INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d_dta           !: = 0 use the initial state as bdy dta ;
71                                                            !: = 1 read it in a NetCDF file
72   INTEGER, DIMENSION(jp_bdy) ::   nn_tra                   ! Choice of boundary condition for active tracers (T and S)
73   INTEGER, DIMENSION(jp_bdy) ::   nn_tra_dta             !: = 0 use the initial state as bdy dta ;
74                                                            !: = 1 read it in a NetCDF file
75#if defined key_lim2
76   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables
77   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2_dta          !: = 0 use the initial state as bdy dta ;
78                                                            !: = 1 read it in a NetCDF file
79#endif
80   !
81   
82   !!----------------------------------------------------------------------
83   !! Global variables
84   !!----------------------------------------------------------------------
85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdytmask   !: Mask defining computational domain at T-points
86   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyumask   !: Mask defining computational domain at U-points
87   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyvmask   !: Mask defining computational domain at V-points
88
89   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary
90
91   REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh       !:
92   REAL(wp), POINTER, DIMENSION(:,:)           ::   phur       !:
93   REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr       !: Pointers for barotropic fields
94   REAL(wp), POINTER, DIMENSION(:,:)           ::   pu2d       !:
95   REAL(wp), POINTER, DIMENSION(:,:)           ::   pv2d       !:
96
97   !!----------------------------------------------------------------------
98   !! open boundary data variables
99   !!----------------------------------------------------------------------
100
101   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions
102                                                                          !: =1 => some data to be read in from data files
103   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays
104   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
105   TYPE(OBC_DATA) , DIMENSION(jp_bdy)              ::   dta_bdy           !: bdy external data (local process)
106
107   !!----------------------------------------------------------------------
108   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
109   !! $Id$
110   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
111   !!----------------------------------------------------------------------
112CONTAINS
113
114   FUNCTION bdy_oce_alloc()
115      !!----------------------------------------------------------------------
116      USE lib_mpp, ONLY: ctl_warn, mpp_sum
117      !
118      INTEGER :: bdy_oce_alloc
119      !!----------------------------------------------------------------------
120      !
121      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),                    & 
122         &      STAT=bdy_oce_alloc )
123         !
124      IF( lk_mpp             )   CALL mpp_sum ( bdy_oce_alloc )
125      IF( bdy_oce_alloc /= 0 )   CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.')
126      !
127   END FUNCTION bdy_oce_alloc
128
129#else
130   !!----------------------------------------------------------------------
131   !!   Dummy module                NO Unstructured Open Boundary Condition
132   !!----------------------------------------------------------------------
133   LOGICAL ::   ln_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries
134#endif
135
136   !!======================================================================
137END MODULE bdy_oce
138
Note: See TracBrowser for help on using the repository browser.