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.
obc_oce.F90 in branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

source: branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90 @ 2865

Last change on this file since 2865 was 2865, checked in by davestorkey, 13 years ago
  1. Updates for dynspg_exp option.
  2. Implement time_offset functionality in obc_dta.
  3. Add option to specify boundaries in the namelist.
  4. Re-activate obc_vol option.
  5. Update to namelist control of tidal harmonics.
  • Property svn:keywords set to Id
File size: 8.4 KB
Line 
1MODULE obc_oce
2   !!======================================================================
3   !!                       ***  MODULE obc_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, J. Chanut) OBC-BDY merge
10   !!----------------------------------------------------------------------
11#if defined key_obc 
12   !!----------------------------------------------------------------------
13   !!   'key_obc'                      Unstructured Open Boundary Condition
14   !!----------------------------------------------------------------------
15   USE par_oce         ! ocean parameters
16   USE obc_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_obc) ::   cn_coords_file !: Name of obc coordinates file
53   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of obc mask file
54   !
55   LOGICAL, DIMENSION(jp_obc) ::   ln_coords_file           !: =T read obc coordinates from file;
56   !                                                        !: =F read obc coordinates from namelist
57   LOGICAL                    ::   ln_mask_file             !: =T read obcmask from file
58   LOGICAL                    ::   ln_vol                   !: =T volume correction             
59   !
60   INTEGER                    ::   nb_obc                   !: number of open boundary sets
61   INTEGER, DIMENSION(jp_obc) ::   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_obc) ::   nn_dyn2d                 ! Choice of boundary condition for barotropic variables (U,V,SSH)
65   INTEGER, DIMENSION(jp_obc) ::   nn_dyn2d_dta           !: = 0 use the initial state as obc 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_obc) ::   nn_dyn3d                 ! Choice of boundary condition for baroclinic velocities
70   INTEGER, DIMENSION(jp_obc) ::   nn_dyn3d_dta           !: = 0 use the initial state as obc dta ;
71                                                            !: = 1 read it in a NetCDF file
72   INTEGER, DIMENSION(jp_obc) ::   nn_tra                   ! Choice of boundary condition for active tracers (T and S)
73   INTEGER, DIMENSION(jp_obc) ::   nn_tra_dta             !: = 0 use the initial state as obc dta ;
74                                                            !: = 1 read it in a NetCDF file
75#if defined key_lim2
76   INTEGER, DIMENSION(jp_obc) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables
77   INTEGER, DIMENSION(jp_obc) ::   nn_ice_lim2_dta          !: = 0 use the initial state as obc dta ;
78                                                            !: = 1 read it in a NetCDF file
79#endif
80   !
81   INTEGER, DIMENSION(jp_obc) ::   nn_dmp2d_in              ! Damping timescale (days) for 2D solution for inward radiation or FRS
82   INTEGER, DIMENSION(jp_obc) ::   nn_dmp2d_out             ! Damping timescale (days) for 2D solution for outward radiation
83   INTEGER, DIMENSION(jp_obc) ::   nn_dmp3d_in              ! Damping timescale (days) for 3D solution for inward radiation or FRS
84   INTEGER, DIMENSION(jp_obc) ::   nn_dmp3d_out             ! Damping timescale (days) for 3D solution for outward radiation
85
86   
87   !!----------------------------------------------------------------------
88   !! Global variables
89   !!----------------------------------------------------------------------
90   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   obctmask   !: Mask defining computational domain at T-points
91   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   obcumask   !: Mask defining computational domain at U-points
92   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   obcvmask   !: Mask defining computational domain at V-points
93
94   REAL(wp)                                    ::   obcsurftot !: Lateral surface of unstructured open boundary
95
96   REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh       !:
97   REAL(wp), POINTER, DIMENSION(:,:)           ::   phur       !:
98   REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr       !: Pointers for barotropic fields
99   REAL(wp), POINTER, DIMENSION(:,:)           ::   pu2d       !:
100   REAL(wp), POINTER, DIMENSION(:,:)           ::   pv2d       !:
101
102   !!----------------------------------------------------------------------
103   !! open boundary data variables
104   !!----------------------------------------------------------------------
105
106   INTEGER,  DIMENSION(jp_obc)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions
107                                                                          !: =1 => some data to be read in from data files
108   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays
109   TYPE(OBC_INDEX), DIMENSION(jp_obc), TARGET      ::   idx_obc           !: obc indices (local process)
110   TYPE(OBC_DATA) , DIMENSION(jp_obc)              ::   dta_obc           !: obc external data (local process)
111
112   !!----------------------------------------------------------------------
113   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
114   !! $Id$
115   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
116   !!----------------------------------------------------------------------
117CONTAINS
118
119   FUNCTION obc_oce_alloc()
120      !!----------------------------------------------------------------------
121      USE lib_mpp, ONLY: ctl_warn, mpp_sum
122      !
123      INTEGER :: obc_oce_alloc
124      !!----------------------------------------------------------------------
125      !
126      ALLOCATE( obctmask(jpi,jpj) , obcumask(jpi,jpj), obcvmask(jpi,jpj),                    & 
127         &      STAT=obc_oce_alloc )
128         !
129      IF( lk_mpp             )   CALL mpp_sum ( obc_oce_alloc )
130      IF( obc_oce_alloc /= 0 )   CALL ctl_warn('obc_oce_alloc: failed to allocate arrays.')
131      !
132   END FUNCTION obc_oce_alloc
133
134#else
135   !!----------------------------------------------------------------------
136   !!   Dummy module                NO Unstructured Open Boundary Condition
137   !!----------------------------------------------------------------------
138   LOGICAL ::   ln_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries
139#endif
140
141   !!======================================================================
142END MODULE obc_oce
143
Note: See TracBrowser for help on using the repository browser.