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

Changeset 3991


Ignore:
Timestamp:
2013-07-29T11:04:44+02:00 (11 years ago)
Author:
davestorkey
Message:

New branch from later branch point on trunk so you can do a clean
diff of all the changes. Copy in changes from dev_r3891_METO1_MERCATOR6_OBC_BDY_merge.

Location:
branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC
Files:
1 added
12 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r3651 r3991  
    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 
     111   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyfmask   !: Mask defining computational domain at F-points 
    93112 
    94113   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary 
    95114 
    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       !:  
     115   REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh                  !:  
     116   REAL(wp), POINTER, DIMENSION(:,:)           ::   phur                  !:  
     117   REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr                  !: Pointers for barotropic fields  
     118   REAL(wp), POINTER, DIMENSION(:,:)           ::   pub2d, pun2d, pua2d   !:  
     119   REAL(wp), POINTER, DIMENSION(:,:)           ::   pvb2d, pvn2d, pva2d   !:  
    101120 
    102121   !!---------------------------------------------------------------------- 
    … …  
    109128   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy) 
    110129   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) 
     130   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
    112131 
    113132   !!---------------------------------------------------------------------- 
    … …  
    125144      !!---------------------------------------------------------------------- 
    126145      ! 
    127       ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),                    &   
     146      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), bdyfmask(jpi,jpj),     &   
    128147         &      STAT=bdy_oce_alloc ) 
    129148         ! 

  • branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90

    r3294 r3991  
    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_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r3909 r3991  
    8080      INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
    8181      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
     82      TYPE(OBC_DATA), POINTER             ::   dta              ! short cut 
    8283      !! 
    8384      !!--------------------------------------------------------------------------- 
    … …  
    9192         ! Calculate depth-mean currents 
    9293         !----------------------------- 
    93          CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
    94  
    95          pu2d(:,:) = 0.e0 
    96          pv2d(:,:) = 0.e0 
    97  
     94         CALL wrk_alloc(jpi,jpj,pun2d,pvn2d)  
     95 
     96         pun2d(:,:) = 0.e0 
     97         pvn2d(:,:) = 0.e0 
    9898         DO ik = 1, jpkm1   !! Vertically integrated momentum trends 
    99              pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
    100              pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
     99             pun2d(:,:) = pun2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
     100             pvn2d(:,:) = pvn2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
    101101         END DO 
    102          pu2d(:,:) = pu2d(:,:) * hur(:,:) 
    103          pv2d(:,:) = pv2d(:,:) * hvr(:,:) 
     102         pun2d(:,:) = pun2d(:,:) * hur(:,:) 
     103         pvn2d(:,:) = pvn2d(:,:) * hvr(:,:) 
    104104          
    105105         DO ib_bdy = 1, nb_bdy 
    … …  
    107107            nblen => idx_bdy(ib_bdy)%nblen 
    108108            nblenrim => idx_bdy(ib_bdy)%nblenrim 
    109  
    110             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
     109            dta => dta_bdy(ib_bdy) 
     110 
     111            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
    111112               ilen1(:) = nblen(:) 
    112                igrd = 1 
    113                DO ib = 1, ilen1(igrd) 
    114                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    115                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    116                   dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
    117                END DO  
    118                igrd = 2 
    119                DO ib = 1, ilen1(igrd) 
    120                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    121                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    122                   dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1)          
    123                END DO  
    124                igrd = 3 
    125                DO ib = 1, ilen1(igrd) 
    126                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    127                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    128                   dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1)          
    129                END DO  
    130             ENDIF 
    131  
    132             IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
    133                ilen1(:) = nblen(:) 
    134                igrd = 2  
    135                DO ib = 1, ilen1(igrd) 
    136                   DO ik = 1, jpkm1 
     113               IF( dta%ll_ssh ) THEN  
     114                  igrd = 1 
     115                  DO ib = 1, ilen1(igrd) 
    137116                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    138117                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    139                      dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)          
    140                   END DO 
    141                END DO  
    142                igrd = 3  
    143                DO ib = 1, ilen1(igrd) 
    144                   DO ik = 1, jpkm1 
     118                     dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
     119                  END DO  
     120               END IF 
     121               IF( dta%ll_u2d ) THEN  
     122                  igrd = 2 
     123                  DO ib = 1, ilen1(igrd) 
    145124                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    146125                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    147                      dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik)          
    148                      END DO 
    149                END DO  
    150             ENDIF 
    151  
    152             IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
    153                ilen1(:) = nblen(:) 
    154                igrd = 1                       ! Everything is at T-points here 
    155                DO ib = 1, ilen1(igrd) 
    156                   DO ik = 1, jpkm1 
     126                     dta_bdy(ib_bdy)%u2d(ib) = pun2d(ii,ij) * umask(ii,ij,1)          
     127                  END DO  
     128               END IF 
     129               IF( dta%ll_v2d ) THEN  
     130                  igrd = 3 
     131                  DO ib = 1, ilen1(igrd) 
    157132                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    158133                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    159                      dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
    160                      dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
    161                   END DO 
    162                END DO  
    163             ENDIF 
    164  
    165 #if defined key_lim2 
    166             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
     134                     dta_bdy(ib_bdy)%v2d(ib) = pvn2d(ii,ij) * vmask(ii,ij,1)          
     135                  END DO  
     136               END IF 
     137            ENDIF 
     138 
     139            IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
    167140               ilen1(:) = nblen(:) 
    168                igrd = 1                       ! Everything is at T-points here 
    169                DO ib = 1, ilen1(igrd) 
    170                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    171                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    172                   dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
    173                   dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
    174                   dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
    175                END DO  
     141               IF( dta%ll_u3d ) THEN  
     142                  igrd = 2  
     143                  DO ib = 1, ilen1(igrd) 
     144                     DO ik = 1, jpkm1 
     145                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     146                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     147                        dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pun2d(ii,ij) ) * umask(ii,ij,ik)          
     148                     END DO 
     149                  END DO  
     150               END IF 
     151               IF( dta%ll_v3d ) THEN  
     152                  igrd = 3  
     153                  DO ib = 1, ilen1(igrd) 
     154                     DO ik = 1, jpkm1 
     155                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     156                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     157                        dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pvn2d(ii,ij) ) * vmask(ii,ij,ik)          
     158                        END DO 
     159                  END DO  
     160               END IF 
     161            ENDIF 
     162 
     163            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
     164               ilen1(:) = nblen(:) 
     165               IF( dta%ll_tem ) THEN 
     166                  igrd = 1  
     167                  DO ib = 1, ilen1(igrd) 
     168                     DO ik = 1, jpkm1 
     169                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     170                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     171                        dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
     172                     END DO 
     173                  END DO  
     174               END IF 
     175               IF( dta%ll_sal ) THEN 
     176                  igrd = 1  
     177                  DO ib = 1, ilen1(igrd) 
     178                     DO ik = 1, jpkm1 
     179                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     180                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     181                        dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
     182                     END DO 
     183                  END DO  
     184               END IF 
     185            ENDIF 
     186 
     187#if defined key_lim2 
     188            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
     189               ilen1(:) = nblen(:) 
     190               IF( dta%ll_frld ) THEN 
     191                  igrd = 1  
     192                  DO ib = 1, ilen1(igrd) 
     193                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     194                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     195                     dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
     196                  END DO  
     197               END IF 
     198               IF( dta%ll_hicif ) THEN 
     199                  igrd = 1  
     200                  DO ib = 1, ilen1(igrd) 
     201                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     202                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     203                     dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
     204                  END DO  
     205               END IF 
     206               IF( dta%ll_hsnif ) THEN 
     207                  igrd = 1  
     208                  DO ib = 1, ilen1(igrd) 
     209                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     210                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     211                     dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
     212                  END DO  
     213               END IF 
    176214            ENDIF 
    177215#endif 
    … …  
    179217         ENDDO ! ib_bdy 
    180218 
    181          CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     219         CALL wrk_dealloc(jpi,jpj,pun2d,pvn2d)  
    182220 
    183221      ENDIF ! kt .eq. nit000 
    … …  
    188226      jstart = 1 
    189227      DO ib_bdy = 1, nb_bdy    
     228         dta => dta_bdy(ib_bdy) 
    190229         IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 
    191230       
    … …  
    193232               ! Update barotropic boundary conditions only 
    194233               ! jit is optional argument for fld_read and bdytide_update 
    195                IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     234               IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    196235                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    197                      dta_bdy(ib_bdy)%ssh(:) = 0.0 
    198                      dta_bdy(ib_bdy)%u2d(:) = 0.0 
    199                      dta_bdy(ib_bdy)%v2d(:) = 0.0 
     236                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
     237                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
     238                     IF( dta%ll_u3d ) dta%v2d(:) = 0.0 
    200239                  ENDIF 
    201                   IF (nn_tra(ib_bdy).ne.4) THEN 
    202                      IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
    203                        & (ln_full_vel_array(ib_bdy) .AND. nn_dyn3d_dta(ib_bdy).eq.1) )THEN 
    204  
    205                         ! For the runoff case, no need to update the forcing (already done in the baroclinic part) 
    206                         jend = nb_bdy_fld(ib_bdy) 
    207                         IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2 
     240                  IF (cn_tra(ib_bdy) /= 'runoff') THEN 
     241                     IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN 
     242 
     243                        jend = jstart + dta%nread(2) - 1 
    208244                        CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    209245                                     & kit=jit, kt_offset=time_offset ) 
    210                         IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2 
    211  
    212                         ! If full velocities in boundary data then split into barotropic and baroclinic data 
     246 
     247                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields 
    213248                        IF( ln_full_vel_array(ib_bdy) .AND.                                             & 
    214249                          &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
    … …  
    216251 
    217252                           igrd = 2                      ! zonal velocity 
    218                            dta_bdy(ib_bdy)%u2d(:) = 0.0 
     253                           dta%u2d(:) = 0.0 
    219254                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    220255                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    221256                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    222257                              DO ik = 1, jpkm1 
    223                                  dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 
    224                        &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 
     258                                 dta%u2d(ib) = dta%u2d(ib) & 
     259                       &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    225260                              END DO 
    226                               dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 
    227                               DO ik = 1, jpkm1 
    228                                  dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
    229                               END DO 
     261                              dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
    230262                           END DO 
    231263                           igrd = 3                      ! meridional velocity 
    232                            dta_bdy(ib_bdy)%v2d(:) = 0.0 
     264                           dta%v2d(:) = 0.0 
    233265                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    234266                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    235267                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    236268                              DO ik = 1, jpkm1 
    237                                  dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 
    238                        &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 
     269                                 dta%v2d(ib) = dta%v2d(ib) & 
     270                       &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    239271                              END DO 
    240                               dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 
    241                               DO ik = 1, jpkm1 
    242                                  dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
    243                               END DO 
     272                              dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
    244273                           END DO 
    245274                        ENDIF                     
    246275                     ENDIF 
    247276                     IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
    248                         CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy),   &  
     277                        CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta, td=tides(ib_bdy),   &  
    249278                          &                 jit=jit, time_offset=time_offset ) 
    250279                     ENDIF 
    … …  
    252281               ENDIF 
    253282            ELSE 
    254                IF (nn_tra(ib_bdy).eq.4) then      ! runoff condition 
     283               IF (cn_tra(ib_bdy) == 'runoff') then      ! runoff condition 
    255284                  jend = nb_bdy_fld(ib_bdy) 
    256285                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  & 
    … …  
    261290                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    262291                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    263                      dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
     292                     dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
    264293                  END DO 
    265294                  ! 
    … …  
    268297                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    269298                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    270                      dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
     299                     dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
    271300                  END DO 
    272301               ELSE 
    273                   IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    274                      dta_bdy(ib_bdy)%ssh(:) = 0.0 
    275                      dta_bdy(ib_bdy)%u2d(:) = 0.0 
    276                      dta_bdy(ib_bdy)%v2d(:) = 0.0 
     302                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     303                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
     304                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
     305                     IF( dta%ll_v2d ) dta%v2d(:) = 0.0 
    277306                  ENDIF 
    278                   IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data 
    279                      jend = nb_bdy_fld(ib_bdy) 
     307                  IF( dta%nread(1) .gt. 0 ) THEN ! update external data 
     308                     jend = jstart + dta%nread(1) - 1 
    280309                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    281310                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 
    … …  
    286315                    &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN 
    287316                     igrd = 2                      ! zonal velocity 
    288                      dta_bdy(ib_bdy)%u2d(:) = 0.0 
     317                     dta%u2d(:) = 0.0 
    289318                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    290319                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    291320                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    292321                        DO ik = 1, jpkm1 
    293                            dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 
    294                  &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 
     322                           dta%u2d(ib) = dta%u2d(ib) & 
     323                 &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    295324                        END DO 
    296                         dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 
     325                        dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
    297326                        DO ik = 1, jpkm1 
    298                            dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
     327                           dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
    299328                        END DO 
    300329                     END DO 
    301330                     igrd = 3                      ! meridional velocity 
    302                      dta_bdy(ib_bdy)%v2d(:) = 0.0 
     331                     dta%v2d(:) = 0.0 
    303332                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    304333                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    305334                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    306335                        DO ik = 1, jpkm1 
    307                            dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 
    308                  &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 
     336                           dta%v2d(ib) = dta%v2d(ib) & 
     337                 &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    309338                        END DO 
    310                         dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 
     339                        dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
    311340                        DO ik = 1, jpkm1 
    312                            dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
     341                           dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 
    313342                        END DO 
    314343                     END DO 
    315344                  ENDIF 
    316                   IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
    317                      CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy),  & 
     345                  IF( cn_dyn2d(ib_bdy) /= 'none' .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
     346                     CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta,  & 
    318347                                        & td=tides(ib_bdy), time_offset=time_offset ) 
    319348                  ENDIF 
    320349               ENDIF 
    321350            ENDIF 
    322             jstart = jend+1 
     351            jstart = jstart + dta%nread(1) 
    323352         END IF ! nn_dta(ib_bdy) = 1 
    324353      END DO  ! ib_bdy 
    … …  
    326355      IF ( ln_apr_obc ) THEN 
    327356         DO ib_bdy = 1, nb_bdy 
    328             IF (nn_tra(ib_bdy).NE.4)THEN 
     357            IF (cn_tra(ib_bdy) /= 'runoff')THEN 
    329358               igrd = 1                      ! meridional velocity 
    330359               DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    … …  
    349378      !!                for open boundary conditions 
    350379      !! 
    351       !! ** Method  :   Use fldread.F90 
     380      !! ** Method  :    
    352381      !!                 
    353382      !!---------------------------------------------------------------------- 
    … …  
    361390                                                                ! =F => baroclinic velocities in 3D boundary data 
    362391      INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays 
    363       INTEGER,              DIMENSION(jpbgrd) ::  ilen0         ! size of local arrays 
    364392      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays 
    365393      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld 
    366394      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V) 
    367395      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts 
     396      TYPE(OBC_DATA), POINTER                ::   dta           ! short cut 
    368397      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures 
    369398      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
    … …  
    403432      nb_bdy_fld(:) = 0 
    404433      DO ib_bdy = 1, nb_bdy          
    405          IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
     434         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
    406435            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    407436         ENDIF 
    408          IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
     437         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
    409438            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    410439         ENDIF 
    411          IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
     440         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
    412441            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    413442         ENDIF 
    414443#if defined key_lim2 
    415          IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
     444         IF( cn_ice_lim2(ib_bdy) /= 'none' .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
    416445            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    417446         ENDIF 
    … …  
    471500            nblen => idx_bdy(ib_bdy)%nblen 
    472501            nblenrim => idx_bdy(ib_bdy)%nblenrim 
     502            dta => dta_bdy(ib_bdy) 
     503            dta%nread(2) = 0 
    473504 
    474505            ! Only read in necessary fields for this set. 
    475506            ! Important that barotropic variables come first. 
    476             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN  
    477  
    478                IF( nn_dyn2d(ib_bdy) .ne. jp_frs .and. nn_tra(ib_bdy) .ne. 4 ) THEN ! runoff condition : no ssh reading 
     507            IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN  
     508 
     509               IF( dta%ll_ssh ) THEN  
     510                  if(lwp) write(numout,*) '++++++ reading in ssh field' 
    479511                  jfld = jfld + 1 
    480512                  blf_i(jfld) = bn_ssh 
    … …  
    483515                  ilen1(jfld) = nblen(igrid(jfld)) 
    484516                  ilen3(jfld) = 1 
    485                ENDIF 
    486  
    487                IF( .not. ln_full_vel_array(ib_bdy) ) THEN 
     517                  dta%nread(2) = dta%nread(2) + 1 
     518               ENDIF 
     519 
     520               IF( dta%ll_u2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 
     521                  if(lwp) write(numout,*) '++++++ reading in u2d field' 
    488522                  jfld = jfld + 1 
    489523                  blf_i(jfld) = bn_u2d 
    … …  
    492526                  ilen1(jfld) = nblen(igrid(jfld)) 
    493527                  ilen3(jfld) = 1 
    494  
     528                  dta%nread(2) = dta%nread(2) + 1 
     529               ENDIF 
     530 
     531               IF( dta%ll_v2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 
     532                  if(lwp) write(numout,*) '++++++ reading in v2d field' 
    495533                  jfld = jfld + 1 
    496534                  blf_i(jfld) = bn_v2d 
    … …  
    499537                  ilen1(jfld) = nblen(igrid(jfld)) 
    500538                  ilen3(jfld) = 1 
    501                ENDIF 
    502  
    503             ENDIF 
    504  
    505             ! baroclinic velocities 
    506             IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. & 
    507            &      ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.  & 
    508            &        ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    509  
    510                jfld = jfld + 1 
    511                blf_i(jfld) = bn_u3d 
    512                ibdy(jfld) = ib_bdy 
    513                igrid(jfld) = 2 
    514                ilen1(jfld) = nblen(igrid(jfld)) 
    515                ilen3(jfld) = jpk 
    516  
    517                jfld = jfld + 1 
    518                blf_i(jfld) = bn_v3d 
    519                ibdy(jfld) = ib_bdy 
    520                igrid(jfld) = 3 
    521                ilen1(jfld) = nblen(igrid(jfld)) 
    522                ilen3(jfld) = jpk 
     539                  dta%nread(2) = dta%nread(2) + 1 
     540               ENDIF 
     541 
     542            ENDIF 
     543 
     544            ! read 3D velocities if baroclinic velocities require OR if 
     545            ! barotropic velocities required and ln_full_vel set to .true. 
     546            IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
     547           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     548 
     549               IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     550                  if(lwp) write(numout,*) '++++++ reading in u3d field' 
     551                  jfld = jfld + 1 
     552                  blf_i(jfld) = bn_u3d 
     553                  ibdy(jfld) = ib_bdy 
     554                  igrid(jfld) = 2 
     555                  ilen1(jfld) = nblen(igrid(jfld)) 
     556                  ilen3(jfld) = jpk 
     557                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 
     558               ENDIF 
     559 
     560               IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     561                  if(lwp) write(numout,*) '++++++ reading in v3d field' 
     562                  jfld = jfld + 1 
     563                  blf_i(jfld) = bn_v3d 
     564                  ibdy(jfld) = ib_bdy 
     565                  igrid(jfld) = 3 
     566                  ilen1(jfld) = nblen(igrid(jfld)) 
     567                  ilen3(jfld) = jpk 
     568                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 
     569               ENDIF 
    523570 
    524571            ENDIF 
    525572 
    526573            ! temperature and salinity 
    527             IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
    528  
    529                jfld = jfld + 1 
    530                blf_i(jfld) = bn_tem 
    531                ibdy(jfld) = ib_bdy 
    532                igrid(jfld) = 1 
    533                ilen1(jfld) = nblen(igrid(jfld)) 
    534                ilen3(jfld) = jpk 
    535  
    536                jfld = jfld + 1 
    537                blf_i(jfld) = bn_sal 
    538                ibdy(jfld) = ib_bdy 
    539                igrid(jfld) = 1 
    540                ilen1(jfld) = nblen(igrid(jfld)) 
    541                ilen3(jfld) = jpk 
     574            IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
     575 
     576               IF( dta%ll_tem ) THEN 
     577                  if(lwp) write(numout,*) '++++++ reading in tem field' 
     578                  jfld = jfld + 1 
     579                  blf_i(jfld) = bn_tem 
     580                  ibdy(jfld) = ib_bdy 
     581                  igrid(jfld) = 1 
     582                  ilen1(jfld) = nblen(igrid(jfld)) 
     583                  ilen3(jfld) = jpk 
     584               ENDIF 
     585 
     586               IF( dta%ll_sal ) THEN 
     587                  if(lwp) write(numout,*) '++++++ reading in sal field' 
     588                  jfld = jfld + 1 
     589                  blf_i(jfld) = bn_sal 
     590                  ibdy(jfld) = ib_bdy 
     591                  igrid(jfld) = 1 
     592                  ilen1(jfld) = nblen(igrid(jfld)) 
     593                  ilen3(jfld) = jpk 
     594               ENDIF 
    542595 
    543596            ENDIF 
    … …  
    545598#if defined key_lim2 
    546599            ! sea ice 
    547             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
    548  
    549                jfld = jfld + 1 
    550                blf_i(jfld) = bn_frld 
    551                ibdy(jfld) = ib_bdy 
    552                igrid(jfld) = 1 
    553                ilen1(jfld) = nblen(igrid(jfld)) 
    554                ilen3(jfld) = 1 
    555  
    556                jfld = jfld + 1 
    557                blf_i(jfld) = bn_hicif 
    558                ibdy(jfld) = ib_bdy 
    559                igrid(jfld) = 1 
    560                ilen1(jfld) = nblen(igrid(jfld)) 
    561                ilen3(jfld) = 1 
    562  
    563                jfld = jfld + 1 
    564                blf_i(jfld) = bn_hsnif 
    565                ibdy(jfld) = ib_bdy 
    566                igrid(jfld) = 1 
    567                ilen1(jfld) = nblen(igrid(jfld)) 
    568                ilen3(jfld) = 1 
     600            IF( nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
     601 
     602               IF( dta%ll_frld ) THEN 
     603                  jfld = jfld + 1 
     604                  blf_i(jfld) = bn_frld 
     605                  ibdy(jfld) = ib_bdy 
     606                  igrid(jfld) = 1 
     607                  ilen1(jfld) = nblen(igrid(jfld)) 
     608                  ilen3(jfld) = 1 
     609               ENDIF 
     610 
     611               IF( dta%ll_hicif ) THEN 
     612                  jfld = jfld + 1 
     613                  blf_i(jfld) = bn_hicif 
     614                  ibdy(jfld) = ib_bdy 
     615                  igrid(jfld) = 1 
     616                  ilen1(jfld) = nblen(igrid(jfld)) 
     617                  ilen3(jfld) = 1 
     618               ENDIF 
     619 
     620               IF( dta%ll_hsnif ) THEN 
     621                  jfld = jfld + 1 
     622                  blf_i(jfld) = bn_hsnif 
     623                  ibdy(jfld) = ib_bdy 
     624                  igrid(jfld) = 1 
     625                  ilen1(jfld) = nblen(igrid(jfld)) 
     626                  ilen3(jfld) = 1 
     627               ENDIF 
    569628 
    570629            ENDIF 
    … …  
    581640            ENDIF 
    582641 
     642            dta%nread(1) = nb_bdy_fld(ib_bdy) 
     643 
    583644         ENDIF ! nn_dta .eq. 1 
    584645      ENDDO ! ib_bdy 
    … …  
    609670 
    610671         nblen => idx_bdy(ib_bdy)%nblen 
    611          nblenrim => idx_bdy(ib_bdy)%nblenrim 
    612  
    613          IF (nn_dyn2d(ib_bdy) .gt. 0) THEN 
    614             IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN 
    615                ilen0(1:3) = nblen(1:3) 
    616                ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) ) 
    617                ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) ) 
    618                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 
    619                   jfld = jfld + 1 
    620                   dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 
     672         dta => dta_bdy(ib_bdy) 
     673 
     674         if(lwp) then 
     675            write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 
     676            write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 
     677            write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 
     678            write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 
     679            write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 
     680            write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 
     681            write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 
     682         endif 
     683 
     684         IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN 
     685            if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 
     686            IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 
     687            IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 
     688            IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 
     689         ENDIF 
     690         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 
     691            IF( dta%ll_ssh ) THEN 
     692               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 
     693               jfld = jfld + 1 
     694               dta%ssh => bf(jfld)%fnow(:,1,1) 
     695            ENDIF 
     696            IF ( dta%ll_u2d ) THEN 
     697               IF ( ln_full_vel_array(ib_bdy) ) THEN 
     698                  if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 
     699                  ALLOCATE( dta%u2d(nblen(2)) ) 
    621700               ELSE 
    622                   ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) ) 
    623                ENDIF 
    624             ELSE 
    625                IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 
    626                   jfld = jfld + 1 
    627                   dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 
    628                ENDIF 
     701                  if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 
     702                  jfld = jfld + 1 
     703                  dta%u2d => bf(jfld)%fnow(:,1,1) 
     704               ENDIF 
     705            ENDIF 
     706            IF ( dta%ll_v2d ) THEN 
     707               IF ( ln_full_vel_array(ib_bdy) ) THEN 
     708                  if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 
     709                  ALLOCATE( dta%v2d(nblen(3)) ) 
     710               ELSE 
     711                  if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 
     712                  jfld = jfld + 1 
     713                  dta%v2d => bf(jfld)%fnow(:,1,1) 
     714               ENDIF 
     715            ENDIF 
     716         ENDIF 
     717 
     718         IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
     719            if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 
     720            IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 
     721            IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 
     722         ENDIF 
     723         IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
     724           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     725            IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     726               if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 
    629727               jfld = jfld + 1 
    630                dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1) 
     728               dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 
     729            ENDIF 
     730            IF ( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     731               if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 
    631732               jfld = jfld + 1 
    632                dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1) 
    633             ENDIF 
    634          ENDIF 
    635  
    636          IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
    637             ilen0(1:3) = nblen(1:3) 
    638             ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) ) 
    639             ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) ) 
    640          ENDIF 
    641          IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. & 
    642            &  ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.   & 
    643            &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    644             jfld = jfld + 1 
    645             dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 
    646             jfld = jfld + 1 
    647             dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 
    648          ENDIF 
    649  
    650          IF (nn_tra(ib_bdy) .gt. 0) THEN 
    651             IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
    652                ilen0(1:3) = nblen(1:3) 
    653                ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) ) 
    654                ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) ) 
    655             ELSE 
     733               dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 
     734            ENDIF 
     735         ENDIF 
     736 
     737         IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
     738            if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 
     739            IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) 
     740            IF( dta%ll_sal ) ALLOCATE( dta_bdy(ib_bdy)%sal(nblen(1),jpk) ) 
     741         ELSE 
     742            IF( dta%ll_tem ) THEN 
     743               if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 
    656744               jfld = jfld + 1 
    657745               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:) 
     746            ENDIF 
     747            IF( dta%ll_sal ) THEN  
     748               if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 
    658749               jfld = jfld + 1 
    659750               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:) 
    … …  
    664755         IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 
    665756            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 
    666                ilen0(1:3) = nblen(1:3) 
    667                ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) ) 
    668                ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) ) 
    669                ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) ) 
     757               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 
     758               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 
     759               ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) ) 
    670760            ELSE 
    671761               jfld = jfld + 1 

  • branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r3968 r3991  
    3030   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3131   USE in_out_manager  ! 
    32    USE domvvl          ! variable volume 
    3332 
    3433   IMPLICIT NONE 
    … …  
    5756      LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities 
    5857      !! 
    59       INTEGER               :: jk,ii,ij,ib,igrd     ! Loop counter 
    60       LOGICAL               :: ll_dyn2d, ll_dyn3d   
     58      INTEGER               :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter 
     59      LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski 
    6160      !! 
    6261 
    … …  
    7069      ENDIF 
    7170 
     71      ll_orlanski = .false. 
     72      DO ib_bdy = 1, nb_bdy 
     73         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 
     74     &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 
     75      ENDDO 
     76 
    7277      !------------------------------------------------------- 
    7378      ! Set pointers 
    … …  
    7782      phur => hur 
    7883      phvr => hvr 
    79       CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
     84      CALL wrk_alloc(jpi,jpj,pua2d,pva2d)  
     85      IF ( ll_orlanski ) CALL wrk_alloc(jpi,jpj,pub2d,pvb2d)  
    8086 
    8187      !------------------------------------------------------- 
    … …  
    8389      !------------------------------------------------------- 
    8490 
    85       pu2d(:,:) = 0.e0 
    86       pv2d(:,:) = 0.e0 
    87       IF (lk_vvl) THEN 
     91      ! "After" velocities:  
     92 
     93      pua2d(:,:) = 0.e0 
     94      pva2d(:,:) = 0.e0 
     95      DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
     96          pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
     97          pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     98      END DO 
     99      pua2d(:,:) = pua2d(:,:) * phur(:,:) 
     100      pva2d(:,:) = pva2d(:,:) * phvr(:,:) 
     101      DO jk = 1 , jpkm1 
     102         ua(:,:,jk) = ua(:,:,jk) - pua2d(:,:) 
     103         va(:,:,jk) = va(:,:,jk) - pva2d(:,:) 
     104      END DO 
     105 
     106      ! "Before" velocities (required for Orlanski condition):  
     107 
     108      IF ( ll_orlanski ) THEN 
     109         pub2d(:,:) = 0.e0 
     110         pvb2d(:,:) = 0.e0 
    88111         DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    89             pu2d(:,:) = pu2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    90             pv2d(:,:) = pv2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     112             pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 
     113             pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 
    91114         END DO 
    92          pu2d(:,:) = pu2d(:,:) / ( hu_0(:,:) + sshu_a(:,:) + 1._wp - umask(:,:,1) ) 
    93          pv2d(:,:) = pv2d(:,:) / ( hv_0(:,:) + sshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
    94       ELSE 
    95          DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    96             pu2d(:,:) = pu2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    97             pv2d(:,:) = pv2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     115         pub2d(:,:) = pub2d(:,:) * phur(:,:) 
     116         pvb2d(:,:) = pvb2d(:,:) * phvr(:,:) 
     117         DO jk = 1 , jpkm1 
     118            ub(:,:,jk) = ub(:,:,jk) - pub2d(:,:) 
     119            vb(:,:,jk) = vb(:,:,jk) - pvb2d(:,:) 
    98120         END DO 
    99          pu2d(:,:) = pu2d(:,:) * phur(:,:) 
    100          pv2d(:,:) = pv2d(:,:) * phvr(:,:) 
    101       ENDIF 
    102       DO jk = 1 , jpkm1 
    103          ua(:,:,jk) = ua(:,:,jk) - pu2d(:,:) * umask(:,:,jk) 
    104          va(:,:,jk) = va(:,:,jk) - pv2d(:,:) * vmask(:,:,jk) 
    105       END DO 
     121      END IF 
    106122 
    107123      !------------------------------------------------------- 
    … …  
    119135 
    120136      DO jk = 1 , jpkm1 
    121          ua(:,:,jk) = ( ua(:,:,jk) + pu2d(:,:) ) * umask(:,:,jk) 
    122          va(:,:,jk) = ( va(:,:,jk) + pv2d(:,:) ) * vmask(:,:,jk) 
     137         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 
     138         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 
    123139      END DO 
    124140 
    125       CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     141      IF ( ll_orlanski ) THEN 
     142         DO jk = 1 , jpkm1 
     143            ub(:,:,jk) = ( ub(:,:,jk) + pub2d(:,:) ) * umask(:,:,jk) 
     144            vb(:,:,jk) = ( vb(:,:,jk) + pvb2d(:,:) ) * vmask(:,:,jk) 
     145         END DO 
     146      END IF 
     147 
     148      CALL wrk_dealloc(jpi,jpj,pua2d,pva2d)  
     149      IF ( ll_orlanski ) CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d)  
    126150 
    127151      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 

  • branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r3680 r3991  
    1818   USE dom_oce         ! ocean space and time domain 
    1919   USE bdy_oce         ! ocean open boundary conditions 
     20   USE bdylib          ! BDY library routines 
    2021   USE dynspg_oce      ! for barotropic variables 
    2122   USE phycst          ! physical constants 
    … …  
    2627   PRIVATE 
    2728 
    28    PUBLIC   bdy_dyn2d     ! routine called in dynspg_ts and bdy_dyn 
     29   PUBLIC   bdy_dyn2d   ! routine called in dynspg_ts and bdy_dyn 
    2930 
    3031   !!---------------------------------------------------------------------- 
    … …  
    4849      DO ib_bdy=1, nb_bdy 
    4950 
    50          SELECT CASE( nn_dyn2d(ib_bdy) ) 
    51          CASE(jp_none) 
     51         SELECT CASE( cn_dyn2d(ib_bdy) ) 
     52         CASE('none') 
    5253            CYCLE 
    53          CASE(jp_frs) 
     54         CASE('frs') 
    5455            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    55          CASE(jp_flather) 
     56         CASE('flather') 
    5657            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
     58         CASE('orlanski') 
     59            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     60         CASE('orlanski_npo') 
     61            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    5762         CASE DEFAULT 
    5863            CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
    … …  
    8994         ij   = idx%nbj(jb,igrd) 
    9095         zwgt = idx%nbw(jb,igrd) 
    91          pu2d(ii,ij) = ( pu2d(ii,ij) + zwgt * ( dta%u2d(jb) - pu2d(ii,ij) ) ) * umask(ii,ij,1) 
     96         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1) 
    9297      END DO 
    9398      ! 
    … …  
    97102         ij   = idx%nbj(jb,igrd) 
    98103         zwgt = idx%nbw(jb,igrd) 
    99          pv2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1) 
     104         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 
    100105      END DO  
    101       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )  
    102       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
     106      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )  
     107      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
    103108      ! 
    104109      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs') 
    … …  
    133138      INTEGER  ::   jb, igrd                         ! dummy loop indices 
    134139      INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses 
     140      REAL(wp), POINTER :: flagu, flagv              ! short cuts 
    135141      REAL(wp) ::   zcorr                            ! Flather correction 
    136142      REAL(wp) ::   zforc                            ! temporary scalar 
    … …  
    160166         ii  = idx%nbi(jb,igrd) 
    161167         ij  = idx%nbj(jb,igrd)  
    162          iim1 = ii + MAX( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice inside the boundary 
    163          iip1 = ii - MIN( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice outside the boundary  
     168         flagu => idx%flagu(jb,igrd) 
     169         iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary 
     170         iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary  
    164171         ! 
    165          zcorr = - idx%flagu(jb) * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
     172         zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
    166173         zforc = dta%u2d(jb) 
    167          pu2d(ii,ij) = zforc + zcorr * umask(ii,ij,1)  
     174         pua2d(ii,ij) = zforc + zcorr * umask(ii,ij,1)  
    168175      END DO 
    169176      ! 
    … …  
    173180         ii  = idx%nbi(jb,igrd) 
    174181         ij  = idx%nbj(jb,igrd)  
    175          ijm1 = ij + MAX( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice inside the boundary 
    176          ijp1 = ij - MIN( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice outside the boundary  
     182         flagv => idx%flagv(jb,igrd) 
     183         ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary 
     184         ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary  
    177185         ! 
    178          zcorr = - idx%flagv(jb) * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
     186         zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
    179187         zforc = dta%v2d(jb) 
    180          pv2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 
    181       END DO 
    182       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
    183       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy )   ! 
     188         pva2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 
     189      END DO 
     190      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
     191      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   ! 
    184192      ! 
    185193      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla') 
    186194      ! 
    187195   END SUBROUTINE bdy_dyn2d_fla 
     196 
     197 
     198   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     199      !!---------------------------------------------------------------------- 
     200      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  *** 
     201      !!              
     202      !!              - Apply Orlanski radiation condition adaptively: 
     203      !!                  - radiation plus weak nudging at outflow points 
     204      !!                  - no radiation and strong nudging at inflow points 
     205      !!  
     206      !! 
     207      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
     208      !!---------------------------------------------------------------------- 
     209      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     210      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     211      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set 
     212      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version 
     213 
     214      INTEGER  ::   ib, igrd                               ! dummy loop indices 
     215      INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices 
     216      !!---------------------------------------------------------------------- 
     217 
     218      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_orlanski') 
     219      ! 
     220      igrd = 2      ! Orlanski bc on u-velocity;  
     221      !             
     222      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ll_npo ) 
     223 
     224      igrd = 3      ! Orlanski bc on v-velocity 
     225      !   
     226      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo ) 
     227      ! 
     228      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 
     229      ! 
     230      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
     231      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   ! 
     232      ! 
     233      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 
     234      ! 
     235   END SUBROUTINE bdy_dyn2d_orlanski 
     236 
    188237#else 
    189238   !!---------------------------------------------------------------------- 

  • branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r3703 r3991  
    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_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

    r3906 r3991  
    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_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r3909 r3991  
    7979      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
    8080      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
     81      INTEGER  ::   i_offset, j_offset                     !   -       - 
    8182      INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts 
    82       REAL   , POINTER  ::  flagu, flagv                   !    -   - 
     83      REAL(wp), POINTER  ::  flagu, flagv                  !    -   - 
     84      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
    8385      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
    8486      INTEGER, DIMENSION (2)                  ::   kdimsz 
    … …  
    9294 
    9395      !! 
    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,             & 
     96      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,                 & 
     97         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,    & 
     98         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
     99         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    98100#if defined key_lim2 
    99          &             nn_ice_lim2, nn_ice_lim2_dta,                       & 
     101         &             cn_ice_lim2, nn_ice_lim2_dta,                           & 
    100102#endif 
    101103         &             ln_vol, nn_volctl, nn_rimwidth 
    … …  
    128130      ln_mask_file      = .false. 
    129131      cn_mask_file(:)   = '' 
    130       nn_dyn2d(:)       = 0 
     132      cn_dyn2d(:)       = '' 
    131133      nn_dyn2d_dta(:)   = -1  ! uninitialised flag 
    132       nn_dyn3d(:)       = 0 
     134      cn_dyn3d(:)       = '' 
    133135      nn_dyn3d_dta(:)   = -1  ! uninitialised flag 
    134       nn_tra(:)         = 0 
     136      cn_tra(:)         = '' 
    135137      nn_tra_dta(:)     = -1  ! uninitialised flag 
    136138      ln_tra_dmp(:)     = .false. 
    … …  
    138140      rn_time_dmp(:)    = 1. 
    139141#if defined key_lim2 
    140       nn_ice_lim2(:)    = 0 
     142      cn_ice_lim2(:)    = '' 
    141143      nn_ice_lim2_dta(:)= -1  ! uninitialised flag 
    142144#endif 
    … …  
    172174 
    173175        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
    174         SELECT CASE( nn_dyn2d(ib_bdy) )                   
    175           CASE(jp_none)         ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    176           CASE(jp_frs)          ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    177           CASE(jp_flather)      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
    178           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn2d' ) 
     176        SELECT CASE( cn_dyn2d(ib_bdy) )                   
     177          CASE('none')          
     178             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     179             dta_bdy(ib_bdy)%ll_ssh = .false. 
     180             dta_bdy(ib_bdy)%ll_u2d = .false. 
     181             dta_bdy(ib_bdy)%ll_v2d = .false. 
     182          CASE('frs')           
     183             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     184             dta_bdy(ib_bdy)%ll_ssh = .false. 
     185             dta_bdy(ib_bdy)%ll_u2d = .true. 
     186             dta_bdy(ib_bdy)%ll_v2d = .true. 
     187          CASE('flather')       
     188             IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
     189             dta_bdy(ib_bdy)%ll_ssh = .true. 
     190             dta_bdy(ib_bdy)%ll_u2d = .true. 
     191             dta_bdy(ib_bdy)%ll_v2d = .true. 
     192          CASE('orlanski')      
     193             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     194             dta_bdy(ib_bdy)%ll_ssh = .false. 
     195             dta_bdy(ib_bdy)%ll_u2d = .true. 
     196             dta_bdy(ib_bdy)%ll_v2d = .true. 
     197          CASE('orlanski_npo')  
     198             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     199             dta_bdy(ib_bdy)%ll_ssh = .false. 
     200             dta_bdy(ib_bdy)%ll_u2d = .true. 
     201             dta_bdy(ib_bdy)%ll_v2d = .true. 
     202          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' ) 
    179203        END SELECT 
    180         IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     204        IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    181205           SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   !  
    182206              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    193217 
    194218        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  ' 
    195         SELECT CASE( nn_dyn3d(ib_bdy) )                   
    196           CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    197           CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    198           CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value' 
    199           CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
    200           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn3d' ) 
     219        SELECT CASE( cn_dyn3d(ib_bdy) )                   
     220          CASE('none') 
     221             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     222             dta_bdy(ib_bdy)%ll_u3d = .false. 
     223             dta_bdy(ib_bdy)%ll_v3d = .false. 
     224          CASE('frs')        
     225             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     226             dta_bdy(ib_bdy)%ll_u3d = .true. 
     227             dta_bdy(ib_bdy)%ll_v3d = .true. 
     228          CASE('specified') 
     229             IF(lwp) WRITE(numout,*) '      Specified value' 
     230             dta_bdy(ib_bdy)%ll_u3d = .true. 
     231             dta_bdy(ib_bdy)%ll_v3d = .true. 
     232          CASE('zero') 
     233             IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
     234             dta_bdy(ib_bdy)%ll_u3d = .false. 
     235             dta_bdy(ib_bdy)%ll_v3d = .false. 
     236          CASE('orlanski') 
     237             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     238             dta_bdy(ib_bdy)%ll_u3d = .true. 
     239             dta_bdy(ib_bdy)%ll_v3d = .true. 
     240          CASE('orlanski_npo') 
     241             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     242             dta_bdy(ib_bdy)%ll_u3d = .true. 
     243             dta_bdy(ib_bdy)%ll_v3d = .true. 
     244          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn3d' ) 
    201245        END SELECT 
    202         IF( nn_dyn3d(ib_bdy) .gt. 0 ) THEN 
     246        IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 
    203247           SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   !  
    204248              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    209253 
    210254        IF ( ln_dyn3d_dmp(ib_bdy) ) THEN 
    211            IF ( nn_dyn3d(ib_bdy).EQ.0 ) THEN 
     255           IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN 
    212256              IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.' 
    213257              ln_dyn3d_dmp(ib_bdy)=.false. 
    214            ELSEIF ( nn_dyn3d(ib_bdy).EQ.1 ) THEN 
     258           ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN 
    215259              CALL ctl_stop( 'Use FRS OR relaxation' ) 
    216260           ELSE 
    … …  
    218262              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
    219263              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     264              dta_bdy(ib_bdy)%ll_u3d = .true. 
     265              dta_bdy(ib_bdy)%ll_v3d = .true. 
    220266           ENDIF 
    221267        ELSE 
    … …  
    225271 
    226272        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  ' 
    227         SELECT CASE( nn_tra(ib_bdy) )                   
    228           CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    229           CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    230           CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value' 
    231           CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Neumann conditions' 
    232           CASE( 4 )      ;   IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
    233           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     273        SELECT CASE( cn_tra(ib_bdy) )                   
     274          CASE('none') 
     275             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     276             dta_bdy(ib_bdy)%ll_tem = .false. 
     277             dta_bdy(ib_bdy)%ll_sal = .false. 
     278          CASE('frs') 
     279             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     280             dta_bdy(ib_bdy)%ll_tem = .true. 
     281             dta_bdy(ib_bdy)%ll_sal = .true. 
     282          CASE('specified') 
     283             IF(lwp) WRITE(numout,*) '      Specified value' 
     284             dta_bdy(ib_bdy)%ll_tem = .true. 
     285             dta_bdy(ib_bdy)%ll_sal = .true. 
     286          CASE('neumann') 
     287             IF(lwp) WRITE(numout,*) '      Neumann conditions' 
     288             dta_bdy(ib_bdy)%ll_tem = .false. 
     289             dta_bdy(ib_bdy)%ll_sal = .false. 
     290          CASE('runoff') 
     291             IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
     292             dta_bdy(ib_bdy)%ll_tem = .false. 
     293             dta_bdy(ib_bdy)%ll_sal = .false. 
     294          CASE('orlanski') 
     295             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     296             dta_bdy(ib_bdy)%ll_tem = .true. 
     297             dta_bdy(ib_bdy)%ll_sal = .true. 
     298          CASE('orlanski_npo') 
     299             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     300             dta_bdy(ib_bdy)%ll_tem = .true. 
     301             dta_bdy(ib_bdy)%ll_sal = .true. 
     302          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_tra' ) 
    234303        END SELECT 
    235         IF( nn_tra(ib_bdy) .gt. 0 ) THEN 
     304        IF( cn_tra(ib_bdy) /= 'none' ) THEN 
    236305           SELECT CASE( nn_tra_dta(ib_bdy) )                   !  
    237306              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    242311 
    243312        IF ( ln_tra_dmp(ib_bdy) ) THEN 
    244            IF ( nn_tra(ib_bdy).EQ.0 ) THEN 
     313           IF ( cn_tra(ib_bdy) == 'none' ) THEN 
    245314              IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.' 
    246315              ln_tra_dmp(ib_bdy)=.false. 
    247            ELSEIF ( nn_tra(ib_bdy).EQ.1 ) THEN 
     316           ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN 
    248317              CALL ctl_stop( 'Use FRS OR relaxation' ) 
    249318           ELSE 
    250319              IF(lwp) WRITE(numout,*) '      + T/S relaxation zone' 
    251320              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
     321              IF(lwp) WRITE(numout,*) '      Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days' 
    252322              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     323              dta_bdy(ib_bdy)%ll_tem = .true. 
     324              dta_bdy(ib_bdy)%ll_sal = .true. 
    253325           ENDIF 
    254326        ELSE 
    … …  
    259331#if defined key_lim2 
    260332        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    261         SELECT CASE( nn_ice_lim2(ib_bdy) )                   
    262           CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    263           CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    264           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     333        SELECT CASE( cn_ice_lim2(ib_bdy) )                   
     334          CASE('none') 
     335             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     336             dta_bdy(ib_bdy)%ll_frld  = .false. 
     337             dta_bdy(ib_bdy)%ll_hicif = .false. 
     338             dta_bdy(ib_bdy)%ll_hsnif = .false. 
     339          CASE('frs') 
     340             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     341             dta_bdy(ib_bdy)%ll_frld  = .true. 
     342             dta_bdy(ib_bdy)%ll_hicif = .true. 
     343             dta_bdy(ib_bdy)%ll_hsnif = .true. 
     344          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim2' ) 
    265345        END SELECT 
    266         IF( nn_ice_lim2(ib_bdy) .gt. 0 ) THEN  
     346        IF( cn_ice_lim2(ib_bdy) /= 'none' ) THEN  
    267347           SELECT CASE( nn_ice_lim2_dta(ib_bdy) )                   !  
    268348              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    744824               IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc... 
    745825                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 
    746                      CALL ctl_stop('bdy_init : ERROR : boundary data in file  & 
    747                                     must be defined in order of distance from edge nbr.', & 
    748                                    'A utility for re-ordering boundary coordinates and data & 
    749                                     files exists in the TOOLS/OBC directory') 
     826                     CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', & 
     827                                   'A utility for re-ordering boundary coordinates and data files exists in the TOOLS/OBC directory') 
    750828                  ENDIF     
    751829               ENDIF 
    … …  
    770848         ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 
    771849         ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) ) 
     850         ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 
    772851         ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 
    773852         ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 
    774          ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1) ) 
    775          ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1) ) 
     853         ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1,jpbgrd) ) 
     854         ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1,jpbgrd) ) 
    776855 
    777856         ! Dispatch mapping indices and discrete distances on each processor 
    … …  
    9411020            ENDDO 
    9421021         ENDDO  
     1022 
    9431023         ! definition of the i- and j- direction local boundaries arrays 
    9441024         ! used for sending the boudaries 
    … …  
    9941074               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
    9951075               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) &  
     1076               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     1077               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) &  
    9961078               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    9971079            END DO 
    … …  
    10961178      ENDDO 
    10971179 
     1180      ! bdyfmask required for flagu, flagv calculations below even though F-points  
     1181      ! not defined for BDY grid.  
     1182      DO ij = 2, jpjm1 
     1183         DO ii = 2, jpim1 
     1184            bdyfmask(ii,ij) = bdytmask(ii,ij  ) * bdytmask(ii+1,ij  )   & 
     1185           &                * bdytmask(ii,ij+1) * bdytmask(ii+1,ij+1) 
     1186         END DO       
     1187      END DO 
     1188 
    10981189      ! Lateral boundary conditions 
    10991190      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 
    … …  
    11021193      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    11031194 
    1104          idx_bdy(ib_bdy)%flagu(:) = 0.e0 
    1105          idx_bdy(ib_bdy)%flagv(:) = 0.e0 
     1195         idx_bdy(ib_bdy)%flagu(:,:) = 0.e0 
     1196         idx_bdy(ib_bdy)%flagv(:,:) = 0.e0 
    11061197         icount = 0  
    11071198 
    1108          !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward 
    1109          !flagu =  0 : u is tangential 
    1110          !flagu =  1 : u is normal to the boundary and is direction is inward 
     1199         ! Calculate relationship of U direction to the local orientation of the boundary 
     1200         ! flagu = -1 : u component is normal to the dynamical boundary and its direction is outward 
     1201         ! flagu =  0 : u is tangential 
     1202         ! flagu =  1 : u is normal to the boundary and is direction is inward 
    11111203   
    1112          igrd = 2      ! u-component  
    1113          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1114             nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1115             nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1116             zefl = bdytmask(nbi  ,nbj) 
    1117             zwfl = bdytmask(nbi+1,nbj) 
    1118             IF( zefl + zwfl == 2 ) THEN 
    1119                icount = icount + 1 
    1120             ELSE 
    1121                idx_bdy(ib_bdy)%flagu(ib)=-zefl+zwfl 
    1122             ENDIF 
     1204         DO igrd = 1,jpbgrd  
     1205            SELECT CASE( igrd ) 
     1206               CASE( 1 ) 
     1207                  cgrid = 'T'  
     1208                  pmask => umask(:,:,1) 
     1209                  i_offset = 0 
     1210               CASE( 2 )  
     1211                  cgrid = 'U' 
     1212                  pmask => bdytmask 
     1213                  i_offset = 1 
     1214               CASE( 3 )  
     1215                  cgrid = 'V' 
     1216                  pmask => fmask(:,:,1) 
     1217                  i_offset = 0 
     1218            END SELECT  
     1219            icount = 0 
     1220            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1221               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1222               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1223               zefl = pmask(nbi+i_offset-1,nbj) 
     1224               zwfl = pmask(nbi+i_offset,nbj) 
     1225               IF( zefl + zwfl == 2 * i_offset ) THEN 
     1226                  icount = icount + 1 
     1227                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     1228               ELSE 
     1229                  idx_bdy(ib_bdy)%flagu(ib,igrd)=-zefl+zwfl 
     1230               ENDIF 
     1231            END DO 
     1232            IF( icount /= 0 ) THEN 
     1233               IF(lwp) WRITE(numout,*) 
     1234               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid,' grid points,',   & 
     1235                  ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
     1236               IF(lwp) WRITE(numout,*) ' ========== ' 
     1237               IF(lwp) WRITE(numout,*) 
     1238               nstop = nstop + 1 
     1239            ENDIF  
    11231240         END DO 
    11241241 
    1125          !flagv = -1 : u component is normal to the dynamical boundary but its direction is outward 
    1126          !flagv =  0 : u is tangential 
    1127          !flagv =  1 : u is normal to the boundary and is direction is inward 
    1128  
    1129          igrd = 3      ! v-component 
    1130          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1131             nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1132             nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1133             znfl = bdytmask(nbi,nbj  ) 
    1134             zsfl = bdytmask(nbi,nbj+1) 
    1135             IF( znfl + zsfl == 2 ) THEN 
    1136                icount = icount + 1 
    1137             ELSE 
    1138                idx_bdy(ib_bdy)%flagv(ib) = -znfl + zsfl 
    1139             END IF 
     1242         ! Calculate relationship of V direction to the local orientation of the boundary 
     1243         ! flagv = -1 : u component is normal to the dynamical boundary but its direction is outward 
     1244         ! flagv =  0 : u is tangential 
     1245         ! flagv =  1 : u is normal to the boundary and is direction is inward 
     1246 
     1247         DO igrd = 1,jpbgrd  
     1248            SELECT CASE( igrd ) 
     1249               CASE( 1 ) 
     1250                  cgrid = 'T' 
     1251                  pmask => vmask(:,:,1) 
     1252                  j_offset = 0 
     1253               CASE( 2 ) 
     1254                  cgrid = 'U' 
     1255                  pmask => fmask(:,:,1) 
     1256                  j_offset = 0 
     1257               CASE( 3 ) 
     1258                  cgrid = 'V' 
     1259                  pmask => bdytmask 
     1260                  j_offset = 1 
     1261            END SELECT  
     1262            icount = 0 
     1263            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1264               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1265               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1266               znfl = pmask(nbi,nbj+j_offset-1  ) 
     1267               zsfl = pmask(nbi,nbj+j_offset) 
     1268               IF( znfl + zsfl == 2 * j_offset ) 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,' 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  
    11401283         END DO 
    11411284 
    1142          IF( icount /= 0 ) THEN 
    1143             IF(lwp) WRITE(numout,*) 
    1144             IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,',   & 
    1145                ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_bdy 
    1146             IF(lwp) WRITE(numout,*) ' ========== ' 
    1147             IF(lwp) WRITE(numout,*) 
    1148             nstop = nstop + 1 
    1149          ENDIF  
    1150      
    1151       ENDDO 
     1285      END DO 
    11521286 
    11531287      ! Compute total lateral surface for volume correction: 
    … …  
    11611295               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    11621296               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1163                flagu => idx_bdy(ib_bdy)%flagu(ib) 
     1297               flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 
    11641298               bdysurftot = bdysurftot + hu     (nbi  , nbj)                           & 
    11651299                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) & 
    … …  
    11741308               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    11751309               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1176                flagv => idx_bdy(ib_bdy)%flagv(ib) 
     1310               flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 
    11771311               bdysurftot = bdysurftot + hv     (nbi, nbj  )                           & 
    11781312                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) & 
    … …  
    15841718      itest = 0 
    15851719 
    1586       IF (nn_dyn2d(ib1)/=nn_dyn2d(ib2)) itest = itest + 1 
    1587       IF (nn_dyn3d(ib1)/=nn_dyn3d(ib2)) itest = itest + 1 
    1588       IF (nn_tra(ib1)/=nn_tra(ib2)) itest = itest + 1 
     1720      IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2)) itest = itest + 1 
     1721      IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2)) itest = itest + 1 
     1722      IF (cn_tra(ib1)/=cn_tra(ib2)) itest = itest + 1 
    15891723      ! 
    15901724      IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1 

  • branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r3651 r3991  
    128128            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    129129            ! relaxation area       
    130             IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     130            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    131131               ilen0(:)=nblen(:) 
    132132            ELSE 

  • branches/2013/dev_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r3777 r3991  
    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_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r3294 r3991  
    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_r3987_METO1_MERCATOR6_OBC_BDY_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r3680 r3991  
    594594         phur => hur_e 
    595595         phvr => hvr_e 
    596          pu2d => ua_e 
    597          pv2d => va_e 
     596         pua2d => ua_e 
     597         pva2d => va_e 
     598         pub2d => zub_e 
     599         pvb2d => zvb_e 
    598600 
    599601         IF( lk_bdy )   CALL bdy_dyn2d( kt )  
Note: See TracChangeset for help on using the changeset viewer.