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 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/BDY
Files:
1 deleted
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r6140 r7646  
    1010   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for lim3 
    1111   !!---------------------------------------------------------------------- 
    12 #if defined key_bdy  
    13    !!---------------------------------------------------------------------- 
    14    !!   'key_bdy'                      Unstructured Open Boundary Condition 
    15    !!---------------------------------------------------------------------- 
    1612   USE par_oce         ! ocean parameters 
    17    USE bdy_par         ! Unstructured boundary parameters 
    1813   USE lib_mpp         ! distributed memory computing 
    1914 
    2015   IMPLICIT NONE 
    2116   PUBLIC 
     17 
     18   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets 
     19   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V) 
    2220 
    2321   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary 
    … …  
    4947      LOGICAL                           ::  ll_tem 
    5048      LOGICAL                           ::  ll_sal 
     49      LOGICAL                           ::  ll_fvl 
    5150      REAL(wp), POINTER, DIMENSION(:)   ::  ssh 
    5251      REAL(wp), POINTER, DIMENSION(:)   ::  u2d 
    … …  
    8281   !! Namelist variables 
    8382   !!---------------------------------------------------------------------- 
     83   LOGICAL, PUBLIC            ::   ln_bdy                   !: Unstructured Ocean Boundary Condition 
     84 
    8485   CHARACTER(len=80), DIMENSION(jp_bdy) ::   cn_coords_file !: Name of bdy coordinates file 
    8586   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of bdy mask file 
    … …  
    9192   ! 
    9293   INTEGER                    ::   nb_bdy                   !: number of open boundary sets 
     94   INTEGER                    ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run) 
    9395   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme 
    9496   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
    … …  
    134136                                                                          !: =1 => some data to be read in from data files 
    135137   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy) 
     138   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_z      !: workspace for reading in global depth arrays (unstr.  bdy) 
     139   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_dz     !: workspace for reading in global depth arrays (unstr.  bdy) 
    136140   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy) 
     141   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_z     !: workspace for reading in global depth arrays (struct. bdy) 
     142   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_dz    !: workspace for reading in global depth arrays (struct. bdy) 
    137143!$AGRIF_DO_NOT_TREAT 
    138144   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    … …  
    166172   END FUNCTION bdy_oce_alloc 
    167173 
    168 #else 
    169    !!---------------------------------------------------------------------- 
    170    !!   Dummy module                NO Unstructured Open Boundary Condition 
    171    !!---------------------------------------------------------------------- 
    172    LOGICAL ::   ln_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries 
    173 #endif 
    174  
    175174   !!====================================================================== 
    176175END MODULE bdy_oce 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r6140 r7646  
    1212   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    1313   !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for lim3 
    14    !!---------------------------------------------------------------------- 
    15 #if defined key_bdy 
    16    !!---------------------------------------------------------------------- 
    17    !!   'key_bdy'                     Open Boundary Conditions 
    1814   !!---------------------------------------------------------------------- 
    1915   !!    bdy_dta        : read external data along open boundaries from file 
    … …  
    3632#endif 
    3733   USE sbcapr 
     34   USE sbctide         ! Tidal forcing or not 
    3835 
    3936   IMPLICIT NONE 
    … …  
    267264 
    268265                        jend = jstart + dta%nread(2) - 1 
    269                         CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    270                                      & kit=jit, kt_offset=time_offset ) 
     266                        IF( ln_full_vel_array(ib_bdy) ) THEN 
     267                           CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
     268                                     & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(ib_bdy)  ) 
     269                        ELSE 
     270                           CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
     271                                     & kit=jit, kt_offset=time_offset  ) 
     272                        ENDIF 
    271273 
    272274                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields 
    … …  
    333335                     jend = jstart + dta%nread(1) - 1 
    334336                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    335                                   & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 
     337                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, fvl=ln_full_vel_array(ib_bdy) ) 
    336338                  ENDIF 
    337339                  ! If full velocities in boundary data then split into barotropic and baroclinic data 
    … …  
    381383      END DO  ! ib_bdy 
    382384 
    383 #if defined key_tide 
    384       IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                            
    385          DO ib_bdy = 1, nb_bdy    ! Tidal component added in ts loop 
    386             IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    387                nblen => idx_bdy(ib_bdy)%nblen 
    388                nblenrim => idx_bdy(ib_bdy)%nblenrim 
    389                IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF  
    390                IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1)) 
    391                IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2)) 
    392                IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3)) 
    393             ENDIF 
    394          END DO 
    395       ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
    396          ! 
    397          CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
     385      IF ( ln_tide ) THEN 
     386         IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                            
     387            DO ib_bdy = 1, nb_bdy    ! Tidal component added in ts loop 
     388               IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
     389                  nblen => idx_bdy(ib_bdy)%nblen 
     390                  nblenrim => idx_bdy(ib_bdy)%nblenrim 
     391                  IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF  
     392                  IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1)) 
     393                  IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2)) 
     394                  IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3)) 
     395               ENDIF 
     396            END DO 
     397         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
     398            ! 
     399            CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
     400         ENDIF 
    398401      ENDIF 
    399 #endif 
    400402 
    401403      IF ( ln_apr_obc ) THEN 
    … …  
    459461      NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s 
    460462#endif 
    461       NAMELIST/nambdy_dta/ ln_full_vel 
     463      NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy 
    462464      !!--------------------------------------------------------------------------- 
    463465      ! 
    … …  
    899901   END SUBROUTINE bdy_dta_init 
    900902 
    901 #else 
    902    !!---------------------------------------------------------------------- 
    903    !!   Dummy module                   NO Open Boundary Conditions 
    904    !!---------------------------------------------------------------------- 
    905 CONTAINS 
    906    SUBROUTINE bdy_dta( kt, jit, time_offset ) ! Empty routine 
    907       INTEGER, INTENT( in )           ::   kt     
    908       INTEGER, INTENT( in ), OPTIONAL ::   jit    
    909       INTEGER, INTENT( in ), OPTIONAL ::   time_offset 
    910       WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt 
    911    END SUBROUTINE bdy_dta 
    912    SUBROUTINE bdy_dta_init()                  ! Empty routine 
    913       WRITE(*,*) 'bdy_dta_init: You should not have seen this print! error?' 
    914    END SUBROUTINE bdy_dta_init 
    915 #endif 
    916  
    917903   !!============================================================================== 
    918904END MODULE bdydta 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r6140 r7646  
    1111   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions 
    1212   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    13    !!---------------------------------------------------------------------- 
    14 #if defined key_bdy  
    15    !!---------------------------------------------------------------------- 
    16    !!   'key_bdy' :                    Unstructured Open Boundary Condition 
    1713   !!---------------------------------------------------------------------- 
    1814   !!   bdy_dyn        : split velocities into barotropic and baroclinic parts 
    … …  
    137133   END SUBROUTINE bdy_dyn 
    138134 
    139 #else 
    140    !!---------------------------------------------------------------------- 
    141    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
    142    !!---------------------------------------------------------------------- 
    143 CONTAINS 
    144    SUBROUTINE bdy_dyn( kt )      ! Empty routine 
    145       WRITE(*,*) 'bdy_dyn: You should not have seen this print! error?', kt 
    146    END SUBROUTINE bdy_dyn 
    147 #endif 
    148  
    149135   !!====================================================================== 
    150136END MODULE bdydyn 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r5930 r7646  
    77   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    88   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_bdy  
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_bdy' :                    Unstructured Open Boundary Condition 
    139   !!---------------------------------------------------------------------- 
    1410   !!   bdy_dyn2d          : Apply open boundary conditions to barotropic variables. 
    … …  
    310306   END SUBROUTINE bdy_ssh 
    311307 
    312 #else 
    313    !!---------------------------------------------------------------------- 
    314    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
    315    !!---------------------------------------------------------------------- 
    316 CONTAINS 
    317    SUBROUTINE bdy_dyn2d( kt )      ! Empty routine 
    318       INTEGER, intent(in) :: kt 
    319       WRITE(*,*) 'bdy_dyn2d: You should not have seen this print! error?', kt 
    320    END SUBROUTINE bdy_dyn2d 
    321  
    322 #endif 
    323  
    324308   !!====================================================================== 
    325309END MODULE bdydyn2d 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r6140 r7646  
    66   !! History :  3.4  !  2011     (D. Storkey) new module as part of BDY rewrite  
    77   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_bdy  
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_bdy' :                    Unstructured Open Boundary Condition 
    128   !!---------------------------------------------------------------------- 
    139   !!   bdy_dyn3d        : apply open boundary conditions to baroclinic velocities 
    … …  
    5753         CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
    5854         CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
     55         CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     56         CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy ) 
    5957         CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    6058         END SELECT 
    … …  
    110108   END SUBROUTINE bdy_dyn3d_spe 
    111109 
     110   SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 
     111      !!---------------------------------------------------------------------- 
     112      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  *** 
     113      !! 
     114      !! ** Purpose : - Enforce a zero gradient of normal velocity 
     115      !! 
     116      !!---------------------------------------------------------------------- 
     117      INTEGER                     ::   kt 
     118      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
     119      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     120      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     121      !! 
     122      INTEGER  ::   jb, jk         ! dummy loop indices 
     123      INTEGER  ::   ii, ij, igrd   ! local integers 
     124      REAL(wp) ::   zwgt           ! boundary weight 
     125      INTEGER  ::   fu, fv 
     126      !!---------------------------------------------------------------------- 
     127      ! 
     128      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zgrad') 
     129      ! 
     130      igrd = 2                      ! Copying tangential velocity into bdy points 
     131      DO jb = 1, idx%nblenrim(igrd) 
     132         DO jk = 1, jpkm1 
     133            ii   = idx%nbi(jb,igrd) 
     134            ij   = idx%nbj(jb,igrd) 
     135            fu   = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 
     136            ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 
     137                        &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 
     138         END DO 
     139      END DO 
     140      ! 
     141      igrd = 3                      ! Copying tangential velocity into bdy points 
     142      DO jb = 1, idx%nblenrim(igrd) 
     143         DO jk = 1, jpkm1 
     144            ii   = idx%nbi(jb,igrd) 
     145            ij   = idx%nbj(jb,igrd) 
     146            fv   = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 
     147            va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 
     148                        &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 
     149         END DO 
     150      END DO 
     151      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
     152      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
     153      ! 
     154      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
     155 
     156      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zgrad') 
     157 
     158   END SUBROUTINE bdy_dyn3d_zgrad 
    112159 
    113160   SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) 
    … …  
    296343   END SUBROUTINE bdy_dyn3d_dmp 
    297344 
    298 #else 
    299    !!---------------------------------------------------------------------- 
    300    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
    301    !!---------------------------------------------------------------------- 
    302 CONTAINS 
    303    SUBROUTINE bdy_dyn3d( kt )      ! Empty routine 
    304       WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt 
    305    END SUBROUTINE bdy_dyn3d 
    306    SUBROUTINE bdy_dyn3d_dmp( kt )      ! Empty routine 
    307       WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt 
    308    END SUBROUTINE bdy_dyn3d_dmp 
    309 #endif 
     345   SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 
     346      !!---------------------------------------------------------------------- 
     347      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  *** 
     348      !!              
     349      !!              - Apply Neumann condition to baroclinic velocities.  
     350      !!              - Wrapper routine for bdy_nmn 
     351      !!  
     352      !! 
     353      !!---------------------------------------------------------------------- 
     354      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     355      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
     356 
     357      INTEGER  ::   jb, igrd                               ! dummy loop indices 
     358      !!---------------------------------------------------------------------- 
     359 
     360      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_nmn') 
     361      ! 
     362      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
     363      ! 
     364      igrd = 2      ! Neumann bc on u-velocity;  
     365      !             
     366      CALL bdy_nmn( idx, igrd, ua ) 
     367 
     368      igrd = 3      ! Neumann bc on v-velocity 
     369      !   
     370      CALL bdy_nmn( idx, igrd, va ) 
     371      ! 
     372      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
     373      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 
     374      ! 
     375      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_nmn') 
     376      ! 
     377   END SUBROUTINE bdy_dyn3d_nmn 
    310378 
    311379   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r5836 r7646  
    88   !!              -   !  2012-01 (C. Rousset)  add lim3 and remove useless jk loop  
    99   !!---------------------------------------------------------------------- 
    10 #if defined   key_bdy   &&  ( defined key_lim2 || defined key_lim3 ) 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_bdy'            and                 Unstructured Open Boundary Conditions 
     10#if defined key_lim2 || defined key_lim3 
     11   !!---------------------------------------------------------------------- 
    1312   !!   'key_lim2'                                                 LIM-2 sea ice model 
    1413   !!   'key_lim3'                                                 LIM-3 sea ice model 
    … …  
    2726#elif defined key_lim3 
    2827   USE ice             ! LIM_3 ice variables 
    29    USE dom_ice         ! sea-ice domain 
    3028   USE limvar 
     29   USE limctl 
    3130#endif  
    3231   USE par_oce         ! ocean parameters 
    … …  
    8281      ! 
    8382#if defined key_lim3 
    84       CALL lim_var_zapsmall 
    85       CALL lim_var_agg(1) 
     83                        CALL lim_var_zapsmall 
     84                        CALL lim_var_agg(1) 
     85      IF( ln_limctl )   CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    8686#endif 
    8787      ! 
    … …  
    121121      ! 
    122122#if defined key_lim2 
    123       DO jb = 1, idx%nblen(jgrd) 
     123      DO jb = 1, idx%nblenrim(jgrd) 
    124124         ji    = idx%nbi(jb,jgrd) 
    125125         jj    = idx%nbj(jb,jgrd) 
    … …  
    141141 
    142142      DO jl = 1, jpl 
    143          DO jb = 1, idx%nblen(jgrd) 
     143         DO jb = 1, idx%nblenrim(jgrd) 
    144144            ji    = idx%nbi(jb,jgrd) 
    145145            jj    = idx%nbj(jb,jgrd) 
    … …  
    177177 
    178178      DO jl = 1, jpl 
    179          DO jb = 1, idx%nblen(jgrd) 
     179         DO jb = 1, idx%nblenrim(jgrd) 
    180180            ji    = idx%nbi(jb,jgrd) 
    181181            jj    = idx%nbj(jb,jgrd) 
    … …  
    236236            END SELECT 
    237237            ! 
    238             IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_ice_sal 
     238            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_icesal 
    239239               sm_i(ji,jj  ,jl) = rn_icesal 
    240240               s_i (ji,jj,:,jl) = rn_icesal 
    … …  
    325325            CASE ( 'U' )   
    326326               jgrd = 2      ! u velocity 
    327                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
     327               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    328328                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    329329                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    … …  
    352352            CASE ( 'V' ) 
    353353               jgrd = 3      ! v velocity 
    354                DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
     354               DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    355355                  ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    356356                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r6140 r7646  
    1313   !!            3.4  !  2012     (J. Chanut) straight open boundary case update 
    1414   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) optimization of BDY communications 
    15    !!---------------------------------------------------------------------- 
    16 #if defined key_bdy 
    17    !!---------------------------------------------------------------------- 
    18    !!   'key_bdy'                     Unstructured Open Boundary Conditions 
     15   !!            3.7  !  2016     (T. Lovato) Remove bdy macro, call here init for dta and tides 
    1916   !!---------------------------------------------------------------------- 
    2017   !!   bdy_init      : Initialization of unstructured open boundaries 
    … …  
    2320   USE dom_oce        ! ocean space and time domain 
    2421   USE bdy_oce        ! unstructured open boundary conditions 
    25    USE sbctide  , ONLY: lk_tide ! Tidal forcing or not 
     22   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine) 
     23   USE bdytides       ! open boundary cond. setting   (bdytide_init routine) 
     24   USE sbctide        ! Tidal forcing or not 
    2625   USE phycst   , ONLY: rday 
    2726   ! 
    … …  
    5352   !!---------------------------------------------------------------------- 
    5453CONTAINS 
    55     
     54 
    5655   SUBROUTINE bdy_init 
    5756      !!---------------------------------------------------------------------- 
    5857      !!                 ***  ROUTINE bdy_init  *** 
     58      !! 
     59      !! ** Purpose :   Initialization of the dynamics and tracer fields with 
     60      !!              unstructured open boundaries. 
     61      !! 
     62      !! ** Method  :   Read initialization arrays (mask, indices) to identify 
     63      !!              an unstructured open boundary 
     64      !! 
     65      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
     66      !!---------------------------------------------------------------------- 
     67      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         & 
     68         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     & 
     69         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             & 
     70         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
     71         &             cn_ice_lim, nn_ice_lim_dta,                             & 
     72         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     & 
     73         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 
     74         ! 
     75      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     76      !!---------------------------------------------------------------------- 
     77      ! 
     78      IF( nn_timing == 1 )   CALL timing_start('bdy_init') 
     79 
     80      ! ------------------------ 
     81      ! Read namelist parameters 
     82      ! ------------------------ 
     83      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries 
     84      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
     85901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
     86      ! 
     87      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
     88      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
     89902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     90      IF(lwm) WRITE ( numond, nambdy ) 
     91 
     92      ! ----------------------------------------- 
     93      ! unstructured open boundaries use control 
     94      ! ----------------------------------------- 
     95      IF ( ln_bdy ) THEN 
     96         IF(lwp) WRITE(numout,*) 
     97         IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 
     98         IF(lwp) WRITE(numout,*) '~~~~~~~~' 
     99         ! 
     100         ! Open boundaries definition (arrays and masks) 
     101         CALL bdy_segs 
     102         ! 
     103         ! Open boundaries initialisation of external data arrays 
     104         CALL bdy_dta_init 
     105         ! 
     106         ! Open boundaries initialisation of tidal harmonic forcing 
     107         IF( ln_tide ) CALL bdytide_init 
     108         ! 
     109      ELSE 
     110         IF(lwp) WRITE(numout,*) 
     111         IF(lwp) WRITE(numout,*) 'bdy_init : open boundaries not used (ln_bdy = F)' 
     112         IF(lwp) WRITE(numout,*) '~~~~~~~~' 
     113         ! 
     114      ENDIF 
     115      ! 
     116      IF( nn_timing == 1 )   CALL timing_stop('bdy_init') 
     117      ! 
     118   END SUBROUTINE bdy_init 
     119    
     120   SUBROUTINE bdy_segs 
     121      !!---------------------------------------------------------------------- 
     122      !!                 ***  ROUTINE bdy_init  *** 
    59123      !!          
    60       !! ** Purpose :   Initialization of the dynamics and tracer fields with  
    61       !!              unstructured open boundaries. 
     124      !! ** Purpose :   Definition of unstructured open boundaries. 
    62125      !! 
    63126      !! ** Method  :   Read initialization arrays (mask, indices) to identify  
    … …  
    90153      REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    91154      !! 
    92       CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile     ! Namelist variables 
    93155      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        -  
    94156      INTEGER                              ::   nbdyind, nbdybeg, nbdyend 
    95157      !! 
    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, & 
    100          &             cn_ice_lim, nn_ice_lim_dta,                           & 
    101          &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
    102          &             ln_vol, nn_volctl, nn_rimwidth 
    103          ! 
    104158      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 
    105159      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    106160      !!---------------------------------------------------------------------- 
    107161      ! 
    108       IF( nn_timing == 1 )   CALL timing_start('bdy_init') 
    109       ! 
    110       IF(lwp) WRITE(numout,*) 
    111       IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 
    112       IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    113       ! 
    114       IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   & 
    115          &                               ' and general open boundary condition are not compatible' ) 
    116  
     162      IF( nn_timing == 1 )   CALL timing_start('bdy_segs') 
     163      ! 
    117164      cgrid = (/'t','u','v'/) 
    118        
    119       ! ------------------------ 
    120       ! Read namelist parameters 
    121       ! ------------------------ 
    122       REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries   
    123       READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
    124 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
    125       ! 
    126       REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    127       READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    128 902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
    129       IF(lwm) WRITE ( numond, nambdy ) 
    130165 
    131166      ! ----------------------------------------- 
    132167      ! Check and write out namelist parameters 
    133168      ! ----------------------------------------- 
    134       !                                   ! control prints 
    135       IF(lwp) WRITE(numout,*) '   nambdy' 
     169      IF( jperio /= 0 )   CALL ctl_stop( 'bdy_segs: Cyclic or symmetric,',   & 
     170         &                               ' and general open boundary condition are not compatible' ) 
    136171 
    137172      IF( nb_bdy == 0 ) THEN  
    … …  
    189224              CASE DEFAULT   ;   CALL ctl_stop( 'nn_dyn2d_dta must be between 0 and 3' ) 
    190225           END SELECT 
    191            IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.lk_tide)) THEN 
    192              CALL ctl_stop( 'You must activate key_tide to add tidal forcing at open boundaries' ) 
     226           IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(.NOT.ln_tide)) THEN 
     227             CALL ctl_stop( 'You must activate with ln_tide to add tidal forcing at open boundaries' ) 
    193228           ENDIF 
    194229        ENDIF 
    … …  
    209244             dta_bdy(ib_bdy)%ll_u3d = .true. 
    210245             dta_bdy(ib_bdy)%ll_v3d = .true. 
     246          CASE('neumann') 
     247             IF(lwp) WRITE(numout,*) '      Neumann conditions' 
     248             dta_bdy(ib_bdy)%ll_u3d = .false. 
     249             dta_bdy(ib_bdy)%ll_v3d = .false. 
     250          CASE('zerograd') 
     251             IF(lwp) WRITE(numout,*) '      Zero gradient for baroclinic velocities' 
     252             dta_bdy(ib_bdy)%ll_u3d = .false. 
     253             dta_bdy(ib_bdy)%ll_v3d = .false. 
    211254          CASE('zero') 
    212255             IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
    … …  
    377420          IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries' 
    378421          IF(lwp) WRITE(numout,*) 
     422        ENDIF 
     423        IF( nb_jpk_bdy > 0 ) THEN 
     424           IF(lwp) WRITE(numout,*) '*** open boundary will be interpolate in the vertical onto the native grid ***' 
     425        ELSE 
     426           IF(lwp) WRITE(numout,*) '*** open boundary will be read straight onto the native grid without vertical interpolation ***' 
    379427        ENDIF 
    380428     ENDIF 
    … …  
    499547            &      nbrdta(jpbdta, jpbgrd, nb_bdy) ) 
    500548 
    501          ALLOCATE( dta_global(jpbdtau, 1, jpk) ) 
    502          IF ( icount>0 ) ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) ) 
     549         IF( nb_jpk_bdy>0 ) THEN 
     550            ALLOCATE( dta_global(jpbdtau, 1, nb_jpk_bdy) ) 
     551            ALLOCATE( dta_global_z(jpbdtau, 1, nb_jpk_bdy) ) 
     552            ALLOCATE( dta_global_dz(jpbdtau, 1, nb_jpk_bdy) ) 
     553         ELSE 
     554            ALLOCATE( dta_global(jpbdtau, 1, jpk) ) 
     555            ALLOCATE( dta_global_z(jpbdtau, 1, jpk) ) ! needed ?? TODO 
     556            ALLOCATE( dta_global_dz(jpbdtau, 1, jpk) )! needed ?? TODO 
     557         ENDIF 
     558 
     559         IF ( icount>0 ) THEN 
     560            IF( nb_jpk_bdy>0 ) THEN 
     561               ALLOCATE( dta_global2(jpbdtas, nrimmax, nb_jpk_bdy) ) 
     562               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, nb_jpk_bdy) ) 
     563               ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, nb_jpk_bdy) ) 
     564            ELSE 
     565               ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) ) 
     566               ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk) ) ! needed ?? TODO 
     567               ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk) )! needed ?? TODO   
     568            ENDIF 
     569         ENDIF 
    503570         !  
    504571      ENDIF 
    … …  
    769836!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
    770837!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1       
    771       iwe = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2 
    772       ies = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1 
    773       iso = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2 
    774       ino = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1 
     838      iwe = mig(1) - 1 + 2         ! if monotasking and no zoom, iw=2 
     839      ies = mig(1) + nlci-1 - 1  ! if monotasking and no zoom, ie=jpim1 
     840      iso = mjg(1) - 1 + 2         ! if monotasking and no zoom, is=2 
     841      ino = mjg(1) + nlcj-1 - 1  ! if monotasking and no zoom, in=jpjm1 
    775842 
    776843      ALLOCATE( nbondi_bdy(nb_bdy)) 
    … …  
    785852      ! Work out dimensions of boundary data on each neighbour process 
    786853      IF(nbondi == 0) THEN 
    787          iw_b(1) = jpizoom + nimppt(nowe+1) 
    788          ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
    789          is_b(1) = jpjzoom + njmppt(nowe+1) 
    790          in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    791  
    792          iw_b(2) = jpizoom + nimppt(noea+1) 
    793          ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
    794          is_b(2) = jpjzoom + njmppt(noea+1) 
    795          in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
     854         iw_b(1) = 1 + nimppt(nowe+1) 
     855         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3 
     856         is_b(1) = 1 + njmppt(nowe+1) 
     857         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3 
     858 
     859         iw_b(2) = 1 + nimppt(noea+1) 
     860         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3 
     861         is_b(2) = 1 + njmppt(noea+1) 
     862         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3 
    796863      ELSEIF(nbondi == 1) THEN 
    797          iw_b(1) = jpizoom + nimppt(nowe+1) 
    798          ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
    799          is_b(1) = jpjzoom + njmppt(nowe+1) 
    800          in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
     864         iw_b(1) = 1 + nimppt(nowe+1) 
     865         ie_b(1) = 1 + nimppt(nowe+1)+nlcit(nowe+1)-3 
     866         is_b(1) = 1 + njmppt(nowe+1) 
     867         in_b(1) = 1 + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    801868      ELSEIF(nbondi == -1) THEN 
    802          iw_b(2) = jpizoom + nimppt(noea+1) 
    803          ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
    804          is_b(2) = jpjzoom + njmppt(noea+1) 
    805          in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
     869         iw_b(2) = 1 + nimppt(noea+1) 
     870         ie_b(2) = 1 + nimppt(noea+1)+nlcit(noea+1)-3 
     871         is_b(2) = 1 + njmppt(noea+1) 
     872         in_b(2) = 1 + njmppt(noea+1)+nlcjt(noea+1)-3 
    806873      ENDIF 
    807874 
    808875      IF(nbondj == 0) THEN 
    809          iw_b(3) = jpizoom + nimppt(noso+1) 
    810          ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
    811          is_b(3) = jpjzoom + njmppt(noso+1) 
    812          in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
    813  
    814          iw_b(4) = jpizoom + nimppt(nono+1) 
    815          ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
    816          is_b(4) = jpjzoom + njmppt(nono+1) 
    817          in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
     876         iw_b(3) = 1 + nimppt(noso+1) 
     877         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3 
     878         is_b(3) = 1 + njmppt(noso+1) 
     879         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3 
     880 
     881         iw_b(4) = 1 + nimppt(nono+1) 
     882         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3 
     883         is_b(4) = 1 + njmppt(nono+1) 
     884         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3 
    818885      ELSEIF(nbondj == 1) THEN 
    819          iw_b(3) = jpizoom + nimppt(noso+1) 
    820          ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
    821          is_b(3) = jpjzoom + njmppt(noso+1) 
    822          in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
     886         iw_b(3) = 1 + nimppt(noso+1) 
     887         ie_b(3) = 1 + nimppt(noso+1)+nlcit(noso+1)-3 
     888         is_b(3) = 1 + njmppt(noso+1) 
     889         in_b(3) = 1 + njmppt(noso+1)+nlcjt(noso+1)-3 
    823890      ELSEIF(nbondj == -1) THEN 
    824          iw_b(4) = jpizoom + nimppt(nono+1) 
    825          ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
    826          is_b(4) = jpjzoom + njmppt(nono+1) 
    827          in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
     891         iw_b(4) = 1 + nimppt(nono+1) 
     892         ie_b(4) = 1 + nimppt(nono+1)+nlcit(nono+1)-3 
     893         is_b(4) = 1 + njmppt(nono+1) 
     894         in_b(4) = 1 + njmppt(nono+1)+nlcjt(nono+1)-3 
    828895      ENDIF 
    829896 
    … …  
    839906               IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc... 
    840907                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 
    841                      CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined ', & 
     908                     CALL ctl_stop('bdy_segs : ERROR : boundary data in file must be defined ', & 
    842909                          &        ' in order of distance from edge nbr A utility for re-ordering ', & 
    843910                          &        ' boundary coordinates and data files exists in the TOOLS/OBC directory') 
    … …  
    899966!                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
    900967!                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
    901                      idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+jpizoom 
    902                      idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+jpjzoom 
     968                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1 
     969                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1 
    903970                     ! check if point has to be sent 
    904971                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 
    … …  
    10921159      !          = 0  elsewhere    
    10931160  
     1161      bdytmask(:,:) = ssmask(:,:) 
     1162 
    10941163      IF( ln_mask_file ) THEN 
    10951164         CALL iom_open( cn_mask_file, inum ) 
    … …  
    11081177         CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond. 
    11091178 
    1110  
    1111          ! Mask corrections 
    1112          ! ---------------- 
    1113          DO ik = 1, jpkm1 
    1114             DO ij = 1, jpj 
    1115                DO ii = 1, jpi 
    1116                   tmask(ii,ij,ik) = tmask(ii,ij,ik) * bdytmask(ii,ij) 
    1117                   umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij) 
    1118                   vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij) 
    1119                END DO       
    1120             END DO 
    1121             DO ij = 2, jpjm1 
    1122                DO ii = 2, jpim1 
    1123                   fmask(ii,ij,ik) = fmask(ii,ij,ik) * bdytmask(ii,ij  ) * bdytmask(ii+1,ij  )   & 
    1124                      &                              * bdytmask(ii,ij+1) * bdytmask(ii+1,ij+1) 
    1125                END DO       
    1126             END DO 
    1127          END DO 
    1128          tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:) 
    1129          ! 
    11301179      ENDIF ! ln_mask_file=.TRUE. 
    11311180       
    1132       bdytmask(:,:) = ssmask(:,:) 
    11331181      IF( .NOT.ln_mask_file ) THEN 
    11341182         ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. 
    … …  
    13001348      CALL wrk_dealloc(jpi,jpj,   zfmask )  
    13011349      ! 
    1302       IF( nn_timing == 1 )   CALL timing_stop('bdy_init') 
    1303       ! 
    1304    END SUBROUTINE bdy_init 
    1305  
     1350      IF( nn_timing == 1 )   CALL timing_stop('bdy_segs') 
     1351      ! 
     1352   END SUBROUTINE bdy_segs 
    13061353 
    13071354   SUBROUTINE bdy_ctl_seg 
    … …  
    17131760   END SUBROUTINE bdy_ctl_corn 
    17141761 
    1715 #else 
    1716    !!--------------------------------------------------------------------------------- 
    1717    !!   Dummy module                                   NO open boundaries 
    1718    !!--------------------------------------------------------------------------------- 
    1719 CONTAINS 
    1720    SUBROUTINE bdy_init      ! Dummy routine 
    1721    END SUBROUTINE bdy_init 
    1722 #endif 
    1723  
    17241762   !!================================================================================= 
    17251763END MODULE bdyini 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90

    r6140 r7646  
    55   !!====================================================================== 
    66   !! History :  3.6  !  2013     (D. Storkey) original code 
     7   !!            4.0  !  2014     (T. Lovato) Generalize OBC structure 
    78   !!---------------------------------------------------------------------- 
    8 #if defined key_bdy  
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_bdy' :                    Unstructured Open Boundary Condition 
    119   !!---------------------------------------------------------------------- 
    1210   !!   bdy_orlanski_2d 
    … …  
    2523   PRIVATE 
    2624 
    27    PUBLIC   bdy_orlanski_2d     ! routine called where? 
    28    PUBLIC   bdy_orlanski_3d     ! routine called where? 
     25   PUBLIC   bdy_frs, bdy_spe, bdy_nmn, bdy_orl 
     26   PUBLIC   bdy_orlanski_2d 
     27   PUBLIC   bdy_orlanski_3d 
    2928 
    3029   !!---------------------------------------------------------------------- 
    31    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     30   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    3231   !! $Id$  
    3332   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3433   !!---------------------------------------------------------------------- 
    3534CONTAINS 
     35 
     36   SUBROUTINE bdy_frs( idx, pta, dta ) 
     37      !!---------------------------------------------------------------------- 
     38      !!                 ***  SUBROUTINE bdy_frs  *** 
     39      !! 
     40      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
     41      !! 
     42      !! Reference : Engedahl H., 1995, Tellus, 365-382. 
     43      !!---------------------------------------------------------------------- 
     44      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     45      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
     46      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     47      !! 
     48      REAL(wp) ::   zwgt           ! boundary weight 
     49      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     50      INTEGER  ::   ii, ij         ! 2D addresses 
     51      !!---------------------------------------------------------------------- 
     52      ! 
     53      IF( nn_timing == 1 ) CALL timing_start('bdy_frs') 
     54      !  
     55      igrd = 1                       ! Everything is at T-points here 
     56      DO ib = 1, idx%nblen(igrd) 
     57         DO ik = 1, jpkm1 
     58            ii = idx%nbi(ib,igrd)  
     59            ij = idx%nbj(ib,igrd) 
     60            zwgt = idx%nbw(ib,igrd) 
     61            pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 
     62         END DO 
     63      END DO 
     64      ! 
     65      IF( nn_timing == 1 ) CALL timing_stop('bdy_frs') 
     66      ! 
     67   END SUBROUTINE bdy_frs 
     68 
     69   SUBROUTINE bdy_spe( idx, pta, dta ) 
     70      !!---------------------------------------------------------------------- 
     71      !!                 ***  SUBROUTINE bdy_spe  *** 
     72      !! 
     73      !! ** Purpose : Apply a specified value for tracers at open boundaries. 
     74      !! 
     75      !!---------------------------------------------------------------------- 
     76      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     77      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     79      !! 
     80      REAL(wp) ::   zwgt           ! boundary weight 
     81      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     82      INTEGER  ::   ii, ij         ! 2D addresses 
     83      !!---------------------------------------------------------------------- 
     84      ! 
     85      IF( nn_timing == 1 ) CALL timing_start('bdy_spe') 
     86      ! 
     87      igrd = 1                       ! Everything is at T-points here 
     88      DO ib = 1, idx%nblenrim(igrd) 
     89         ii = idx%nbi(ib,igrd) 
     90         ij = idx%nbj(ib,igrd) 
     91         DO ik = 1, jpkm1 
     92            pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 
     93         END DO 
     94      END DO 
     95      ! 
     96      IF( nn_timing == 1 ) CALL timing_stop('bdy_spe') 
     97      ! 
     98   END SUBROUTINE bdy_spe 
     99 
     100   SUBROUTINE bdy_orl( idx, ptb, pta, dta, ll_npo ) 
     101      !!---------------------------------------------------------------------- 
     102      !!                 ***  SUBROUTINE bdy_orl  *** 
     103      !! 
     104      !! ** Purpose : Apply Orlanski radiation for tracers at open boundaries. 
     105      !!              This is a wrapper routine for bdy_orlanski_3d below 
     106      !! 
     107      !!---------------------------------------------------------------------- 
     108      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     109      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
     110      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptb  ! before tracer field 
     111      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     112      LOGICAL,                             INTENT(in) ::   ll_npo  ! switch for NPO version 
     113      !! 
     114      INTEGER  ::   igrd                                    ! grid index 
     115      !!---------------------------------------------------------------------- 
     116      ! 
     117      IF( nn_timing == 1 ) CALL timing_start('bdy_orl') 
     118      ! 
     119      igrd = 1                       ! Everything is at T-points here 
     120      ! 
     121      CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, ll_npo ) 
     122      ! 
     123      IF( nn_timing == 1 ) CALL timing_stop('bdy_orl') 
     124      ! 
     125   END SUBROUTINE bdy_orl 
    36126 
    37127   SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, ll_npo ) 
    … …  
    355445   END SUBROUTINE bdy_orlanski_3d 
    356446 
    357  
    358 #else 
    359    !!---------------------------------------------------------------------- 
    360    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
    361    !!---------------------------------------------------------------------- 
    362 CONTAINS 
    363    SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext  )      ! Empty routine 
    364       WRITE(*,*) 'bdy_orlanski_2d: You should not have seen this print! error?', kt 
    365    END SUBROUTINE bdy_orlanski_2d 
    366    SUBROUTINE bdy_orlanski_3d( idx, igrd, phib, phia, phi_ext  )      ! Empty routine 
    367       WRITE(*,*) 'bdy_orlanski_3d: You should not have seen this print! error?', kt 
    368    END SUBROUTINE bdy_orlanski_3d 
    369 #endif 
     447   SUBROUTINE bdy_nmn( idx, igrd, phia ) 
     448      !!---------------------------------------------------------------------- 
     449      !!                 ***  SUBROUTINE bdy_nmn  *** 
     450      !!                     
     451      !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 
     452      !!  
     453      !!---------------------------------------------------------------------- 
     454      INTEGER,                    INTENT(in)     ::   igrd     ! grid index 
     455      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated) 
     456      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
     457      !!  
     458      REAL(wp) ::   zcoef, zcoef1, zcoef2 
     459      REAL(wp), POINTER, DIMENSION(:,:,:)        :: pmask      ! land/sea mask for field 
     460      REAL(wp), POINTER, DIMENSION(:,:)        :: bdypmask      ! land/sea mask for field 
     461      INTEGER  ::   ib, ik   ! dummy loop indices 
     462      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
     463      !!---------------------------------------------------------------------- 
     464      !! 
     465      IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 
     466      ! 
     467      SELECT CASE(igrd) 
     468         CASE(1) 
     469            pmask => tmask(:,:,:) 
     470            bdypmask => bdytmask(:,:) 
     471         CASE(2) 
     472            pmask => umask(:,:,:) 
     473            bdypmask => bdyumask(:,:) 
     474         CASE(3) 
     475            pmask => vmask(:,:,:) 
     476            bdypmask => bdyvmask(:,:) 
     477         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 
     478      END SELECT 
     479      DO ib = 1, idx%nblenrim(igrd) 
     480         ii = idx%nbi(ib,igrd) 
     481         ij = idx%nbj(ib,igrd) 
     482         DO ik = 1, jpkm1 
     483            ! search the sense of the gradient 
     484            zcoef1 = bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik) +  bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) 
     485            zcoef2 = bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik) +  bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) 
     486            IF ( nint(zcoef1+zcoef2) == 0) THEN 
     487               ! corner **** we probably only want to set the tangentail component for the dynamics here 
     488               zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) +  pmask(ii,ij-1,ik) +  pmask(ii,ij+1,ik) 
     489               IF (zcoef > .5_wp) THEN ! Only set none isolated points. 
     490                 phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik) + & 
     491                   &              phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik) + & 
     492                   &              phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik) + & 
     493                   &              phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik) 
     494                 phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik) 
     495               ELSE 
     496                 phia(ii,ij,ik) = phia(ii,ij  ,ik) * pmask(ii,ij  ,ik) 
     497               ENDIF 
     498            ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 
     499               ! oblique corner **** we probably only want to set the normal component for the dynamics here 
     500               zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij  ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij  ) + & 
     501                   &   pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) +  pmask(ii,ij+1,ik)*bdypmask(ii,ij+1  ) 
     502               phia(ii,ij,ik) = phia(ii-1,ij  ,ik) * pmask(ii-1,ij  ,ik)*bdypmask(ii-1,ij  ) + & 
     503                   &            phia(ii+1,ij  ,ik) * pmask(ii+1,ij  ,ik)*bdypmask(ii+1,ij  )  + & 
     504                   &            phia(ii  ,ij-1,ik) * pmask(ii  ,ij-1,ik)*bdypmask(ii,ij -1 ) + & 
     505                   &            phia(ii  ,ij+1,ik) * pmask(ii  ,ij+1,ik)*bdypmask(ii,ij+1  ) 
     506  
     507               phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik) 
     508            ELSE 
     509               ip = nint(bdypmask(ii+1,ij  )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij  )*pmask(ii-1,ij,ik)) 
     510               jp = nint(bdypmask(ii  ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii  ,ij-1)*pmask(ii,ij-1,ik)) 
     511               phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 
     512            ENDIF 
     513         END DO 
     514      END DO 
     515      ! 
     516      IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 
     517      ! 
     518   END SUBROUTINE bdy_nmn 
    370519 
    371520   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r6140 r7646  
    1111   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes 
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_bdy 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_bdy'     Open Boundary Condition 
    16    !!---------------------------------------------------------------------- 
    1713   !!   bdytide_init  : read of namelist and initialisation of tidal harmonics data 
    1814   !!   tide_update   : calculation of tidal forcing at each timestep 
    … …  
    2117   USE dom_oce        ! ocean space and time domain 
    2218   USE phycst         ! physical constants 
    23    USE bdy_par        ! Unstructured boundary parameters 
    2419   USE bdy_oce        ! ocean open boundary conditions 
    2520   USE tideini        !  
    … …  
    10095 
    10196      DO ib_bdy = 1, nb_bdy 
    102          IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    103  
     97         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
     98            ! 
    10499            td => tides(ib_bdy) 
    105100            nblen => idx_bdy(ib_bdy)%nblen 
    … …  
    134129            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    135130            ! relaxation area       
    136             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    137                ilen0(:)=nblen(:) 
    138             ELSE 
    139                ilen0(:)=nblenrim(:) 
     131            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
     132            ELSE                                   ;   ilen0(:) = nblenrim(:) 
    140133            ENDIF 
    141134 
    … …  
    156149            td%v   (:,:,:) = 0._wp 
    157150 
    158             IF (ln_bdytide_2ddta) THEN 
     151            IF( ln_bdytide_2ddta ) THEN 
    159152               ! It is assumed that each data file contains all complex harmonic amplitudes 
    160                ! given on the data domain (ie global, jpidta x jpjdta) 
    161                ! 
    162                CALL wrk_alloc( jpi, jpj, zti, ztr ) 
     153               ! given on the global domain (ie global, jpiglo x jpjglo) 
     154               ! 
     155               CALL wrk_alloc( jpi,jpj,  zti, ztr ) 
    163156               ! 
    164157               ! SSH fields 
    165158               clfile = TRIM(filtide)//'_grid_T.nc' 
    166                CALL iom_open (clfile , inum )  
     159               CALL iom_open( clfile , inum )  
    167160               igrd = 1                       ! Everything is at T-points here 
    168161               DO itide = 1, nb_harmo 
    169                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
    170                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )  
     162                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
     163                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )  
    171164                  DO ib = 1, ilen0(igrd) 
    172165                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    180173               ! U fields 
    181174               clfile = TRIM(filtide)//'_grid_U.nc' 
    182                CALL iom_open (clfile , inum )  
     175               CALL iom_open( clfile , inum )  
    183176               igrd = 2                       ! Everything is at U-points here 
    184177               DO itide = 1, nb_harmo 
    185                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 
    186                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 
     178                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 
     179                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 
    187180                  DO ib = 1, ilen0(igrd) 
    188181                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    196189               ! V fields 
    197190               clfile = TRIM(filtide)//'_grid_V.nc' 
    198                CALL iom_open (clfile , inum )  
     191               CALL iom_open( clfile , inum )  
    199192               igrd = 3                       ! Everything is at V-points here 
    200193               DO itide = 1, nb_harmo 
    201                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 
    202                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 
     194                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 
     195                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 
    203196                  DO ib = 1, ilen0(igrd) 
    204197                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    210203               CALL iom_close( inum ) 
    211204               ! 
    212                CALL wrk_dealloc( jpi, jpj, ztr, zti )  
     205               CALL wrk_dealloc( jpi,jpj,  ztr, zti )  
    213206               ! 
    214207            ELSE             
    … …  
    219212               ! 
    220213               ! Set map structure 
    221                ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1) 
    222                ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy) 
    223                ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2) 
    224                ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy) 
    225                ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3) 
    226                ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy) 
     214               ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)   ;   ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy) 
     215               ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)   ;   ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy) 
     216               ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)   ;   ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy) 
    227217 
    228218               ! Open files and read in tidal forcing data 
    … …  
    258248               ! 
    259249               DEALLOCATE( dta_read ) 
     250               ! 
    260251            ENDIF ! ln_bdytide_2ddta=.true. 
    261252            ! 
    … …  
    275266            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    276267            ! 
    277          ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 
     268         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 
    278269         ! 
    279270      END DO ! loop on ib_bdy 
    … …  
    376367   END SUBROUTINE bdytide_update 
    377368 
     369 
    378370   SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) 
    379371      !!---------------------------------------------------------------------- 
    … …  
    422414 
    423415      DO ib_bdy = 1,nb_bdy 
    424  
    425          IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    426  
     416         ! 
     417         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
     418            ! 
    427419            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    428420            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    429  
    430             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    431                ilen0(:)=nblen(:) 
    432             ELSE 
    433                ilen0(:)=nblenrim(:) 
     421            ! 
     422            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
     423            ELSE                                   ;   ilen0(:) = nblenrim(:) 
    434424            ENDIF      
    435  
     425            ! 
    436426            ! We refresh nodal factors every day below 
    437427            ! This should be done somewhere else 
    … …  
    598588  END SUBROUTINE tide_init_velocities 
    599589 
    600 #else 
    601    !!---------------------------------------------------------------------- 
    602    !!   Dummy module         NO Unstruct Open Boundary Conditions for tides 
    603    !!---------------------------------------------------------------------- 
    604 CONTAINS 
    605    SUBROUTINE bdytide_init             ! Empty routine 
    606       WRITE(*,*) 'bdytide_init: You should not have seen this print! error?' 
    607    END SUBROUTINE bdytide_init 
    608    SUBROUTINE bdytide_update( kt, jit )   ! Empty routine 
    609       WRITE(*,*) 'bdytide_update: You should not have seen this print! error?', kt, jit 
    610    END SUBROUTINE bdytide_update 
    611    SUBROUTINE bdy_dta_tides( kt, kit, time_offset )     ! Empty routine 
    612       INTEGER, INTENT( in )            ::   kt          ! Dummy argument empty routine       
    613       INTEGER, INTENT( in ),OPTIONAL   ::   kit         ! Dummy argument empty routine 
    614       INTEGER, INTENT( in ),OPTIONAL   ::   time_offset ! Dummy argument empty routine 
    615       WRITE(*,*) 'bdy_dta_tides: You should not have seen this print! error?', kt, jit 
    616    END SUBROUTINE bdy_dta_tides 
    617 #endif 
    618  
    619590   !!====================================================================== 
    620591END MODULE bdytides 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r6140 r7646  
    88   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    99   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
     10   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure 
    1011   !!---------------------------------------------------------------------- 
    11 #if defined key_bdy 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_bdy'                     Unstructured Open Boundary Conditions 
    14    !!---------------------------------------------------------------------- 
    15    !!   bdy_tra            : Apply open boundary conditions to T and S 
    16    !!   bdy_tra_frs        : Apply Flow Relaxation Scheme 
     12   !!   bdy_tra       : Apply open boundary conditions & damping to T and S 
    1713   !!---------------------------------------------------------------------- 
    1814   USE oce            ! ocean dynamics and tracers variables 
    … …  
    2016   USE bdy_oce        ! ocean open boundary conditions 
    2117   USE bdylib         ! for orlanski library routines 
    22    USE bdydta   , ONLY:   bf   !  
    2318   ! 
    2419   USE in_out_manager ! I/O manager 
    … …  
    2924   PRIVATE 
    3025 
     26   ! Local structure to rearrange tracers data 
     27   TYPE, PUBLIC ::   ztrabdy 
     28      REAL(wp), POINTER, DIMENSION(:,:) ::  tra 
     29   END TYPE 
     30 
    3131   PUBLIC   bdy_tra      ! called in tranxt.F90  
    3232   PUBLIC   bdy_tra_dmp  ! called in step.F90  
    3333 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 4.0, NEMO Consortium (2016) 
    3636   !! $Id$  
    3737   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4848      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    4949      ! 
    50       INTEGER ::   ib_bdy   ! Loop index 
     50      INTEGER                        :: ib_bdy, jn, igrd   ! Loop indeces 
     51      TYPE(ztrabdy), DIMENSION(jpts) :: zdta               ! Temporary data structure 
    5152      !!---------------------------------------------------------------------- 
     53      igrd = 1  
    5254 
    5355      DO ib_bdy=1, nb_bdy 
    5456         ! 
    55          SELECT CASE( cn_tra(ib_bdy) ) 
    56          CASE('none'        )   ;   CYCLE 
    57          CASE('frs'         )   ;   CALL bdy_tra_frs     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    58          CASE('specified'   )   ;   CALL bdy_tra_spe     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    59          CASE('neumann'     )   ;   CALL bdy_tra_nmn     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    60          CASE('orlanski'    )   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 
    61          CASE('orlanski_npo')   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 
    62          CASE('runoff'      )   ;   CALL bdy_tra_rnf     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    63          CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    64          END SELECT 
    65          ! Boundary points should be updated 
    66          CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 
    67          CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 
     57         zdta(1)%tra => dta_bdy(ib_bdy)%tem 
     58         zdta(2)%tra => dta_bdy(ib_bdy)%sal 
     59         ! 
     60         DO jn = 1, jpts 
     61            ! 
     62            SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     63            CASE('none'        )   ;   CYCLE 
     64            CASE('frs'         )   ;   CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     65            CASE('specified'   )   ;   CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     66            CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn)               ) 
     67            CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 
     68            CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 
     69            CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn),               jn ) 
     70            CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
     71            END SELECT 
     72            ! Boundary points should be updated 
     73            CALL lbc_bdy_lnk( tsa(:,:,:,jn), 'T', 1., ib_bdy ) 
     74            !  
     75         END DO 
    6876      END DO 
    6977      ! 
    7078   END SUBROUTINE bdy_tra 
    7179 
    72  
    73    SUBROUTINE bdy_tra_frs( idx, dta, kt ) 
     80   SUBROUTINE bdy_rnf( idx, pta, jpa ) 
    7481      !!---------------------------------------------------------------------- 
    75       !!                 ***  SUBROUTINE bdy_tra_frs  *** 
     82      !!                 ***  SUBROUTINE bdy_rnf  *** 
    7683      !!                     
    77       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
    78       !!  
    79       !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    80       !!---------------------------------------------------------------------- 
    81       INTEGER,         INTENT(in) ::   kt    ! 
    82       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    83       TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
    84       ! 
    85       REAL(wp) ::   zwgt           ! boundary weight 
    86       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    87       INTEGER  ::   ii, ij         ! 2D addresses 
    88       !!---------------------------------------------------------------------- 
    89       ! 
    90       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_frs') 
    91       ! 
    92       igrd = 1                       ! Everything is at T-points here 
    93       DO ib = 1, idx%nblen(igrd) 
    94          DO ik = 1, jpkm1 
    95             ii = idx%nbi(ib,igrd) 
    96             ij = idx%nbj(ib,igrd) 
    97             zwgt = idx%nbw(ib,igrd) 
    98             tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik)          
    99             tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik) 
    100          END DO 
    101       END DO  
    102       ! 
    103       IF( kt .eq. nit000 )   CLOSE( unit = 102 ) 
    104       ! 
    105       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_frs') 
    106       ! 
    107    END SUBROUTINE bdy_tra_frs 
    108  
    109  
    110    SUBROUTINE bdy_tra_spe( idx, dta, kt ) 
    111       !!---------------------------------------------------------------------- 
    112       !!                 ***  SUBROUTINE bdy_tra_frs  *** 
    113       !!                     
    114       !! ** Purpose : Apply a specified value for tracers at open boundaries. 
     84      !! ** Purpose : Specialized routine to apply TRA runoff values at OBs: 
     85      !!                  - duplicate the neighbour value for the temperature 
     86      !!                  - specified to 0.1 PSU for the salinity 
    11587      !!  
    11688      !!---------------------------------------------------------------------- 
    117       INTEGER,         INTENT(in) ::   kt    ! 
    118       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    119       TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
    120       ! 
    121       REAL(wp) ::   zwgt           ! boundary weight 
    122       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    123       INTEGER  ::   ii, ij         ! 2D addresses 
    124       !!---------------------------------------------------------------------- 
    125       ! 
    126       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe') 
    127       ! 
    128       igrd = 1                       ! Everything is at T-points here 
    129       DO ib = 1, idx%nblenrim(igrd) 
    130          ii = idx%nbi(ib,igrd) 
    131          ij = idx%nbj(ib,igrd) 
    132          DO ik = 1, jpkm1 
    133             tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik) 
    134             tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik) 
    135          END DO 
    136       END DO 
    137       ! 
    138       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    139       ! 
    140       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_spe') 
    141       ! 
    142    END SUBROUTINE bdy_tra_spe 
    143  
    144  
    145    SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 
    146       !!---------------------------------------------------------------------- 
    147       !!                 ***  SUBROUTINE bdy_tra_nmn  *** 
    148       !!                     
    149       !! ** Purpose : Duplicate the value for tracers at open boundaries. 
    150       !!  
    151       !!---------------------------------------------------------------------- 
    152       INTEGER,         INTENT(in) ::   kt    !  
    153       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    154       TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
    155       ! 
    156       REAL(wp) ::   zwgt           ! boundary weight 
    157       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    158       INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses 
    159       !!---------------------------------------------------------------------- 
    160       ! 
    161       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_nmn') 
    162       ! 
    163       igrd = 1                       ! Everything is at T-points here 
    164       DO ib = 1, idx%nblenrim(igrd) 
    165          ii = idx%nbi(ib,igrd) 
    166          ij = idx%nbj(ib,igrd) 
    167          DO ik = 1, jpkm1 
    168             ! search the sense of the gradient 
    169             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    170             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    171             IF ( zcoef1+zcoef2 == 0) THEN 
    172                ! corner 
    173                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
    174                tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij  ,ik,jp_tem) * tmask(ii-1,ij  ,ik) + & 
    175                  &                    tsa(ii+1,ij  ,ik,jp_tem) * tmask(ii+1,ij  ,ik) + & 
    176                  &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + & 
    177                  &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik) 
    178                tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    179                tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + & 
    180                  &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + & 
    181                  &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + & 
    182                  &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik) 
    183                tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    184             ELSE 
    185                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    186                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    187                tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 
    188                tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik) 
    189             ENDIF 
    190          END DO 
    191       END DO 
    192       ! 
    193       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    194       ! 
    195       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_nmn') 
    196       ! 
    197    END SUBROUTINE bdy_tra_nmn 
    198   
    199  
    200    SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 
    201       !!---------------------------------------------------------------------- 
    202       !!                 ***  SUBROUTINE bdy_tra_orlanski  *** 
    203       !!              
    204       !!              - Apply Orlanski radiation to temperature and salinity.  
    205       !!              - Wrapper routine for bdy_orlanski_3d 
    206       !!  
    207       !! 
    208       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    209       !!---------------------------------------------------------------------- 
    210       TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    211       TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    212       LOGICAL        , INTENT(in) ::   ll_npo  ! switch for NPO version 
    213       ! 
    214       INTEGER  ::   igrd                                    ! grid index 
    215       !!---------------------------------------------------------------------- 
    216       ! 
    217       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 
    218       ! 
    219       igrd = 1      ! Orlanski bc on temperature;  
    220       !             
    221       CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 
    222  
    223       igrd = 1      ! Orlanski bc on salinity; 
    224       !   
    225       CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 
    226       ! 
    227       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_orlanski') 
    228       ! 
    229    END SUBROUTINE bdy_tra_orlanski 
    230  
    231  
    232    SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 
    233       !!---------------------------------------------------------------------- 
    234       !!                 ***  SUBROUTINE bdy_tra_rnf  *** 
    235       !!                     
    236       !! ** Purpose : Apply the runoff values for tracers at open boundaries: 
    237       !!                  - specified to 0.1 PSU for the salinity 
    238       !!                  - duplicate the value for the temperature 
    239       !!  
    240       !!---------------------------------------------------------------------- 
    241       INTEGER        , INTENT(in) ::   kt    !  
    242       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    243       TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
     89      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     91      INTEGER,                             INTENT(in) ::   jpa  ! TRA index 
    24492      ! 
    24593      REAL(wp) ::   zwgt           ! boundary weight 
    … …  
    24896      !!---------------------------------------------------------------------- 
    24997      ! 
    250       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_rnf') 
     98      IF( nn_timing == 1 )   CALL timing_start('bdy_rnf') 
    25199      ! 
    252100      igrd = 1                       ! Everything is at T-points here 
    … …  
    257105            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    258106            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    259             tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik) 
    260             tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik) 
     107            if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 
     108            if (jpa == jp_sal) pta(ii,ij,ik) =                 0.1 * tmask(ii,ij,ik) 
    261109         END DO 
    262110      END DO 
    263111      ! 
    264       IF( kt == nit000 )   CLOSE( unit = 102 ) 
     112      IF( nn_timing == 1 )   CALL timing_stop('bdy_rnf') 
    265113      ! 
    266       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_rnf') 
    267       ! 
    268    END SUBROUTINE bdy_tra_rnf 
    269  
     114   END SUBROUTINE bdy_rnf 
    270115 
    271116   SUBROUTINE bdy_tra_dmp( kt ) 
    … …  
    308153   END SUBROUTINE bdy_tra_dmp 
    309154  
    310 #else 
    311    !!---------------------------------------------------------------------- 
    312    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
    313    !!---------------------------------------------------------------------- 
    314 CONTAINS 
    315    SUBROUTINE bdy_tra(kt)      ! Empty routine 
    316       WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt 
    317    END SUBROUTINE bdy_tra 
    318  
    319    SUBROUTINE bdy_tra_dmp(kt)      ! Empty routine 
    320       WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt 
    321    END SUBROUTINE bdy_tra_dmp 
    322 #endif 
    323  
    324155   !!====================================================================== 
    325156END MODULE bdytra 

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r6140 r7646  
    99   !!            3.0  !  2008-04  (NEMO team)  add in the reference version 
    1010   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    11    !!---------------------------------------------------------------------- 
    12 #if defined key_bdy 
    13    !!---------------------------------------------------------------------- 
    14    !!   'key_bdy'                     unstructured open boundary conditions 
    1511   !!---------------------------------------------------------------------- 
    1612   USE oce            ! ocean dynamics and tracers  
    … …  
    175171   END SUBROUTINE bdy_vol 
    176172 
    177 #else 
    178    !!---------------------------------------------------------------------- 
    179    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
    180    !!---------------------------------------------------------------------- 
    181 CONTAINS 
    182    SUBROUTINE bdy_vol( kt )        ! Empty routine 
    183       WRITE(*,*) 'bdy_vol: You should not have seen this print! error?', kt 
    184    END SUBROUTINE bdy_vol 
    185 #endif 
    186  
    187173   !!====================================================================== 
    188174END MODULE bdyvol 
Note: See TracChangeset for help on using the changeset viewer.