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 4223 – NEMO

Changeset 4223


Ignore:
Timestamp:
2013-11-15T18:21:46+01:00 (10 years ago)
Author:
cbricaud
Message:

Merge Time splitting update with BDY developments

Location:
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC
Files:
13 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r3651 r4223  
    2929      REAL   , POINTER, DIMENSION(:,:)   ::  nbw 
    3030      REAL   , POINTER, DIMENSION(:,:)   ::  nbd 
    31       REAL   , POINTER, DIMENSION(:)     ::  flagu 
    32       REAL   , POINTER, DIMENSION(:)     ::  flagv 
     31      REAL   , POINTER, DIMENSION(:,:)   ::  nbdout 
     32      REAL   , POINTER, DIMENSION(:,:)   ::  flagu 
     33      REAL   , POINTER, DIMENSION(:,:)   ::  flagv 
    3334   END TYPE OBC_INDEX 
    3435 
     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 
    3541   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
     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 
    3650      REAL, POINTER, DIMENSION(:)     ::  ssh 
    3751      REAL, POINTER, DIMENSION(:)     ::  u2d 
     
    4256      REAL, POINTER, DIMENSION(:,:)   ::  sal 
    4357#if defined key_lim2 
     58      LOGICAL                         ::  ll_frld 
     59      LOGICAL                         ::  ll_hicif 
     60      LOGICAL                         ::  ll_hsnif 
    4461      REAL, POINTER, DIMENSION(:)     ::  frld 
    4562      REAL, POINTER, DIMENSION(:)     ::  hicif 
     
    6380   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
    6481   !                                                        !  = 1 the volume will be constant during all the integration. 
    65    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d                 ! Choice of boundary condition for barotropic variables (U,V,SSH) 
    66    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d_dta           !: = 0 use the initial state as bdy dta ;  
     82   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn2d       ! Choice of boundary condition for barotropic variables (U,V,SSH) 
     83   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn2d_dta   !: = 0 use the initial state as bdy dta ;  
    6784                                                            !: = 1 read it in a NetCDF file 
    6885                                                            !: = 2 read tidal harmonic forcing from a NetCDF file 
    6986                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files 
    70    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d                 ! Choice of boundary condition for baroclinic velocities  
    71    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d_dta           !: = 0 use the initial state as bdy dta ;  
     87   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn3d       ! Choice of boundary condition for baroclinic velocities  
     88   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn3d_dta   !: = 0 use the initial state as bdy dta ;  
    7289                                                            !: = 1 read it in a NetCDF file 
    73    INTEGER, DIMENSION(jp_bdy) ::   nn_tra                   ! Choice of boundary condition for active tracers (T and S) 
    74    INTEGER, DIMENSION(jp_bdy) ::   nn_tra_dta             !: = 0 use the initial state as bdy dta ;  
     90   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_tra         ! Choice of boundary condition for active tracers (T and S) 
     91   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ;  
    7592                                                            !: = 1 read it in a NetCDF file 
    7693   LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping 
    7794   LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping 
    7895   REAL,    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days 
     96   REAL,    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points 
    7997 
    8098#if defined key_lim2 
    81    INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables  
    82    INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2_dta          !: = 0 use the initial state as bdy dta ;  
    83                                                             !: = 1 read it in a NetCDF file 
     99   CHARACTER(len=20), DIMENSION(jp_bdy) ::   nn_ice_lim2      ! Choice of boundary condition for sea ice variables  
     100   INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim2_dta  !: = 0 use the initial state as bdy dta ;  
     101                                                              !: = 1 read it in a NetCDF file 
    84102#endif 
    85103   ! 
     
    88106   !! Global variables 
    89107   !!---------------------------------------------------------------------- 
    90    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdytmask   !: Mask defining computational domain at T-points 
    91    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyumask   !: Mask defining computational domain at U-points 
    92    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyvmask   !: Mask defining computational domain at V-points 
     108   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdytmask   !: Mask defining computational domain at T-points 
     109   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyumask   !: Mask defining computational domain at U-points 
     110   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyvmask   !: Mask defining computational domain at V-points 
    93111 
    94112   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary 
    95113 
    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       !:  
     114   REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh                  !:  
     115   REAL(wp), POINTER, DIMENSION(:,:)           ::   phur                  !:  
     116   REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr                  !: Pointers for barotropic fields  
     117   REAL(wp), POINTER, DIMENSION(:,:)           ::   pub2d, pun2d, pua2d   !:  
     118   REAL(wp), POINTER, DIMENSION(:,:)           ::   pvb2d, pvn2d, pva2d   !:  
    101119 
    102120   !!---------------------------------------------------------------------- 
     
    109127   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy) 
    110128   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    111    TYPE(OBC_DATA) , DIMENSION(jp_bdy)              ::   dta_bdy           !: bdy external data (local process) 
     129   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
    112130 
    113131   !!---------------------------------------------------------------------- 
     
    125143      !!---------------------------------------------------------------------- 
    126144      ! 
    127       ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),                     
     145      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),      
    128146         &      STAT=bdy_oce_alloc ) 
    129147         ! 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90

    r3294 r4223  
    2323# endif 
    2424   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets 
    25    INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file 
    2625   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V) 
    2726 
    28    !! Flags for choice of schemes 
    29    INTEGER, PUBLIC, PARAMETER ::   jp_none         = 0        !: Flag for no open boundary condition 
    30    INTEGER, PUBLIC, PARAMETER ::   jp_frs          = 1        !: Flag for Flow Relaxation Scheme 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_flather      = 2        !: Flag for Flather 
    3227#else 
    3328   !!---------------------------------------------------------------------- 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r3970 r4223  
    8484      INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
    8585      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
     86      TYPE(OBC_DATA), POINTER             ::   dta              ! short cut 
    8687      !! 
    8788      !!--------------------------------------------------------------------------- 
     
    9596         ! Calculate depth-mean currents 
    9697         !----------------------------- 
    97          CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
    98  
    99          pu2d(:,:) = 0.e0 
    100          pv2d(:,:) = 0.e0 
    101  
     98         CALL wrk_alloc(jpi,jpj,pun2d,pvn2d)  
     99 
     100         pun2d(:,:) = 0.e0 
     101         pvn2d(:,:) = 0.e0 
    102102         DO ik = 1, jpkm1   !! Vertically integrated momentum trends 
    103              pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
    104              pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
     103             pun2d(:,:) = pun2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
     104             pvn2d(:,:) = pvn2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
    105105         END DO 
    106          pu2d(:,:) = pu2d(:,:) * hur(:,:) 
    107          pv2d(:,:) = pv2d(:,:) * hvr(:,:) 
     106         pun2d(:,:) = pun2d(:,:) * hur(:,:) 
     107         pvn2d(:,:) = pvn2d(:,:) * hvr(:,:) 
    108108          
    109109         DO ib_bdy = 1, nb_bdy 
     
    111111            nblen => idx_bdy(ib_bdy)%nblen 
    112112            nblenrim => idx_bdy(ib_bdy)%nblenrim 
    113  
    114             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
     113            dta => dta_bdy(ib_bdy) 
     114 
     115            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
    115116               ilen1(:) = nblen(:) 
    116                igrd = 1 
    117                DO ib = 1, ilen1(igrd) 
    118                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    119                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    120                   dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
    121                END DO  
    122                igrd = 2 
    123                DO ib = 1, ilen1(igrd) 
    124                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    125                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    126                   dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1)          
    127                END DO  
    128                igrd = 3 
    129                DO ib = 1, ilen1(igrd) 
    130                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    131                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    132                   dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1)          
    133                END DO  
    134             ENDIF 
    135  
    136             IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
    137                ilen1(:) = nblen(:) 
    138                igrd = 2  
    139                DO ib = 1, ilen1(igrd) 
    140                   DO ik = 1, jpkm1 
     117               IF( dta%ll_ssh ) THEN  
     118                  igrd = 1 
     119                  DO ib = 1, ilen1(igrd) 
    141120                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    142121                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    143                      dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)          
    144                   END DO 
    145                END DO  
    146                igrd = 3  
    147                DO ib = 1, ilen1(igrd) 
    148                   DO ik = 1, jpkm1 
     122                     dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
     123                  END DO  
     124               END IF 
     125               IF( dta%ll_u2d ) THEN  
     126                  igrd = 2 
     127                  DO ib = 1, ilen1(igrd) 
    149128                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    150129                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    151                      dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik)          
    152                      END DO 
    153                END DO  
    154             ENDIF 
    155  
    156             IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
    157                ilen1(:) = nblen(:) 
    158                igrd = 1                       ! Everything is at T-points here 
    159                DO ib = 1, ilen1(igrd) 
    160                   DO ik = 1, jpkm1 
     130                     dta_bdy(ib_bdy)%u2d(ib) = pun2d(ii,ij) * umask(ii,ij,1)          
     131                  END DO  
     132               END IF 
     133               IF( dta%ll_v2d ) THEN  
     134                  igrd = 3 
     135                  DO ib = 1, ilen1(igrd) 
    161136                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    162137                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    163                      dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
    164                      dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
    165                   END DO 
    166                END DO  
     138                     dta_bdy(ib_bdy)%v2d(ib) = pvn2d(ii,ij) * vmask(ii,ij,1)          
     139                  END DO  
     140               END IF 
     141            ENDIF 
     142 
     143            IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
     144               ilen1(:) = nblen(:) 
     145               IF( dta%ll_u3d ) THEN  
     146                  igrd = 2  
     147                  DO ib = 1, ilen1(igrd) 
     148                     DO ik = 1, jpkm1 
     149                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     150                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     151                        dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pun2d(ii,ij) ) * umask(ii,ij,ik)          
     152                     END DO 
     153                  END DO  
     154               END IF 
     155               IF( dta%ll_v3d ) THEN  
     156                  igrd = 3  
     157                  DO ib = 1, ilen1(igrd) 
     158                     DO ik = 1, jpkm1 
     159                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     160                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     161                        dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pvn2d(ii,ij) ) * vmask(ii,ij,ik)          
     162                        END DO 
     163                  END DO  
     164               END IF 
     165            ENDIF 
     166 
     167            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
     168               ilen1(:) = nblen(:) 
     169               IF( dta%ll_tem ) THEN 
     170                  igrd = 1  
     171                  DO ib = 1, ilen1(igrd) 
     172                     DO ik = 1, jpkm1 
     173                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     174                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     175                        dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
     176                     END DO 
     177                  END DO  
     178               END IF 
     179               IF( dta%ll_sal ) THEN 
     180                  igrd = 1  
     181                  DO ib = 1, ilen1(igrd) 
     182                     DO ik = 1, jpkm1 
     183                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     184                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     185                        dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
     186                     END DO 
     187                  END DO  
     188               END IF 
    167189            ENDIF 
    168190 
    169191#if defined key_lim2 
    170             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
     192            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
    171193               ilen1(:) = nblen(:) 
    172                igrd = 1                       ! Everything is at T-points here 
    173                DO ib = 1, ilen1(igrd) 
    174                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    175                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    176                   dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
    177                   dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
    178                   dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
    179                END DO  
     194               IF( dta%ll_frld ) THEN 
     195                  igrd = 1  
     196                  DO ib = 1, ilen1(igrd) 
     197                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     198                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     199                     dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
     200                  END DO  
     201               END IF 
     202               IF( dta%ll_hicif ) THEN 
     203                  igrd = 1  
     204                  DO ib = 1, ilen1(igrd) 
     205                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     206                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     207                     dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
     208                  END DO  
     209               END IF 
     210               IF( dta%ll_hsnif ) THEN 
     211                  igrd = 1  
     212                  DO ib = 1, ilen1(igrd) 
     213                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     214                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     215                     dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
     216                  END DO  
     217               END IF 
    180218            ENDIF 
    181219#endif 
     
    183221         ENDDO ! ib_bdy 
    184222 
    185          CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     223         CALL wrk_dealloc(jpi,jpj,pun2d,pvn2d)  
    186224 
    187225      ENDIF ! kt .eq. nit000 
     
    192230      jstart = 1 
    193231      DO ib_bdy = 1, nb_bdy    
     232         dta => dta_bdy(ib_bdy) 
    194233         IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 
    195234       
     
    197236               ! Update barotropic boundary conditions only 
    198237               ! jit is optional argument for fld_read and bdytide_update 
    199                IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     238               IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    200239                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    201                      dta_bdy(ib_bdy)%ssh(:) = 0.0 
    202                      dta_bdy(ib_bdy)%u2d(:) = 0.0 
    203                      dta_bdy(ib_bdy)%v2d(:) = 0.0 
     240                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
     241                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
     242                     IF( dta%ll_u3d ) dta%v2d(:) = 0.0 
    204243                  ENDIF 
    205                   IF (nn_tra(ib_bdy).ne.4) THEN 
    206                      IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
    207                        & (ln_full_vel_array(ib_bdy) .AND. nn_dyn3d_dta(ib_bdy).eq.1) )THEN 
    208  
    209                         ! For the runoff case, no need to update the forcing (already done in the baroclinic part) 
    210                         jend = nb_bdy_fld(ib_bdy) 
    211                         IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2 
     244                  IF (cn_tra(ib_bdy) /= 'runoff') THEN 
     245                     IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN 
     246 
     247                        jend = jstart + dta%nread(2) - 1 
    212248                        CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    213249                                     & kit=jit, kt_offset=time_offset ) 
    214                         IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2 
    215  
    216                         ! If full velocities in boundary data then split into barotropic and baroclinic data 
     250 
     251                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields 
    217252                        IF( ln_full_vel_array(ib_bdy) .AND.                                             & 
    218253                          &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
     
    220255 
    221256                           igrd = 2                      ! zonal velocity 
    222                            dta_bdy(ib_bdy)%u2d(:) = 0.0 
     257                           dta%u2d(:) = 0.0 
    223258                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    224259                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    225260                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    226261                              DO ik = 1, jpkm1 
    227                                  dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 
    228                        &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 
     262                                 dta%u2d(ib) = dta%u2d(ib) & 
     263                       &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    229264                              END DO 
    230                               dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 
    231                               DO ik = 1, jpkm1 
    232                                  dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
    233                               END DO 
     265                              dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
    234266                           END DO 
    235267                           igrd = 3                      ! meridional velocity 
    236                            dta_bdy(ib_bdy)%v2d(:) = 0.0 
     268                           dta%v2d(:) = 0.0 
    237269                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    238270                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    239271                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    240272                              DO ik = 1, jpkm1 
    241                                  dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 
    242                        &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 
     273                                 dta%v2d(ib) = dta%v2d(ib) & 
     274                       &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    243275                              END DO 
    244                               dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 
    245                               DO ik = 1, jpkm1 
    246                                  dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
    247                               END DO 
     276                              dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
    248277                           END DO 
    249278                        ENDIF                     
    250279                     ENDIF 
    251280                     IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
    252                         CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy),   &  
     281                        CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta, td=tides(ib_bdy),   &  
    253282                          &                 jit=jit, time_offset=time_offset ) 
    254283                     ENDIF 
     
    256285               ENDIF 
    257286            ELSE 
    258                IF (nn_tra(ib_bdy).eq.4) then      ! runoff condition 
     287               IF (cn_tra(ib_bdy) == 'runoff') then      ! runoff condition 
    259288                  jend = nb_bdy_fld(ib_bdy) 
    260289                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  & 
     
    265294                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    266295                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    267                      dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
     296                     dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
    268297                  END DO 
    269298                  ! 
     
    272301                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    273302                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    274                      dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
     303                     dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
    275304                  END DO 
    276305               ELSE 
    277                   IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    278                      dta_bdy(ib_bdy)%ssh(:) = 0.0 
    279                      dta_bdy(ib_bdy)%u2d(:) = 0.0 
    280                      dta_bdy(ib_bdy)%v2d(:) = 0.0 
     306                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     307                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
     308                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
     309                     IF( dta%ll_v2d ) dta%v2d(:) = 0.0 
    281310                  ENDIF 
    282                   IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data 
    283                      jend = nb_bdy_fld(ib_bdy) 
     311                  IF( dta%nread(1) .gt. 0 ) THEN ! update external data 
     312                     jend = jstart + dta%nread(1) - 1 
    284313                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    285314                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 
     
    290319                    &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN 
    291320                     igrd = 2                      ! zonal velocity 
    292                      dta_bdy(ib_bdy)%u2d(:) = 0.0 
     321                     dta%u2d(:) = 0.0 
    293322                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    294323                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    295324                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    296325                        DO ik = 1, jpkm1 
    297                            dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 
    298                  &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 
     326                           dta%u2d(ib) = dta%u2d(ib) & 
     327                 &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    299328                        END DO 
    300                         dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 
     329                        dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
    301330                        DO ik = 1, jpkm1 
    302                            dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
     331                           dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
    303332                        END DO 
    304333                     END DO 
    305334                     igrd = 3                      ! meridional velocity 
    306                      dta_bdy(ib_bdy)%v2d(:) = 0.0 
     335                     dta%v2d(:) = 0.0 
    307336                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    308337                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    309338                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    310339                        DO ik = 1, jpkm1 
    311                            dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 
    312                  &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 
     340                           dta%v2d(ib) = dta%v2d(ib) & 
     341                 &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    313342                        END DO 
    314                         dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 
     343                        dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
    315344                        DO ik = 1, jpkm1 
    316                            dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
     345                           dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 
    317346                        END DO 
    318347                     END DO 
    319348                  ENDIF 
    320                   ! bg jchanut tschanges 
    321                   !IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
    322                   !   CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy),  & 
    323                   !                      & td=tides(ib_bdy), time_offset=time_offset ) 
    324                   !ENDIF 
    325                   ! end jchanut tschanges 
    326                ENDIF 
    327             ENDIF 
    328             jstart = jend+1 
     349 
     350               ENDIF 
     351            ENDIF 
     352            jstart = jstart + dta%nread(1) 
    329353         END IF ! nn_dta(ib_bdy) = 1 
    330354      END DO  ! ib_bdy 
     
    339363      IF ( ln_apr_obc ) THEN 
    340364         DO ib_bdy = 1, nb_bdy 
    341             IF (nn_tra(ib_bdy).NE.4)THEN 
     365            IF (cn_tra(ib_bdy) /= 'runoff')THEN 
    342366               igrd = 1                      ! meridional velocity 
    343367               DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     
    362386      !!                for open boundary conditions 
    363387      !! 
    364       !! ** Method  :   Use fldread.F90 
     388      !! ** Method  :    
    365389      !!                 
    366390      !!---------------------------------------------------------------------- 
     
    374398                                                                ! =F => baroclinic velocities in 3D boundary data 
    375399      INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays 
    376       INTEGER,              DIMENSION(jpbgrd) ::  ilen0         ! size of local arrays 
    377400      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays 
    378401      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld 
    379402      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V) 
    380403      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts 
     404      TYPE(OBC_DATA), POINTER                ::   dta           ! short cut 
    381405      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures 
    382406      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
     
    416440      nb_bdy_fld(:) = 0 
    417441      DO ib_bdy = 1, nb_bdy          
    418          IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
     442         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
    419443            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    420444         ENDIF 
    421          IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
     445         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
    422446            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    423447         ENDIF 
    424          IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
     448         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
    425449            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    426450         ENDIF 
    427451#if defined key_lim2 
    428          IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
     452         IF( cn_ice_lim2(ib_bdy) /= 'none' .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
    429453            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    430454         ENDIF 
     
    484508            nblen => idx_bdy(ib_bdy)%nblen 
    485509            nblenrim => idx_bdy(ib_bdy)%nblenrim 
     510            dta => dta_bdy(ib_bdy) 
     511            dta%nread(2) = 0 
    486512 
    487513            ! Only read in necessary fields for this set. 
    488514            ! Important that barotropic variables come first. 
    489             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN  
    490  
    491                IF( nn_dyn2d(ib_bdy) .ne. jp_frs .and. nn_tra(ib_bdy) .ne. 4 ) THEN ! runoff condition : no ssh reading 
     515            IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN  
     516 
     517               IF( dta%ll_ssh ) THEN  
     518                  if(lwp) write(numout,*) '++++++ reading in ssh field' 
    492519                  jfld = jfld + 1 
    493520                  blf_i(jfld) = bn_ssh 
     
    496523                  ilen1(jfld) = nblen(igrid(jfld)) 
    497524                  ilen3(jfld) = 1 
    498                ENDIF 
    499  
    500                IF( .not. ln_full_vel_array(ib_bdy) ) THEN 
     525                  dta%nread(2) = dta%nread(2) + 1 
     526               ENDIF 
     527 
     528               IF( dta%ll_u2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 
     529                  if(lwp) write(numout,*) '++++++ reading in u2d field' 
    501530                  jfld = jfld + 1 
    502531                  blf_i(jfld) = bn_u2d 
     
    505534                  ilen1(jfld) = nblen(igrid(jfld)) 
    506535                  ilen3(jfld) = 1 
    507  
     536                  dta%nread(2) = dta%nread(2) + 1 
     537               ENDIF 
     538 
     539               IF( dta%ll_v2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 
     540                  if(lwp) write(numout,*) '++++++ reading in v2d field' 
    508541                  jfld = jfld + 1 
    509542                  blf_i(jfld) = bn_v2d 
     
    512545                  ilen1(jfld) = nblen(igrid(jfld)) 
    513546                  ilen3(jfld) = 1 
    514                ENDIF 
    515  
    516             ENDIF 
    517  
    518             ! baroclinic velocities 
    519             IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. & 
    520            &      ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.  & 
    521            &        ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    522  
    523                jfld = jfld + 1 
    524                blf_i(jfld) = bn_u3d 
    525                ibdy(jfld) = ib_bdy 
    526                igrid(jfld) = 2 
    527                ilen1(jfld) = nblen(igrid(jfld)) 
    528                ilen3(jfld) = jpk 
    529  
    530                jfld = jfld + 1 
    531                blf_i(jfld) = bn_v3d 
    532                ibdy(jfld) = ib_bdy 
    533                igrid(jfld) = 3 
    534                ilen1(jfld) = nblen(igrid(jfld)) 
    535                ilen3(jfld) = jpk 
     547                  dta%nread(2) = dta%nread(2) + 1 
     548               ENDIF 
     549 
     550            ENDIF 
     551 
     552            ! read 3D velocities if baroclinic velocities require OR if 
     553            ! barotropic velocities required and ln_full_vel set to .true. 
     554            IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
     555           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     556 
     557               IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     558                  if(lwp) write(numout,*) '++++++ reading in u3d field' 
     559                  jfld = jfld + 1 
     560                  blf_i(jfld) = bn_u3d 
     561                  ibdy(jfld) = ib_bdy 
     562                  igrid(jfld) = 2 
     563                  ilen1(jfld) = nblen(igrid(jfld)) 
     564                  ilen3(jfld) = jpk 
     565                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 
     566               ENDIF 
     567 
     568               IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     569                  if(lwp) write(numout,*) '++++++ reading in v3d field' 
     570                  jfld = jfld + 1 
     571                  blf_i(jfld) = bn_v3d 
     572                  ibdy(jfld) = ib_bdy 
     573                  igrid(jfld) = 3 
     574                  ilen1(jfld) = nblen(igrid(jfld)) 
     575                  ilen3(jfld) = jpk 
     576                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 
     577               ENDIF 
    536578 
    537579            ENDIF 
    538580 
    539581            ! temperature and salinity 
    540             IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
    541  
    542                jfld = jfld + 1 
    543                blf_i(jfld) = bn_tem 
    544                ibdy(jfld) = ib_bdy 
    545                igrid(jfld) = 1 
    546                ilen1(jfld) = nblen(igrid(jfld)) 
    547                ilen3(jfld) = jpk 
    548  
    549                jfld = jfld + 1 
    550                blf_i(jfld) = bn_sal 
    551                ibdy(jfld) = ib_bdy 
    552                igrid(jfld) = 1 
    553                ilen1(jfld) = nblen(igrid(jfld)) 
    554                ilen3(jfld) = jpk 
     582            IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
     583 
     584               IF( dta%ll_tem ) THEN 
     585                  if(lwp) write(numout,*) '++++++ reading in tem field' 
     586                  jfld = jfld + 1 
     587                  blf_i(jfld) = bn_tem 
     588                  ibdy(jfld) = ib_bdy 
     589                  igrid(jfld) = 1 
     590                  ilen1(jfld) = nblen(igrid(jfld)) 
     591                  ilen3(jfld) = jpk 
     592               ENDIF 
     593 
     594               IF( dta%ll_sal ) THEN 
     595                  if(lwp) write(numout,*) '++++++ reading in sal field' 
     596                  jfld = jfld + 1 
     597                  blf_i(jfld) = bn_sal 
     598                  ibdy(jfld) = ib_bdy 
     599                  igrid(jfld) = 1 
     600                  ilen1(jfld) = nblen(igrid(jfld)) 
     601                  ilen3(jfld) = jpk 
     602               ENDIF 
    555603 
    556604            ENDIF 
     
    558606#if defined key_lim2 
    559607            ! sea ice 
    560             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
    561  
    562                jfld = jfld + 1 
    563                blf_i(jfld) = bn_frld 
    564                ibdy(jfld) = ib_bdy 
    565                igrid(jfld) = 1 
    566                ilen1(jfld) = nblen(igrid(jfld)) 
    567                ilen3(jfld) = 1 
    568  
    569                jfld = jfld + 1 
    570                blf_i(jfld) = bn_hicif 
    571                ibdy(jfld) = ib_bdy 
    572                igrid(jfld) = 1 
    573                ilen1(jfld) = nblen(igrid(jfld)) 
    574                ilen3(jfld) = 1 
    575  
    576                jfld = jfld + 1 
    577                blf_i(jfld) = bn_hsnif 
    578                ibdy(jfld) = ib_bdy 
    579                igrid(jfld) = 1 
    580                ilen1(jfld) = nblen(igrid(jfld)) 
    581                ilen3(jfld) = 1 
     608            IF( nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
     609 
     610               IF( dta%ll_frld ) THEN 
     611                  jfld = jfld + 1 
     612                  blf_i(jfld) = bn_frld 
     613                  ibdy(jfld) = ib_bdy 
     614                  igrid(jfld) = 1 
     615                  ilen1(jfld) = nblen(igrid(jfld)) 
     616                  ilen3(jfld) = 1 
     617               ENDIF 
     618 
     619               IF( dta%ll_hicif ) THEN 
     620                  jfld = jfld + 1 
     621                  blf_i(jfld) = bn_hicif 
     622                  ibdy(jfld) = ib_bdy 
     623                  igrid(jfld) = 1 
     624                  ilen1(jfld) = nblen(igrid(jfld)) 
     625                  ilen3(jfld) = 1 
     626               ENDIF 
     627 
     628               IF( dta%ll_hsnif ) THEN 
     629                  jfld = jfld + 1 
     630                  blf_i(jfld) = bn_hsnif 
     631                  ibdy(jfld) = ib_bdy 
     632                  igrid(jfld) = 1 
     633                  ilen1(jfld) = nblen(igrid(jfld)) 
     634                  ilen3(jfld) = 1 
     635               ENDIF 
    582636 
    583637            ENDIF 
     
    594648            ENDIF 
    595649 
     650            dta%nread(1) = nb_bdy_fld(ib_bdy) 
     651 
    596652         ENDIF ! nn_dta .eq. 1 
    597653      ENDDO ! ib_bdy 
     
    622678 
    623679         nblen => idx_bdy(ib_bdy)%nblen 
    624          nblenrim => idx_bdy(ib_bdy)%nblenrim 
    625  
    626          IF (nn_dyn2d(ib_bdy) .gt. 0) THEN 
    627             IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN 
    628                ilen0(1:3) = nblen(1:3) 
    629                ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) ) 
    630                ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) ) 
    631                IF ( nn_dyn2d(ib_bdy) .ne. jp_frs .and. (nn_dyn2d_dta(ib_bdy).eq.1.or.nn_dyn2d_dta(ib_bdy).eq.3) ) THEN 
    632                   jfld = jfld + 1 
    633                   dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 
     680         dta => dta_bdy(ib_bdy) 
     681 
     682         if(lwp) then 
     683            write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 
     684            write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 
     685            write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 
     686            write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 
     687            write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 
     688            write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 
     689            write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 
     690         endif 
     691 
     692         IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN 
     693            if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 
     694            IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 
     695            IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 
     696            IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 
     697         ENDIF 
     698         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 
     699            IF( dta%ll_ssh ) THEN 
     700               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 
     701               jfld = jfld + 1 
     702               dta%ssh => bf(jfld)%fnow(:,1,1) 
     703            ENDIF 
     704            IF ( dta%ll_u2d ) THEN 
     705               IF ( ln_full_vel_array(ib_bdy) ) THEN 
     706                  if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 
     707                  ALLOCATE( dta%u2d(nblen(2)) ) 
    634708               ELSE 
    635                   ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) ) 
    636                ENDIF 
    637             ELSE 
    638                IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 
    639                   jfld = jfld + 1 
    640                   dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 
    641                ENDIF 
     709                  if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 
     710                  jfld = jfld + 1 
     711                  dta%u2d => bf(jfld)%fnow(:,1,1) 
     712               ENDIF 
     713            ENDIF 
     714            IF ( dta%ll_v2d ) THEN 
     715               IF ( ln_full_vel_array(ib_bdy) ) THEN 
     716                  if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 
     717                  ALLOCATE( dta%v2d(nblen(3)) ) 
     718               ELSE 
     719                  if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 
     720                  jfld = jfld + 1 
     721                  dta%v2d => bf(jfld)%fnow(:,1,1) 
     722               ENDIF 
     723            ENDIF 
     724         ENDIF 
     725 
     726         IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
     727            if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 
     728            IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 
     729            IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 
     730         ENDIF 
     731         IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
     732           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     733            IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     734               if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 
    642735               jfld = jfld + 1 
    643                dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1) 
     736               dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 
     737            ENDIF 
     738            IF ( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     739               if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 
    644740               jfld = jfld + 1 
    645                dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1) 
    646             ENDIF 
    647          ENDIF 
    648  
    649          IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
    650             ilen0(1:3) = nblen(1:3) 
    651             ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) ) 
    652             ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) ) 
    653          ENDIF 
    654          IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. & 
    655            &  ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.   & 
    656            &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    657             jfld = jfld + 1 
    658             dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 
    659             jfld = jfld + 1 
    660             dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 
    661          ENDIF 
    662  
    663          IF (nn_tra(ib_bdy) .gt. 0) THEN 
    664             IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
    665                ilen0(1:3) = nblen(1:3) 
    666                ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) ) 
    667                ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) ) 
    668             ELSE 
     741               dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 
     742            ENDIF 
     743         ENDIF 
     744 
     745         IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
     746            if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 
     747            IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) 
     748            IF( dta%ll_sal ) ALLOCATE( dta_bdy(ib_bdy)%sal(nblen(1),jpk) ) 
     749         ELSE 
     750            IF( dta%ll_tem ) THEN 
     751               if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 
    669752               jfld = jfld + 1 
    670753               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:) 
     754            ENDIF 
     755            IF( dta%ll_sal ) THEN  
     756               if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 
    671757               jfld = jfld + 1 
    672758               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:) 
     
    677763         IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 
    678764            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 
    679                ilen0(1:3) = nblen(1:3) 
    680                ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) ) 
    681                ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) ) 
    682                ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) ) 
     765               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 
     766               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 
     767               ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) ) 
    683768            ELSE 
    684769               jfld = jfld + 1 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r4193 r4223  
    3030   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3131   USE in_out_manager  ! 
    32    USE domvvl          ! variable volume 
     32   USE domvvl 
    3333 
    3434   IMPLICIT NONE 
     
    5757      LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities 
    5858      !! 
    59       INTEGER               :: jk,ii,ij,ib,igrd     ! Loop counter 
    60       LOGICAL               :: ll_dyn2d, ll_dyn3d   
     59      INTEGER               :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter 
     60      LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski 
    6161      !! 
    6262 
     
    7070      ENDIF 
    7171 
     72      ll_orlanski = .false. 
     73      DO ib_bdy = 1, nb_bdy 
     74         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 
     75     &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 
     76      ENDDO 
     77 
    7278      !------------------------------------------------------- 
    7379      ! Set pointers 
     
    7783      phur => hur 
    7884      phvr => hvr 
    79       CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
     85      CALL wrk_alloc(jpi,jpj,pua2d,pva2d)  
     86      IF ( ll_orlanski ) CALL wrk_alloc(jpi,jpj,pub2d,pvb2d)  
    8087 
    8188      !------------------------------------------------------- 
     
    8390      !------------------------------------------------------- 
    8491 
    85       pu2d(:,:) = 0.e0 
    86       pv2d(:,:) = 0.e0 
     92      ! "After" velocities:  
    8793 
     94      pua2d(:,:) = 0.e0 
     95      pva2d(:,:) = 0.e0 
     96       
    8897      IF (lk_vvl) THEN 
    8998         DO jk = 1, jpkm1 
    90             pu2d(:,:) = pu2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    91             pv2d(:,:) = pv2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     99            pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
     100            pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    92101         END DO 
    93          pu2d(:,:) = pu2d(:,:) / ( hu_0(:,:) + sshu_a(:,:) + 1._wp - umask(:,:,1) ) 
    94          pv2d(:,:) = pv2d(:,:) / ( hv_0(:,:) + sshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
     102         pua2d(:,:) = pua2d(:,:) / ( hu_0(:,:) + sshu_a(:,:) + 1._wp - umask(:,:,1) )  
     103         pva2d(:,:) = pva2d(:,:) / ( hv_0(:,:) + sshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
    95104      ELSE 
    96105         DO jk = 1, jpkm1 
    97             pu2d(:,:) = pu2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    98             pv2d(:,:) = pv2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     106            pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
     107            pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    99108         END DO 
    100          pu2d(:,:) = pu2d(:,:) * phur(:,:) 
    101          pv2d(:,:) = pv2d(:,:) * phvr(:,:) 
     109         pua2d(:,:) = pua2d(:,:) * phur(:,:) 
     110         pva2d(:,:) = pva2d(:,:) * phvr(:,:) 
    102111      ENDIF 
    103112 
    104113      DO jk = 1 , jpkm1 
    105          ua(:,:,jk) = ua(:,:,jk) - pu2d(:,:) * umask(:,:,jk) 
    106          va(:,:,jk) = va(:,:,jk) - pv2d(:,:) * vmask(:,:,jk) 
     114         ua(:,:,jk) = ua(:,:,jk) - pua2d(:,:) 
     115         va(:,:,jk) = va(:,:,jk) - pva2d(:,:) 
    107116      END DO 
     117 
     118      ! "Before" velocities (required for Orlanski condition):  
     119 
     120      IF ( ll_orlanski ) THEN           
     121         pub2d(:,:) = 0.e0 
     122         pvb2d(:,:) = 0.e0 
     123 
     124         IF (lk_vvl) THEN 
     125            DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
     126               pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 
     127               pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 
     128            END DO 
     129            pub2d(:,:) = pub2d(:,:) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) )  
     130            pvb2d(:,:) = pvb2d(:,:) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
     131         ELSE 
     132            DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
     133               pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 
     134               pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 
     135            END DO 
     136            pub2d(:,:) = pub2d(:,:) * phur(:,:) 
     137            pvb2d(:,:) = pvb2d(:,:) * phvr(:,:) 
     138         ENDIF 
     139 
     140         DO jk = 1 , jpkm1 
     141            ub(:,:,jk) = ub(:,:,jk) - pub2d(:,:) 
     142            vb(:,:,jk) = vb(:,:,jk) - pvb2d(:,:) 
     143         END DO 
     144      END IF 
    108145 
    109146      !------------------------------------------------------- 
     
    121158 
    122159      DO jk = 1 , jpkm1 
    123          ua(:,:,jk) = ( ua(:,:,jk) + pu2d(:,:) ) * umask(:,:,jk) 
    124          va(:,:,jk) = ( va(:,:,jk) + pv2d(:,:) ) * vmask(:,:,jk) 
     160         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 
     161         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 
    125162      END DO 
    126163 
    127       CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     164      IF ( ll_orlanski ) THEN 
     165         DO jk = 1 , jpkm1 
     166            ub(:,:,jk) = ( ub(:,:,jk) + pub2d(:,:) ) * umask(:,:,jk) 
     167            vb(:,:,jk) = ( vb(:,:,jk) + pvb2d(:,:) ) * vmask(:,:,jk) 
     168         END DO 
     169      END IF 
     170 
     171      CALL wrk_dealloc(jpi,jpj,pua2d,pva2d)  
     172      IF ( ll_orlanski ) CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d)  
    128173 
    129174      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r3970 r4223  
    1212   !!   'key_bdy' :                    Unstructured Open Boundary Condition 
    1313   !!---------------------------------------------------------------------- 
    14    !!   bdy_dyn2d      : Apply open boundary conditions to barotropic variables. 
    15    !!   bdy_dyn2d_fla    : Apply Flather condition 
     14   !!   bdy_dyn2d          : Apply open boundary conditions to barotropic variables. 
     15   !!   bdy_dyn2d_frs      : Apply Flow Relaxation Scheme  
     16   !!   bdy_dyn2d_fla      : Apply Flather condition 
     17   !!   bdy_dyn2d_orlanski : Orlanski Radiation 
     18   !!   bdy_ssh            : Duplicate sea level across open boundaries 
    1619   !!---------------------------------------------------------------------- 
    1720   USE timing          ! Timing 
     
    1922   USE dom_oce         ! ocean space and time domain 
    2023   USE bdy_oce         ! ocean open boundary conditions 
     24   USE bdylib          ! BDY library routines 
    2125   USE dynspg_oce      ! for barotropic variables 
    2226   USE phycst          ! physical constants 
     
    2731   PRIVATE 
    2832 
    29    PUBLIC   bdy_dyn2d     ! routine called in dynspg_ts and bdy_dyn 
     33   PUBLIC   bdy_dyn2d   ! routine called in dynspg_ts and bdy_dyn 
    3034   PUBLIC   bdy_ssh       ! routine called in dynspg_ts or sshwzv 
    3135 
     
    5054      DO ib_bdy=1, nb_bdy 
    5155 
    52          SELECT CASE( nn_dyn2d(ib_bdy) ) 
    53          CASE(jp_none) 
     56         SELECT CASE( cn_dyn2d(ib_bdy) ) 
     57         CASE('none') 
    5458            CYCLE 
    55          CASE(jp_frs) 
     59         CASE('frs') 
    5660            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    57          CASE(jp_flather) 
     61         CASE('flather') 
    5862            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
     63         CASE('orlanski') 
     64            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     65         CASE('orlanski_npo') 
     66            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    5967         CASE DEFAULT 
    6068            CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
     
    9199         ij   = idx%nbj(jb,igrd) 
    92100         zwgt = idx%nbw(jb,igrd) 
    93          pu2d(ii,ij) = ( pu2d(ii,ij) + zwgt * ( dta%u2d(jb) - pu2d(ii,ij) ) ) * umask(ii,ij,1) 
     101         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1) 
    94102      END DO 
    95103      ! 
     
    99107         ij   = idx%nbj(jb,igrd) 
    100108         zwgt = idx%nbw(jb,igrd) 
    101          pv2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1) 
     109         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 
    102110      END DO  
    103       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )  
    104       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
     111      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )  
     112      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
    105113      ! 
    106114      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs') 
     
    135143      INTEGER  ::   jb, igrd                         ! dummy loop indices 
    136144      INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses 
     145      REAL(wp), POINTER :: flagu, flagv              ! short cuts 
    137146      REAL(wp) ::   zcorr                            ! Flather correction 
    138147      REAL(wp) ::   zforc                            ! temporary scalar 
     
    165174         ii  = idx%nbi(jb,igrd) 
    166175         ij  = idx%nbj(jb,igrd)  
    167          iim1 = ii + MAX( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice inside the boundary 
    168          iip1 = ii - MIN( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice outside the boundary  
     176         flagu => idx%flagu(jb,igrd) 
     177         iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary 
     178         iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary  
    169179         ! 
    170          zcorr = - idx%flagu(jb) * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
    171          ! bg jchanut tschanges: Set zflag to 0 below to revert to Flather scheme 
    172 !!         zforc = dta%u2d(jb) 
    173          zflag = ABS(idx%flagu(jb)) 
    174          iim1 = ii + idx%flagu(jb) 
    175          zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pu2d(iim1,ij) 
    176          pu2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1)  
    177          ! end jchanut tschanges 
     180         zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
     181 
     182         ! jchanut tschanges: Set zflag to 0 below to revert to Flather scheme 
     183         ! Use characteristics method instead 
     184         zflag = ABS(flagu) 
     185         zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(iim1,ij) 
     186         pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1)  
    178187      END DO 
    179188      ! 
     
    183192         ii  = idx%nbi(jb,igrd) 
    184193         ij  = idx%nbj(jb,igrd)  
    185          ijm1 = ij + MAX( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice inside the boundary 
    186          ijp1 = ij - MIN( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice outside the boundary  
     194         flagv => idx%flagv(jb,igrd) 
     195         ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary 
     196         ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary  
    187197         ! 
    188          zcorr = - idx%flagv(jb) * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
    189          ! bg jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme 
    190 !!         zforc = dta%v2d(jb) 
    191          zflag = ABS(idx%flagv(jb)) 
    192          ijm1 = ij + idx%flagv(jb) 
    193          zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pv2d(ii,ijm1) 
    194          pv2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 
    195          ! end jchanut tschanges 
    196       END DO 
    197       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
    198       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy )   ! 
     198         zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
     199 
     200         ! jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme 
     201         ! Use characteristics method instead 
     202         zflag = ABS(flagv) 
     203         zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1) 
     204         pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 
     205      END DO 
     206      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
     207      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   ! 
    199208      ! 
    200209      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla') 
    201210      ! 
    202211   END SUBROUTINE bdy_dyn2d_fla 
     212 
     213 
     214   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     215      !!---------------------------------------------------------------------- 
     216      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  *** 
     217      !!              
     218      !!              - Apply Orlanski radiation condition adaptively: 
     219      !!                  - radiation plus weak nudging at outflow points 
     220      !!                  - no radiation and strong nudging at inflow points 
     221      !!  
     222      !! 
     223      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
     224      !!---------------------------------------------------------------------- 
     225      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     226      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     227      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set 
     228      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version 
     229 
     230      INTEGER  ::   ib, igrd                               ! dummy loop indices 
     231      INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices 
     232      !!---------------------------------------------------------------------- 
     233 
     234      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_orlanski') 
     235      ! 
     236      igrd = 2      ! Orlanski bc on u-velocity;  
     237      !             
     238      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ll_npo ) 
     239 
     240      igrd = 3      ! Orlanski bc on v-velocity 
     241      !   
     242      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo ) 
     243      ! 
     244      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 
     245      ! 
     246      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
     247      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   ! 
     248      ! 
     249      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 
     250      ! 
     251   END SUBROUTINE bdy_dyn2d_orlanski 
    203252 
    204253   SUBROUTINE bdy_ssh( zssh ) 
     
    248297 
    249298   END SUBROUTINE bdy_ssh 
     299 
    250300#else 
    251301   !!---------------------------------------------------------------------- 
     
    255305   SUBROUTINE bdy_dyn2d( kt )      ! Empty routine 
    256306      INTEGER, intent(in) :: kt 
    257       WRITE(*,*) 'bdy_dyn2: You should not have seen this print! error?', kt 
     307      WRITE(*,*) 'bdy_dyn2d: You should not have seen this print! error?', kt 
    258308   END SUBROUTINE bdy_dyn2d 
    259309 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r3703 r4223  
    1919   USE dom_oce         ! ocean space and time domain 
    2020   USE bdy_oce         ! ocean open boundary conditions 
     21   USE bdylib          ! for orlanski library routines 
    2122   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2223   USE in_out_manager  ! 
     
    5253      DO ib_bdy=1, nb_bdy 
    5354 
    54 !!$         IF ( using Orlanski radiation conditions ) THEN  
    55 !!$            CALL bdy_rad( kt,  bdyidx(ib_bdy) ) 
    56 !!$         ENDIF 
    57  
    58          SELECT CASE( nn_dyn3d(ib_bdy) ) 
    59          CASE(jp_none) 
     55         SELECT CASE( cn_dyn3d(ib_bdy) ) 
     56         CASE('none') 
    6057            CYCLE 
    61          CASE(jp_frs) 
     58         CASE('frs') 
    6259            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    63          CASE(2) 
     60         CASE('specified') 
    6461            CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    65          CASE(3) 
     62         CASE('zero') 
    6663            CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     64         CASE('orlanski') 
     65            CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     66         CASE('orlanski_npo') 
     67            CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    6768         CASE DEFAULT 
    6869            CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
     
    109110         END DO 
    110111      END DO 
    111       CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
     112      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
     113      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    112114      ! 
    113115      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
     
    204206         END DO 
    205207      END DO  
    206       CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
     208      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
     209      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    207210      ! 
    208211      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
     
    211214 
    212215   END SUBROUTINE bdy_dyn3d_frs 
     216 
     217   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     218      !!---------------------------------------------------------------------- 
     219      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  *** 
     220      !!              
     221      !!              - Apply Orlanski radiation to baroclinic velocities.  
     222      !!              - Wrapper routine for bdy_orlanski_3d 
     223      !!  
     224      !! 
     225      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
     226      !!---------------------------------------------------------------------- 
     227      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     228      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     229      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
     230      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
     231 
     232      INTEGER  ::   jb, igrd                               ! dummy loop indices 
     233      !!---------------------------------------------------------------------- 
     234 
     235      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_orlanski') 
     236      ! 
     237      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
     238      ! 
     239      igrd = 2      ! Orlanski bc on u-velocity;  
     240      !             
     241      CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo ) 
     242 
     243      igrd = 3      ! Orlanski bc on v-velocity 
     244      !   
     245      CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 
     246      ! 
     247      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
     248      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
     249      ! 
     250      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_orlanski') 
     251      ! 
     252   END SUBROUTINE bdy_dyn3d_orlanski 
     253 
    213254 
    214255   SUBROUTINE bdy_dyn3d_dmp( kt ) 
     
    232273      ! Remove barotropic part from before velocity 
    233274      !------------------------------------------------------- 
    234       CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
    235  
    236       pu2d(:,:) = 0.e0 
    237       pv2d(:,:) = 0.e0 
     275      CALL wrk_alloc(jpi,jpj,pub2d,pvb2d)  
     276 
     277      pub2d(:,:) = 0.e0 
     278      pvb2d(:,:) = 0.e0 
    238279 
    239280      DO jk = 1, jpkm1 
    240281#if defined key_vvl 
    241          pu2d(:,:) = pu2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk)   *umask(:,:,jk)  
    242          pv2d(:,:) = pv2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk)   *vmask(:,:,jk) 
     282         pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk)   *umask(:,:,jk)  
     283         pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk)   *vmask(:,:,jk) 
    243284#else 
    244          pu2d(:,:) = pu2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk)  * umask(:,:,jk) 
    245          pv2d(:,:) = pv2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk)  * vmask(:,:,jk) 
     285         pub2d(:,:) = pub2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk)  * umask(:,:,jk) 
     286         pvb2d(:,:) = pvb2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk)  * vmask(:,:,jk) 
    246287#endif 
    247288      END DO 
    248289 
    249290      IF( lk_vvl ) THEN 
    250          pu2d(:,:) = pu2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 
    251          pv2d(:,:) = pv2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
     291         pub2d(:,:) = pub2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 
     292         pvb2d(:,:) = pvb2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
    252293      ELSE 
    253          pu2d(:,:) = pv2d(:,:) * hur(:,:) 
    254          pv2d(:,:) = pu2d(:,:) * hvr(:,:) 
     294         pub2d(:,:) = pvb2d(:,:) * hur(:,:) 
     295         pvb2d(:,:) = pub2d(:,:) * hvr(:,:) 
    255296      ENDIF 
    256297 
    257298      DO ib_bdy=1, nb_bdy 
    258          IF ( ln_dyn3d_dmp(ib_bdy).and.nn_dyn3d(ib_bdy).gt.0 ) THEN 
     299         IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN 
    259300            igrd = 2                      ! Relaxation of zonal velocity 
    260301            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd) 
     
    264305               DO jk = 1, jpkm1 
    265306                  ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 
    266                                    ub(ii,ij,jk) + pu2d(ii,ij)) ) * umask(ii,ij,jk) 
     307                                   ub(ii,ij,jk) + pub2d(ii,ij)) ) * umask(ii,ij,jk) 
    267308               END DO 
    268309            END DO 
     
    275316               DO jk = 1, jpkm1 
    276317                  va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  & 
    277                                    vb(ii,ij,jk) + pv2d(ii,ij)) ) * vmask(ii,ij,jk) 
     318                                   vb(ii,ij,jk) + pvb2d(ii,ij)) ) * vmask(ii,ij,jk) 
    278319               END DO 
    279320            END DO 
     
    281322      ENDDO 
    282323      ! 
    283       CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     324      CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d)  
    284325      ! 
    285326      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

    r4193 r4223  
    5050      DO ib_bdy=1, nb_bdy 
    5151 
    52          SELECT CASE( nn_ice_lim2(ib_bdy) ) 
    53          CASE(jp_none) 
     52         SELECT CASE( cn_ice_lim2(ib_bdy) ) 
     53         CASE('none') 
    5454            CYCLE 
    55          CASE(jp_frs) 
     55         CASE('frs') 
    5656            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    5757         CASE DEFAULT 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r4193 r4223  
    2121   !!   bdy_init       : Initialization of unstructured open boundaries 
    2222   !!---------------------------------------------------------------------- 
     23   USE wrk_nemo        ! Memory Allocation 
    2324   USE timing          ! Timing 
    2425   USE oce             ! ocean dynamics and tracers variables 
     
    7980      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
    8081      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
     82      INTEGER  ::   i_offset, j_offset                     !   -       - 
    8183      INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts 
    82       REAL   , POINTER  ::  flagu, flagv                   !    -   - 
     84      REAL(wp), POINTER  ::  flagu, flagv                  !    -   - 
     85      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
    8386      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
    8487      INTEGER, DIMENSION (2)                  ::   kdimsz 
     
    9093      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving 
    9194      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
     95      REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    9296 
    9397      !! 
    94       NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,             & 
    95          &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, & 
    96          &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta,         &   
    97          &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp,             & 
     98      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,                 & 
     99         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,    & 
     100         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
     101         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    98102#if defined key_lim2 
    99          &             nn_ice_lim2, nn_ice_lim2_dta,                       & 
     103         &             cn_ice_lim2, nn_ice_lim2_dta,                           & 
    100104#endif 
    101105         &             ln_vol, nn_volctl, nn_rimwidth 
     
    128132      ln_mask_file      = .false. 
    129133      cn_mask_file(:)   = '' 
    130       nn_dyn2d(:)       = 0 
     134      cn_dyn2d(:)       = '' 
    131135      nn_dyn2d_dta(:)   = -1  ! uninitialised flag 
    132       nn_dyn3d(:)       = 0 
     136      cn_dyn3d(:)       = '' 
    133137      nn_dyn3d_dta(:)   = -1  ! uninitialised flag 
    134       nn_tra(:)         = 0 
     138      cn_tra(:)         = '' 
    135139      nn_tra_dta(:)     = -1  ! uninitialised flag 
    136140      ln_tra_dmp(:)     = .false. 
     
    138142      rn_time_dmp(:)    = 1. 
    139143#if defined key_lim2 
    140       nn_ice_lim2(:)    = 0 
     144      cn_ice_lim2(:)    = '' 
    141145      nn_ice_lim2_dta(:)= -1  ! uninitialised flag 
    142146#endif 
     
    161165 
    162166      DO ib_bdy = 1,nb_bdy 
    163         icount = 0 ! flag to set max rimwidth to 1 if no relaxation 
    164167        IF(lwp) WRITE(numout,*) ' '  
    165168        IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------'  
     
    173176 
    174177        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
    175         SELECT CASE( nn_dyn2d(ib_bdy) )                   
    176           CASE(jp_none)         ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    177           CASE(jp_frs)          ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    178           icount = icount + 1 
    179           CASE(jp_flather)      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
    180           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn2d' ) 
     178        SELECT CASE( cn_dyn2d(ib_bdy) )                   
     179          CASE('none')          
     180             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     181             dta_bdy(ib_bdy)%ll_ssh = .false. 
     182             dta_bdy(ib_bdy)%ll_u2d = .false. 
     183             dta_bdy(ib_bdy)%ll_v2d = .false. 
     184          CASE('frs')           
     185             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     186             dta_bdy(ib_bdy)%ll_ssh = .false. 
     187             dta_bdy(ib_bdy)%ll_u2d = .true. 
     188             dta_bdy(ib_bdy)%ll_v2d = .true. 
     189          CASE('flather')       
     190             IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
     191             dta_bdy(ib_bdy)%ll_ssh = .true. 
     192             dta_bdy(ib_bdy)%ll_u2d = .true. 
     193             dta_bdy(ib_bdy)%ll_v2d = .true. 
     194          CASE('orlanski')      
     195             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     196             dta_bdy(ib_bdy)%ll_ssh = .false. 
     197             dta_bdy(ib_bdy)%ll_u2d = .true. 
     198             dta_bdy(ib_bdy)%ll_v2d = .true. 
     199          CASE('orlanski_npo')  
     200             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     201             dta_bdy(ib_bdy)%ll_ssh = .false. 
     202             dta_bdy(ib_bdy)%ll_u2d = .true. 
     203             dta_bdy(ib_bdy)%ll_v2d = .true. 
     204          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' ) 
    181205        END SELECT 
    182         IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     206        IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    183207           SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   !  
    184208              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     
    195219 
    196220        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  ' 
    197         SELECT CASE( nn_dyn3d(ib_bdy) )                   
    198           CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    199           CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    200           icount = icount + 1 
    201           CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value' 
    202           CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
    203           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn3d' ) 
     221        SELECT CASE( cn_dyn3d(ib_bdy) )                   
     222          CASE('none') 
     223             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     224             dta_bdy(ib_bdy)%ll_u3d = .false. 
     225             dta_bdy(ib_bdy)%ll_v3d = .false. 
     226          CASE('frs')        
     227             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     228             dta_bdy(ib_bdy)%ll_u3d = .true. 
     229             dta_bdy(ib_bdy)%ll_v3d = .true. 
     230          CASE('specified') 
     231             IF(lwp) WRITE(numout,*) '      Specified value' 
     232             dta_bdy(ib_bdy)%ll_u3d = .true. 
     233             dta_bdy(ib_bdy)%ll_v3d = .true. 
     234          CASE('zero') 
     235             IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
     236             dta_bdy(ib_bdy)%ll_u3d = .false. 
     237             dta_bdy(ib_bdy)%ll_v3d = .false. 
     238          CASE('orlanski') 
     239             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     240             dta_bdy(ib_bdy)%ll_u3d = .true. 
     241             dta_bdy(ib_bdy)%ll_v3d = .true. 
     242          CASE('orlanski_npo') 
     243             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     244             dta_bdy(ib_bdy)%ll_u3d = .true. 
     245             dta_bdy(ib_bdy)%ll_v3d = .true. 
     246          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn3d' ) 
    204247        END SELECT 
    205         IF( nn_dyn3d(ib_bdy) .gt. 0 ) THEN 
     248        IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 
    206249           SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   !  
    207250              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     
    212255 
    213256        IF ( ln_dyn3d_dmp(ib_bdy) ) THEN 
    214            IF ( nn_dyn3d(ib_bdy).EQ.0 ) THEN 
     257           IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN 
    215258              IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.' 
    216259              ln_dyn3d_dmp(ib_bdy)=.false. 
    217            ELSEIF ( nn_dyn3d(ib_bdy).EQ.1 ) THEN 
     260           ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN 
    218261              CALL ctl_stop( 'Use FRS OR relaxation' ) 
    219262           ELSE 
    220               icount = icount + 1 
    221263              IF(lwp) WRITE(numout,*) '      + baroclinic velocities relaxation zone' 
    222264              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
    223265              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     266              dta_bdy(ib_bdy)%ll_u3d = .true. 
     267              dta_bdy(ib_bdy)%ll_v3d = .true. 
    224268           ENDIF 
    225269        ELSE 
     
    229273 
    230274        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  ' 
    231         SELECT CASE( nn_tra(ib_bdy) )                   
    232           CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    233           CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    234           icount = icount + 1 
    235           CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value' 
    236           CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Neumann conditions' 
    237           CASE( 4 )      ;   IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
    238           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     275        SELECT CASE( cn_tra(ib_bdy) )                   
     276          CASE('none') 
     277             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     278             dta_bdy(ib_bdy)%ll_tem = .false. 
     279             dta_bdy(ib_bdy)%ll_sal = .false. 
     280          CASE('frs') 
     281             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     282             dta_bdy(ib_bdy)%ll_tem = .true. 
     283             dta_bdy(ib_bdy)%ll_sal = .true. 
     284          CASE('specified') 
     285             IF(lwp) WRITE(numout,*) '      Specified value' 
     286             dta_bdy(ib_bdy)%ll_tem = .true. 
     287             dta_bdy(ib_bdy)%ll_sal = .true. 
     288          CASE('neumann') 
     289             IF(lwp) WRITE(numout,*) '      Neumann conditions' 
     290             dta_bdy(ib_bdy)%ll_tem = .false. 
     291             dta_bdy(ib_bdy)%ll_sal = .false. 
     292          CASE('runoff') 
     293             IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
     294             dta_bdy(ib_bdy)%ll_tem = .false. 
     295             dta_bdy(ib_bdy)%ll_sal = .false. 
     296          CASE('orlanski') 
     297             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     298             dta_bdy(ib_bdy)%ll_tem = .true. 
     299             dta_bdy(ib_bdy)%ll_sal = .true. 
     300          CASE('orlanski_npo') 
     301             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     302             dta_bdy(ib_bdy)%ll_tem = .true. 
     303             dta_bdy(ib_bdy)%ll_sal = .true. 
     304          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_tra' ) 
    239305        END SELECT 
    240         IF( nn_tra(ib_bdy) .gt. 0 ) THEN 
     306        IF( cn_tra(ib_bdy) /= 'none' ) THEN 
    241307           SELECT CASE( nn_tra_dta(ib_bdy) )                   !  
    242308              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     
    247313 
    248314        IF ( ln_tra_dmp(ib_bdy) ) THEN 
    249            IF ( nn_tra(ib_bdy).EQ.0 ) THEN 
     315           IF ( cn_tra(ib_bdy) == 'none' ) THEN 
    250316              IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.' 
    251317              ln_tra_dmp(ib_bdy)=.false. 
    252            ELSEIF ( nn_tra(ib_bdy).EQ.1 ) THEN 
     318           ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN 
    253319              CALL ctl_stop( 'Use FRS OR relaxation' ) 
    254320           ELSE 
    255               icount = icount + 1 
    256321              IF(lwp) WRITE(numout,*) '      + T/S relaxation zone' 
    257322              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
     323              IF(lwp) WRITE(numout,*) '      Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days' 
    258324              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     325              dta_bdy(ib_bdy)%ll_tem = .true. 
     326              dta_bdy(ib_bdy)%ll_sal = .true. 
    259327           ENDIF 
    260328        ELSE 
     
    265333#if defined key_lim2 
    266334        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    267         SELECT CASE( nn_ice_lim2(ib_bdy) )                   
    268           CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    269           CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    270           icount = icount + 1 
    271           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     335        SELECT CASE( cn_ice_lim2(ib_bdy) )                   
     336          CASE('none') 
     337             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     338             dta_bdy(ib_bdy)%ll_frld  = .false. 
     339             dta_bdy(ib_bdy)%ll_hicif = .false. 
     340             dta_bdy(ib_bdy)%ll_hsnif = .false. 
     341          CASE('frs') 
     342             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     343             dta_bdy(ib_bdy)%ll_frld  = .true. 
     344             dta_bdy(ib_bdy)%ll_hicif = .true. 
     345             dta_bdy(ib_bdy)%ll_hsnif = .true. 
     346          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim2' ) 
    272347        END SELECT 
    273         IF( nn_ice_lim2(ib_bdy) .gt. 0 ) THEN  
     348        IF( cn_ice_lim2(ib_bdy) /= 'none' ) THEN  
    274349           SELECT CASE( nn_ice_lim2_dta(ib_bdy) )                   !  
    275350              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
     
    280355        IF(lwp) WRITE(numout,*) 
    281356#endif 
    282         IF ( icount>0 ) THEN 
    283            IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy) 
    284            IF(lwp) WRITE(numout,*) 
    285         ELSE 
    286            nn_rimwidth(ib_bdy) = 1 ! no relaxation 
    287         ENDIF 
     357 
     358        IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy) 
     359        IF(lwp) WRITE(numout,*) 
    288360 
    289361      ENDDO 
     
    401473            ENDDO 
    402474            CALL iom_close( inum ) 
     475 
    403476         ENDIF  
    404477 
     
    407480      IF (nb_bdy>0) THEN 
    408481         jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy)) 
     482 
    409483         ! Allocate arrays 
    410484         !--------------- 
     
    454528         ENDIF  
    455529 
    456       ENDDO      
     530      ENDDO       
    457531     
    458532      ! 2. Now fill indices corresponding to straight open boundary arrays: 
     
    752826               IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc... 
    753827                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 
    754                      CALL ctl_stop('bdy_init : ERROR : boundary data in file  & 
    755                                     must be defined in order of distance from edge nbr.', & 
    756                                    'A utility for re-ordering boundary coordinates and data & 
    757                                     files exists in the TOOLS/OBC directory') 
     828                     CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', & 
     829                                   'A utility for re-ordering boundary coordinates and data files exists in the TOOLS/OBC directory') 
    758830                  ENDIF     
    759831               ENDIF 
    760832               ! check if point is in local domain 
    761833               IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
    762                   & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   & 
    763                   & nbrdta(ib,igrd,ib_bdy) <= nn_rimwidth(ib_bdy)     ) THEN       
     834                  & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN 
    764835                  ! 
    765836                  icount = icount  + 1 
     
    774845         ! Allocate index arrays for this boundary set 
    775846         !-------------------------------------------- 
    776  
    777          ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(1:jpbgrd)) 
    778          ilen1 = MAX(1,ilen1) 
     847         ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:)) 
    779848         ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) ) 
    780849         ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) ) 
    781850         ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 
    782851         ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) ) 
     852         ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 
    783853         ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 
    784854         ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 
    785          ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1) ) 
    786          ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1) )       
     855         ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1,jpbgrd) ) 
     856         ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1,jpbgrd) ) 
    787857 
    788858         ! Dispatch mapping indices and discrete distances on each processor 
     
    9521022            ENDDO 
    9531023         ENDDO  
     1024 
    9541025         ! definition of the i- and j- direction local boundaries arrays 
    9551026         ! used for sending the boudaries 
     
    10061077               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) &  
    10071078               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     1079               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) &  
     1080               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    10081081            END DO 
    10091082         END DO  
     
    10191092      ! bdytmask = 1  on the computational domain AND on open boundaries 
    10201093      !          = 0  elsewhere    
    1021       bdytmask(:,:) = 1.e0 
    1022       bdyumask(:,:) = 1.e0 
    1023       bdyvmask(:,:) = 1.e0 
    1024  
     1094  
    10251095      IF( ln_mask_file ) THEN 
    10261096         CALL iom_open( cn_mask_file, inum ) 
     
    11101180      ENDDO 
    11111181 
     1182      ! For the flagu/flagv calculation below we require a version of fmask without 
     1183      ! the land boundary condition (shlat) included: 
     1184      CALL wrk_alloc(jpi,jpj,zfmask)  
     1185      DO ij = 2, jpjm1 
     1186         DO ii = 2, jpim1 
     1187            zfmask(ii,ij) = tmask(ii,ij  ,1) * tmask(ii+1,ij  ,1)   & 
     1188           &              * tmask(ii,ij+1,1) * tmask(ii+1,ij+1,1) 
     1189         END DO       
     1190      END DO 
     1191 
    11121192      ! Lateral boundary conditions 
     1193      CALL lbc_lnk( zfmask       , 'F', 1. ) 
    11131194      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 
    11141195      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 
     
    11161197      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    11171198 
    1118          idx_bdy(ib_bdy)%flagu(:) = 0.e0 
    1119          idx_bdy(ib_bdy)%flagv(:) = 0.e0 
     1199         idx_bdy(ib_bdy)%flagu(:,:) = 0.e0 
     1200         idx_bdy(ib_bdy)%flagv(:,:) = 0.e0 
    11201201         icount = 0  
    11211202 
    1122          !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward 
    1123          !flagu =  0 : u is tangential 
    1124          !flagu =  1 : u is normal to the boundary and is direction is inward 
     1203         ! Calculate relationship of U direction to the local orientation of the boundary 
     1204         ! flagu = -1 : u component is normal to the dynamical boundary and its direction is outward 
     1205         ! flagu =  0 : u is tangential 
     1206         ! flagu =  1 : u is normal to the boundary and is direction is inward 
    11251207   
    1126          igrd = 2      ! u-component  
    1127          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1128             nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1129             nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1130             zefl = bdytmask(nbi  ,nbj) 
    1131             zwfl = bdytmask(nbi+1,nbj) 
    1132             IF( zefl + zwfl == 2 ) THEN 
    1133                icount = icount + 1 
    1134             ELSE 
    1135                idx_bdy(ib_bdy)%flagu(ib)=-zefl+zwfl 
    1136             ENDIF 
     1208         DO igrd = 1,jpbgrd  
     1209            SELECT CASE( igrd ) 
     1210               CASE( 1 ) 
     1211                  pmask => umask(:,:,1) 
     1212                  i_offset = 0 
     1213               CASE( 2 )  
     1214                  pmask => bdytmask 
     1215                  i_offset = 1 
     1216               CASE( 3 )  
     1217                  pmask => zfmask(:,:) 
     1218                  i_offset = 0 
     1219            END SELECT  
     1220            icount = 0 
     1221            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1222               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1223               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1224               zefl = pmask(nbi+i_offset-1,nbj) 
     1225               zwfl = pmask(nbi+i_offset,nbj) 
     1226               ! This error check only works if you are using the bdyXmask arrays 
     1227               IF( i_offset == 1 .and. zefl + zwfl == 2 ) THEN 
     1228                  icount = icount + 1 
     1229                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     1230               ELSE 
     1231                  idx_bdy(ib_bdy)%flagu(ib,igrd) = -zefl + zwfl 
     1232               ENDIF 
     1233            END DO 
     1234            IF( icount /= 0 ) THEN 
     1235               IF(lwp) WRITE(numout,*) 
     1236               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   & 
     1237                  ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
     1238               IF(lwp) WRITE(numout,*) ' ========== ' 
     1239               IF(lwp) WRITE(numout,*) 
     1240               nstop = nstop + 1 
     1241            ENDIF  
    11371242         END DO 
    11381243 
    1139          !flagv = -1 : u component is normal to the dynamical boundary but its direction is outward 
    1140          !flagv =  0 : u is tangential 
    1141          !flagv =  1 : u is normal to the boundary and is direction is inward 
    1142  
    1143          igrd = 3      ! v-component 
    1144          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1145             nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1146             nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1147             znfl = bdytmask(nbi,nbj  ) 
    1148             zsfl = bdytmask(nbi,nbj+1) 
    1149             IF( znfl + zsfl == 2 ) THEN 
    1150                icount = icount + 1 
    1151             ELSE 
    1152                idx_bdy(ib_bdy)%flagv(ib) = -znfl + zsfl 
    1153             END IF 
     1244         ! Calculate relationship of V direction to the local orientation of the boundary 
     1245         ! flagv = -1 : v component is normal to the dynamical boundary but its direction is outward 
     1246         ! flagv =  0 : v is tangential 
     1247         ! flagv =  1 : v is normal to the boundary and is direction is inward 
     1248 
     1249         DO igrd = 1,jpbgrd  
     1250            SELECT CASE( igrd ) 
     1251               CASE( 1 ) 
     1252                  pmask => vmask(:,:,1) 
     1253                  j_offset = 0 
     1254               CASE( 2 ) 
     1255                  pmask => zfmask(:,:) 
     1256                  j_offset = 0 
     1257               CASE( 3 ) 
     1258                  pmask => bdytmask 
     1259                  j_offset = 1 
     1260            END SELECT  
     1261            icount = 0 
     1262            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1263               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1264               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1265               znfl = pmask(nbi,nbj+j_offset-1  ) 
     1266               zsfl = pmask(nbi,nbj+j_offset) 
     1267               ! This error check only works if you are using the bdyXmask arrays 
     1268               IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN 
     1269                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     1270                  icount = icount + 1 
     1271               ELSE 
     1272                  idx_bdy(ib_bdy)%flagv(ib,igrd) = -znfl + zsfl 
     1273               END IF 
     1274            END DO 
     1275            IF( icount /= 0 ) THEN 
     1276               IF(lwp) WRITE(numout,*) 
     1277               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   & 
     1278                  ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
     1279               IF(lwp) WRITE(numout,*) ' ========== ' 
     1280               IF(lwp) WRITE(numout,*) 
     1281               nstop = nstop + 1 
     1282            ENDIF  
    11541283         END DO 
    11551284 
    1156          IF( icount /= 0 ) THEN 
    1157             IF(lwp) WRITE(numout,*) 
    1158             IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,',   & 
    1159                ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_bdy 
    1160             IF(lwp) WRITE(numout,*) ' ========== ' 
    1161             IF(lwp) WRITE(numout,*) 
    1162             nstop = nstop + 1 
    1163          ENDIF  
    1164      
    1165       ENDDO 
     1285      END DO 
    11661286 
    11671287      ! Compute total lateral surface for volume correction: 
     
    11751295               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    11761296               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1177                flagu => idx_bdy(ib_bdy)%flagu(ib) 
     1297               flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 
    11781298               bdysurftot = bdysurftot + hu     (nbi  , nbj)                           & 
    11791299                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) & 
     
    11881308               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    11891309               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1190                flagv => idx_bdy(ib_bdy)%flagv(ib) 
     1310               flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 
    11911311               bdysurftot = bdysurftot + hv     (nbi, nbj  )                           & 
    11921312                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) & 
     
    12041324         DEALLOCATE(nbidta, nbjdta, nbrdta) 
    12051325      ENDIF 
     1326 
     1327      CALL wrk_dealloc(jpi,jpj,zfmask)  
    12061328 
    12071329      IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 
     
    15981720      itest = 0 
    15991721 
    1600       IF (nn_dyn2d(ib1)/=nn_dyn2d(ib2)) itest = itest + 1 
    1601       IF (nn_dyn3d(ib1)/=nn_dyn3d(ib2)) itest = itest + 1 
    1602       IF (nn_tra(ib1)/=nn_tra(ib2)) itest = itest + 1 
     1722      IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2)) itest = itest + 1 
     1723      IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2)) itest = itest + 1 
     1724      IF (cn_tra(ib1)/=cn_tra(ib2)) itest = itest + 1 
    16031725      ! 
    16041726      IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r3970 r4223  
    132132            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    133133            ! relaxation area       
    134             IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     134            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    135135               ilen0(:)=nblen(:) 
    136136            ELSE 
     
    414414 
    415415         ! line below should be simplified (runoff case) 
    416          IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 
     416!! CHANUT: TO BE SORTED OUT 
     417!!         IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 
     418         IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    417419 
    418420            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    419421            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    420422 
    421             IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     423            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    422424               ilen0(:)=nblen(:) 
    423425            ELSE 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r3777 r4223  
    2020   USE dom_oce         ! ocean space and time domain variables  
    2121   USE bdy_oce         ! ocean open boundary conditions 
     22   USE bdylib          ! for orlanski library routines 
    2223   USE bdydta, ONLY:   bf 
    2324   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     
    5152      DO ib_bdy=1, nb_bdy 
    5253 
    53          SELECT CASE( nn_tra(ib_bdy) ) 
    54          CASE(jp_none) 
     54         SELECT CASE( cn_tra(ib_bdy) ) 
     55         CASE('none') 
    5556            CYCLE 
    56          CASE(jp_frs) 
     57         CASE('frs') 
    5758            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    58          CASE(2) 
     59         CASE('specified') 
    5960            CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    60          CASE(3) 
     61         CASE('neumann') 
    6162            CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    62          CASE(4) 
     63         CASE('orlanski') 
     64            CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 
     65         CASE('orlanski_npo') 
     66            CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 
     67         CASE('runoff') 
    6368            CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    6469         CASE DEFAULT 
     
    196201      ! 
    197202   END SUBROUTINE bdy_tra_nmn 
     203  
     204 
     205   SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 
     206      !!---------------------------------------------------------------------- 
     207      !!                 ***  SUBROUTINE bdy_tra_orlanski  *** 
     208      !!              
     209      !!              - Apply Orlanski radiation to temperature and salinity.  
     210      !!              - Wrapper routine for bdy_orlanski_3d 
     211      !!  
     212      !! 
     213      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
     214      !!---------------------------------------------------------------------- 
     215      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     216      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     217      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
     218 
     219      INTEGER  ::   igrd                                    ! grid index 
     220      !!---------------------------------------------------------------------- 
     221 
     222      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 
     223      ! 
     224      igrd = 1      ! Orlanski bc on temperature;  
     225      !             
     226      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 
     227 
     228      igrd = 1      ! Orlanski bc on salinity; 
     229      !   
     230      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 
     231      ! 
     232      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 
     233      ! 
     234 
     235   END SUBROUTINE bdy_tra_orlanski 
     236 
    198237 
    199238   SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r3294 r4223  
    104104               ii = idx%nbi(jb,jgrd) 
    105105               ij = idx%nbj(jb,jgrd) 
    106                zubtpecor = zubtpecor + idx%flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     106               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
    107107            END DO 
    108108         END DO 
     
    112112               ii = idx%nbi(jb,jgrd) 
    113113               ij = idx%nbj(jb,jgrd) 
    114                zubtpecor = zubtpecor + idx%flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
     114               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
    115115            END DO 
    116116         END DO 
     
    136136               ii = idx%nbi(jb,jgrd) 
    137137               ij = idx%nbj(jb,jgrd) 
    138                ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb) * zubtpecor * umask(ii,ij,jk) 
    139                ztranst = ztranst + idx%flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     138               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk) 
     139               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
    140140            END DO 
    141141         END DO 
     
    145145               ii = idx%nbi(jb,jgrd) 
    146146               ij = idx%nbj(jb,jgrd) 
    147                va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb) * zubtpecor * vmask(ii,ij,jk) 
    148                ztranst = ztranst + idx%flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
     147               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk) 
     148               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
    149149            END DO 
    150150         END DO 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r3970 r4223  
    117117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
    118118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !: 
    119    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m) 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m) 
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m) 
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m) 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m) 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m) 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m) 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m) 
    123123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2) 
    124124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
     
    196196   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask        !: land/ocean mask of barotropic stream function 
    197197 
    198    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
     198   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    199199 
    200200   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
  • branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4221 r4223  
    766766         phur => hur_e 
    767767         phvr => hvr_e 
    768          pu2d => ua_e 
    769          pv2d => va_e 
     768         pua2d => ua_e 
     769         pva2d => va_e 
     770         pub2d => zun_e 
     771         pvb2d => zvn_e 
    770772                                       
    771773         IF( lk_bdy )   CALL bdy_dyn2d( kt )               ! open boundaries 
Note: See TracChangeset for help on using the changeset viewer.