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.
Changeset 11536 for NEMO/trunk/src/OCE/BDY/bdy_oce.F90 – NEMO

Ignore:
Timestamp:
2019-09-11T15:54:18+02:00 (5 years ago)
Author:
smasson
Message:

trunk: merge dev_r10984_HPC-13 into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/BDY/bdy_oce.F90

    r10934 r11536  
    2222      INTEGER ,          DIMENSION(jpbgrd) ::  nblen 
    2323      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim 
     24      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim0 
    2425      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi 
    2526      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj 
    2627      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr 
    2728      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap 
     29      INTEGER , POINTER, DIMENSION(:,:)    ::  ntreat 
    2830      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw 
    2931      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd 
     
    4042   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
    4143      INTEGER          , DIMENSION(2)   ::  nread 
    42       LOGICAL                           ::  ll_ssh 
    43       LOGICAL                           ::  ll_u2d 
    44       LOGICAL                           ::  ll_v2d 
    45       LOGICAL                           ::  ll_u3d 
    46       LOGICAL                           ::  ll_v3d 
    47       LOGICAL                           ::  ll_tem 
    48       LOGICAL                           ::  ll_sal 
    49       LOGICAL                           ::  ll_fvl 
     44      LOGICAL                           ::  lneed_ssh 
     45      LOGICAL                           ::  lneed_dyn2d 
     46      LOGICAL                           ::  lneed_dyn3d 
     47      LOGICAL                           ::  lneed_tra 
     48      LOGICAL                           ::  lneed_ice 
    5049      REAL(wp), POINTER, DIMENSION(:)   ::  ssh 
    5150      REAL(wp), POINTER, DIMENSION(:)   ::  u2d 
     
    5554      REAL(wp), POINTER, DIMENSION(:,:) ::  tem 
    5655      REAL(wp), POINTER, DIMENSION(:,:) ::  sal 
    57 #if defined key_si3 
    58       LOGICAL                           ::   ll_a_i 
    59       LOGICAL                           ::   ll_h_i 
    60       LOGICAL                           ::   ll_h_s 
    61       REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology 
    62       REAL(wp), POINTER, DIMENSION(:,:) ::   h_i    !: Now ice  thickness climatology 
    63       REAL(wp), POINTER, DIMENSION(:,:) ::   h_s    !: now snow thickness 
    64 #endif 
     56      REAL(wp), POINTER, DIMENSION(:,:) ::  a_i    !: now ice leads fraction climatology 
     57      REAL(wp), POINTER, DIMENSION(:,:) ::  h_i    !: Now ice  thickness climatology 
     58      REAL(wp), POINTER, DIMENSION(:,:) ::  h_s    !: now snow thickness 
     59      REAL(wp), POINTER, DIMENSION(:,:) ::  t_i    !: now ice  temperature 
     60      REAL(wp), POINTER, DIMENSION(:,:) ::  t_s    !: now snow temperature 
     61      REAL(wp), POINTER, DIMENSION(:,:) ::  tsu    !: now surf temperature 
     62      REAL(wp), POINTER, DIMENSION(:,:) ::  s_i    !: now ice  salinity 
     63      REAL(wp), POINTER, DIMENSION(:,:) ::  aip    !: now ice  pond concentration 
     64      REAL(wp), POINTER, DIMENSION(:,:) ::  hip    !: now ice  pond depth 
    6565#if defined key_top 
    6666      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply 
     
    7474   !! Namelist variables 
    7575   !!---------------------------------------------------------------------- 
     76   !                                                   !!** nambdy ** 
    7677   LOGICAL, PUBLIC            ::   ln_bdy                   !: Unstructured Ocean Boundary Condition 
    7778 
     
    8586   ! 
    8687   INTEGER                    ::   nb_bdy                   !: number of open boundary sets 
    87    INTEGER, DIMENSION(jp_bdy) ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run) 
    8888   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme 
    8989   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
     
    108108   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_dta     !: = 0 use the initial state as bdy dta ;  
    109109                                                            !: = 1 read it in a NetCDF file 
    110    REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice 
    111    REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice 
    112    REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice 
     110   !  
     111   !                                                   !!** nambdy_dta ** 
     112   REAL(wp), DIMENSION(jp_bdy) ::   rice_tem                !: temperature of incoming sea ice 
     113   REAL(wp), DIMENSION(jp_bdy) ::   rice_sal                !: salinity    of incoming sea ice 
     114   REAL(wp), DIMENSION(jp_bdy) ::   rice_age                !: age         of incoming sea ice 
     115   REAL(wp), DIMENSION(jp_bdy) ::   rice_apnd               !: pond conc.  of incoming sea ice 
     116   REAL(wp), DIMENSION(jp_bdy) ::   rice_hpnd               !: pond thick. of incoming sea ice 
    113117   ! 
    114     
    115118   !!---------------------------------------------------------------------- 
    116119   !! Global variables 
     
    128131   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions 
    129132                                                                          !: =1 => some data to be read in from data files 
    130    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy) 
    131    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_z      !: workspace for reading in global depth arrays (unstr.  bdy) 
    132    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_dz     !: workspace for reading in global depth arrays (unstr.  bdy) 
    133    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy) 
    134    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_z     !: workspace for reading in global depth arrays (struct. bdy) 
    135    REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_dz    !: workspace for reading in global depth arrays (struct. bdy) 
    136133!$AGRIF_DO_NOT_TREAT 
    137134   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    138135   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
    139136!$AGRIF_END_DO_NOT_TREAT 
     137   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdy      !: mark needed communication for given boundary, grid and neighbour 
     138   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdy      !:  when searching in any direction 
     139   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyint   !: mark needed communication for given boundary, grid and neighbour 
     140   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyint   !:  when searching towards the interior of the computational domain 
     141   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyext   !: mark needed communication for given boundary, grid and neighbour 
     142   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyext   !:  when searching towards the exterior of the computational domain 
    140143   !!---------------------------------------------------------------------- 
    141144   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
Note: See TracChangeset for help on using the changeset viewer.