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 7351 for branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Ignore:
Timestamp:
2016-11-28T17:04:10+01:00 (7 years ago)
Author:
emanuelaclementi
Message:

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

Location:
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r5836 r7351  
    7070      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology 
    7171      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_s   !: now snow thickness 
     72#endif 
     73#if defined key_top 
     74      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply 
     75      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor 
     76      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer 
     77      LOGICAL                             :: dmp     !: obc damping term 
    7278#endif 
    7379   END TYPE OBC_DATA 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r5930 r7351  
    4545   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set. 
    4646   INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets. 
    47  
    4847   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions 
    4948                                                               ! =F => baroclinic velocities in 3D boundary conditions 
    … …  
    5857#endif 
    5958 
    60 #  include "domzgr_substitute.h90" 
    6159   !!---------------------------------------------------------------------- 
    6260   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    7573      !!                 
    7674      !!---------------------------------------------------------------------- 
    77       !! 
    78       INTEGER, INTENT( in )           ::   kt    ! ocean time-step index  
    79       INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
    80       INTEGER, INTENT( in ), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit 
    81                                                         ! is present then units = subcycle timesteps. 
    82                                                         ! time_offset = 0 => get data at "now" time level 
    83                                                         ! time_offset = -1 => get data at "before" time level 
    84                                                         ! time_offset = +1 => get data at "after" time level 
    85                                                         ! etc. 
    86       !! 
    87       INTEGER     ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices 
     75      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index  
     76      INTEGER, INTENT(in), OPTIONAL ::   jit          ! subcycle time-step index (for timesplitting option) 
     77      INTEGER, INTENT(in), OPTIONAL ::   time_offset  ! time offset in units of timesteps. NB. if jit 
     78      !                                               ! is present then units = subcycle timesteps. 
     79      !                                               ! time_offset = 0 => get data at "now" time level 
     80      !                                               ! time_offset = -1 => get data at "before" time level 
     81      !                                               ! time_offset = +1 => get data at "after" time level 
     82      !                                               ! etc. 
     83      ! 
     84      INTEGER ::  ib_bdy, jfld, jstart, jend, ib, ii, ij, ik, igrd, jl  ! local indices 
    8885      INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
    8986      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
    9087      TYPE(OBC_DATA), POINTER             ::   dta              ! short cut 
    91       !! 
    9288      !!--------------------------------------------------------------------------- 
    93       !! 
    94       IF( nn_timing == 1 ) CALL timing_start('bdy_dta') 
    95  
     89      ! 
     90      IF( nn_timing == 1 )   CALL timing_start('bdy_dta') 
     91      ! 
    9692      ! Initialise data arrays once for all from initial conditions where required 
    9793      !--------------------------------------------------------------------------- 
    98       IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN 
     94      IF( kt == nit000 .AND. .NOT.PRESENT(jit) ) THEN 
    9995 
    10096         ! Calculate depth-mean currents 
    … …  
    10298          
    10399         DO ib_bdy = 1, nb_bdy 
    104  
     100            ! 
    105101            nblen => idx_bdy(ib_bdy)%nblen 
    106102            nblenrim => idx_bdy(ib_bdy)%nblenrim 
    107103            dta => dta_bdy(ib_bdy) 
    108104 
    109             IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
     105            IF( nn_dyn2d_dta(ib_bdy) == 0 ) THEN  
    110106               ilen1(:) = nblen(:) 
    111107               IF( dta%ll_ssh ) THEN  
    … …  
    135131            ENDIF 
    136132 
    137             IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
     133            IF( nn_dyn3d_dta(ib_bdy) == 0 ) THEN  
    138134               ilen1(:) = nblen(:) 
    139135               IF( dta%ll_u3d ) THEN  
    … …  
    159155            ENDIF 
    160156 
    161             IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
     157            IF( nn_tra_dta(ib_bdy) == 0 ) THEN  
    162158               ilen1(:) = nblen(:) 
    163159               IF( dta%ll_tem ) THEN 
    … …  
    184180 
    185181#if defined key_lim2 
    186             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN  
     182            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    187183               ilen1(:) = nblen(:) 
    188184               IF( dta%ll_frld ) THEN 
    … …  
    212208            ENDIF 
    213209#elif defined key_lim3 
    214             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN  
     210            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN  
    215211               ilen1(:) = nblen(:) 
    216212               IF( dta%ll_a_i ) THEN 
    … …  
    246242            ENDIF 
    247243#endif 
    248  
    249          ENDDO ! ib_bdy 
    250  
    251  
    252       ENDIF ! kt .eq. nit000 
     244         END DO ! ib_bdy 
     245         ! 
     246      ENDIF ! kt == nit000 
    253247 
    254248      ! update external data from files 
    … …  
    258252      DO ib_bdy = 1, nb_bdy    
    259253         dta => dta_bdy(ib_bdy) 
    260          IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 
     254         IF( nn_dta(ib_bdy) == 1 ) THEN ! skip this bit if no external data required 
    261255       
    262256            IF( PRESENT(jit) ) THEN 
    … …  
    264258               ! jit is optional argument for fld_read and bdytide_update 
    265259               IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    266                   IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    267                      IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
    268                      IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
    269                      IF( dta%ll_u3d ) dta%v2d(:) = 0.0 
     260                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     261                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 
     262                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 
     263                     IF( dta%ll_u3d ) dta%v2d(:) = 0._wp 
    270264                  ENDIF 
    271265                  IF (cn_tra(ib_bdy) /= 'runoff') THEN 
    272                      IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN 
     266                     IF( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 
    273267 
    274268                        jend = jstart + dta%nread(2) - 1 
    … …  
    278272                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields 
    279273                        IF( ln_full_vel_array(ib_bdy) .AND.                                             & 
    280                           &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
    281                           &      nn_dyn3d_dta(ib_bdy) .EQ. 1 ) )THEN 
     274                          &    ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR.  & 
     275                          &      nn_dyn3d_dta(ib_bdy) == 1 ) )THEN 
    282276 
    283277                           igrd = 2                      ! zonal velocity 
    284                            dta%u2d(:) = 0.0 
     278                           dta%u2d(:) = 0._wp 
    285279                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    286280                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    288282                              DO ik = 1, jpkm1 
    289283                                 dta%u2d(ib) = dta%u2d(ib) & 
    290                        &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
     284                       &                          + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    291285                              END DO 
    292                               dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
     286                              dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
    293287                           END DO 
    294288                           igrd = 3                      ! meridional velocity 
    295                            dta%v2d(:) = 0.0 
     289                           dta%v2d(:) = 0._wp 
    296290                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    297291                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    299293                              DO ik = 1, jpkm1 
    300294                                 dta%v2d(ib) = dta%v2d(ib) & 
    301                        &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
     295                       &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    302296                              END DO 
    303                               dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
     297                              dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
    304298                           END DO 
    305299                        ENDIF                     
    … …  
    331325                  END DO 
    332326               ELSE 
    333                   IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    334                      IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
    335                      IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
    336                      IF( dta%ll_v2d ) dta%v2d(:) = 0.0 
     327                  IF( nn_dyn2d_dta(ib_bdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     328                     IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 
     329                     IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 
     330                     IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 
    337331                  ENDIF 
    338332                  IF( dta%nread(1) .gt. 0 ) THEN ! update external data 
    … …  
    343337                  ! If full velocities in boundary data then split into barotropic and baroclinic data 
    344338                  IF( ln_full_vel_array(ib_bdy) .and.                                             & 
    345                     & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. & 
    346                     &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN 
     339                    & ( nn_dyn2d_dta(ib_bdy) == 1 .OR. nn_dyn2d_dta(ib_bdy) == 3 .OR. & 
     340                    &   nn_dyn3d_dta(ib_bdy) == 1 ) ) THEN 
    347341                     igrd = 2                      ! zonal velocity 
    348                      dta%u2d(:) = 0.0 
     342                     dta%u2d(:) = 0._wp 
    349343                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    350344                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    352346                        DO ik = 1, jpkm1 
    353347                           dta%u2d(ib) = dta%u2d(ib) & 
    354                  &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
     348                 &                       + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    355349                        END DO 
    356                         dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
     350                        dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
    357351                        DO ik = 1, jpkm1 
    358352                           dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
    … …  
    360354                     END DO 
    361355                     igrd = 3                      ! meridional velocity 
    362                      dta%v2d(:) = 0.0 
     356                     dta%v2d(:) = 0._wp 
    363357                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    364358                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    366360                        DO ik = 1, jpkm1 
    367361                           dta%v2d(ib) = dta%v2d(ib) & 
    368                  &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
     362                 &                       + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    369363                        END DO 
    370                         dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
     364                        dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
    371365                        DO ik = 1, jpkm1 
    372366                           dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 
    … …  
    413407                  ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    414408                  dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + ssh_ib(ii,ij) 
    415                ENDDO 
    416             ENDIF 
    417          ENDDO 
     409               END DO 
     410            ENDIF 
     411         END DO 
    418412      ENDIF 
    419  
     413      ! 
    420414      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta') 
    421  
    422       END SUBROUTINE bdy_dta 
    423  
    424  
    425       SUBROUTINE bdy_dta_init 
     415      ! 
     416   END SUBROUTINE bdy_dta 
     417 
     418 
     419   SUBROUTINE bdy_dta_init 
    426420      !!---------------------------------------------------------------------- 
    427421      !!                   ***  SUBROUTINE bdy_dta_init  *** 
    … …  
    433427      !!                 
    434428      !!---------------------------------------------------------------------- 
    435       !! 
    436       INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices 
    437       INTEGER      ::   ios                               ! Local integer output status for namelist read 
    438       !! 
     429      INTEGER ::   ib_bdy, jfld, jstart, jend, ierror, ios     ! Local integers 
     430      ! 
    439431      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
    440432      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files 
    … …  
    469461      NAMELIST/nambdy_dta/ ln_full_vel 
    470462      !!--------------------------------------------------------------------------- 
    471  
    472       IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init') 
    473  
     463      ! 
     464      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_init') 
     465      ! 
    474466      IF(lwp) WRITE(numout,*) 
    475467      IF(lwp) WRITE(numout,*) 'bdy_dta_ini : initialization of data at the open boundaries' 
    … …  
    486478#endif 
    487479                              ) 
    488          IF(nn_dta(ib_bdy) .gt. 1) nn_dta(ib_bdy) = 1 
     480         IF(nn_dta(ib_bdy) > 1) nn_dta(ib_bdy) = 1 
    489481      END DO 
    490482 
    … …  
    494486      nb_bdy_fld(:) = 0 
    495487      DO ib_bdy = 1, nb_bdy          
    496          IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
     488         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) THEN 
    497489            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    498490         ENDIF 
    499          IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
     491         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) == 1 ) THEN 
    500492            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    501493         ENDIF 
    502          IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
     494         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) == 1  ) THEN 
    503495            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    504496         ENDIF 
    505497#if ( defined key_lim2 || defined key_lim3 ) 
    506          IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) .eq. 1  ) THEN 
     498         IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1  ) THEN 
    507499            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    508500         ENDIF 
    509501#endif                
    510502         IF(lwp) WRITE(numout,*) 'Maximum number of files to open =',nb_bdy_fld(ib_bdy) 
    511       ENDDO             
     503      END DO             
    512504 
    513505      nb_bdy_fld_sum = SUM( nb_bdy_fld ) 
    … …  
    535527      jfld = 0  
    536528      DO ib_bdy = 1, nb_bdy          
    537          IF( nn_dta(ib_bdy) .eq. 1 ) THEN 
     529         IF( nn_dta(ib_bdy) == 1 ) THEN 
    538530            READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
    539 901         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
     531901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
    540532 
    541533            READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 
    542 902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
    543             IF(lwm) WRITE ( numond, nambdy_dta ) 
     534902         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 
     535            IF(lwm) WRITE( numond, nambdy_dta ) 
    544536 
    545537            cn_dir_array(ib_bdy) = cn_dir 
    … …  
    553545            ! Only read in necessary fields for this set. 
    554546            ! Important that barotropic variables come first. 
    555             IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN  
     547            IF( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN  
    556548 
    557549               IF( dta%ll_ssh ) THEN  
    … …  
    592584            ! read 3D velocities if baroclinic velocities require OR if 
    593585            ! barotropic velocities required and ln_full_vel set to .true. 
    594             IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
    595            &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    596  
    597                IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     586            IF( nn_dyn3d_dta(ib_bdy) == 1 .OR. & 
     587           &  ( ln_full_vel_array(ib_bdy) .AND. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN 
     588 
     589               IF( dta%ll_u3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
    598590                  if(lwp) write(numout,*) '++++++ reading in u3d field' 
    599591                  jfld = jfld + 1 
    … …  
    606598               ENDIF 
    607599 
    608                IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     600               IF( dta%ll_v3d .OR. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
    609601                  if(lwp) write(numout,*) '++++++ reading in v3d field' 
    610602                  jfld = jfld + 1 
    … …  
    620612 
    621613            ! temperature and salinity 
    622             IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
     614            IF( nn_tra_dta(ib_bdy) == 1 ) THEN 
    623615 
    624616               IF( dta%ll_tem ) THEN 
    … …  
    646638#if defined key_lim2 
    647639            ! sea ice 
    648             IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
     640            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    649641 
    650642               IF( dta%ll_frld ) THEN 
    … …  
    678670#elif defined key_lim3 
    679671            ! sea ice 
    680             IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
     672            IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 
    681673               ! Test for types of ice input (lim2 or lim3)  
    682674               ! Build file name to find dimensions  
    … …  
    733725            ! Recalculate field counts 
    734726            !------------------------- 
    735             IF( ib_bdy .eq. 1 ) THEN  
     727            IF( ib_bdy == 1 ) THEN  
    736728               nb_bdy_fld_sum = 0 
    737729               nb_bdy_fld(ib_bdy) = jfld 
    … …  
    744736            dta%nread(1) = nb_bdy_fld(ib_bdy) 
    745737 
    746          ENDIF ! nn_dta .eq. 1 
     738         ENDIF ! nn_dta == 1 
    747739      ENDDO ! ib_bdy 
    748740 
    … …  
    785777         endif 
    786778 
    787          IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN 
     779         IF ( nn_dyn2d_dta(ib_bdy) == 0 .or. nn_dyn2d_dta(ib_bdy) == 2 ) THEN 
    788780            if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 
    789781            IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 
    … …  
    791783            IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 
    792784         ENDIF 
    793          IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 
     785         IF ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) THEN 
    794786            IF( dta%ll_ssh ) THEN 
    795787               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 
    … …  
    819811         ENDIF 
    820812 
    821          IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
     813         IF ( nn_dyn3d_dta(ib_bdy) == 0 ) THEN 
    822814            if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 
    823815            IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 
    824816            IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 
    825817         ENDIF 
    826          IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
    827            &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     818         IF ( nn_dyn3d_dta(ib_bdy) == 1 .or. & 
     819           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) == 1 .or. nn_dyn2d_dta(ib_bdy) == 3 ) ) ) THEN 
    828820            IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
    829821               if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 
    … …  
    838830         ENDIF 
    839831 
    840          IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
     832         IF( nn_tra_dta(ib_bdy) == 0 ) THEN 
    841833            if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 
    842834            IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) 
    … …  
    857849#if defined key_lim2 
    858850         IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    859             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
     851            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
    860852               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 
    861853               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 
    … …  
    872864#elif defined key_lim3 
    873865         IF (cn_ice_lim(ib_bdy) /= 'none') THEN 
    874             IF( nn_ice_lim_dta(ib_bdy) .eq. 0 ) THEN 
     866            IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 
    875867               ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) ) 
    876868               ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 
    … …  
    892884                  ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 
    893885                  ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) ) 
    894                   dta_bdy(ib_bdy)%a_i (:,:) = 0.0 
    895                   dta_bdy(ib_bdy)%ht_i(:,:) = 0.0 
    896                   dta_bdy(ib_bdy)%ht_s(:,:) = 0.0 
    897                ENDIF 
    898  
    899             ENDIF 
    900          ENDIF 
    901 #endif 
    902  
    903       ENDDO ! ib_bdy  
    904  
     886                  dta_bdy(ib_bdy)%a_i (:,:) = 0._wp 
     887                  dta_bdy(ib_bdy)%ht_i(:,:) = 0._wp 
     888                  dta_bdy(ib_bdy)%ht_s(:,:) = 0._wp 
     889               ENDIF 
     890 
     891            ENDIF 
     892         ENDIF 
     893#endif 
     894         ! 
     895      END DO ! ib_bdy  
     896      ! 
    905897      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init') 
    906  
    907       END SUBROUTINE bdy_dta_init 
     898      ! 
     899   END SUBROUTINE bdy_dta_init 
    908900 
    909901#else 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r5930 r7351  
    3636   PUBLIC   bdy_dyn    ! routine called in dyn_nxt 
    3737 
    38 #  include "domzgr_substitute.h90" 
    3938   !!---------------------------------------------------------------------- 
    4039   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    5150      !! 
    5251      !!---------------------------------------------------------------------- 
    53       !! 
    54       INTEGER, INTENT( in )           :: kt               ! Main time step counter 
    55       LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities 
    56       !! 
    57       INTEGER               :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter 
    58       LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski 
    59       !! 
     52      INTEGER, INTENT(in)           ::   kt           ! Main time step counter 
     53      LOGICAL, INTENT(in), OPTIONAL ::   dyn3d_only   ! T => only update baroclinic velocities 
     54      ! 
     55      INTEGER ::   jk, ii, ij, ib_bdy, ib, igrd     ! Loop counter 
     56      LOGICAL ::   ll_dyn2d, ll_dyn3d, ll_orlanski 
    6057      REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d     ! after barotropic velocities 
    61  
    62       IF( nn_timing == 1 ) CALL timing_start('bdy_dyn') 
    63  
     58      !!---------------------------------------------------------------------- 
     59      ! 
     60      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn') 
     61      ! 
    6462      ll_dyn2d = .true. 
    6563      ll_dyn3d = .true. 
    66  
     64      ! 
    6765      IF( PRESENT(dyn3d_only) ) THEN 
    68          IF( dyn3d_only ) ll_dyn2d = .false. 
     66         IF( dyn3d_only )   ll_dyn2d = .false. 
    6967      ENDIF 
    70  
     68      ! 
    7169      ll_orlanski = .false. 
    7270      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 
     71         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .OR. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 
     72     &   .OR. cn_dyn3d(ib_bdy) == 'orlanski' .OR. cn_dyn3d(ib_bdy) == 'orlanski_npo')  ll_orlanski = .true. 
     73      END DO 
    7674 
    7775      !------------------------------------------------------- 
    … …  
    7977      !------------------------------------------------------- 
    8078 
    81       CALL wrk_alloc(jpi,jpj,pua2d,pva2d)  
     79      CALL wrk_alloc( jpi,jpj,   pua2d, pva2d )  
    8280 
    8381      !------------------------------------------------------- 
    … …  
    8583      !------------------------------------------------------- 
    8684 
    87       ! "After" velocities:  
     85      !                          ! "After" velocities:  
     86      pua2d(:,:) = 0._wp 
     87      pva2d(:,:) = 0._wp      
     88      DO jk = 1, jpkm1 
     89         pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     90         pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
     91      END DO 
     92      pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:) 
     93      pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:) 
    8894 
    89       pua2d(:,:) = 0.e0 
    90       pva2d(:,:) = 0.e0       
    91       DO jk = 1, jpkm1 
    92          pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    93          pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     95      DO jk = 1 , jpkm1 
     96         ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk) 
     97         va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk) 
    9498      END DO 
    9599 
    96       pua2d(:,:) = pua2d(:,:) * hur_a(:,:) 
    97       pva2d(:,:) = pva2d(:,:) * hvr_a(:,:) 
    98100 
    99       DO jk = 1 , jpkm1 
    100          ua(:,:,jk) = (ua(:,:,jk) - pua2d(:,:)) * umask(:,:,jk) 
    101          va(:,:,jk) = (va(:,:,jk) - pva2d(:,:)) * vmask(:,:,jk) 
    102       END DO 
    103  
    104       ! "Before" velocities (required for Orlanski condition):  
    105  
    106       IF ( ll_orlanski ) THEN           
     101      IF( ll_orlanski ) THEN     ! "Before" velocities (Orlanski condition only)  
    107102         DO jk = 1 , jpkm1 
    108             ub(:,:,jk) = (ub(:,:,jk) - ub_b(:,:)) * umask(:,:,jk) 
    109             vb(:,:,jk) = (vb(:,:,jk) - vb_b(:,:)) * vmask(:,:,jk) 
     103            ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk) 
     104            vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk) 
    110105         END DO 
    111       END IF 
     106      ENDIF 
    112107 
    113108      !------------------------------------------------------- 
    … …  
    116111      !------------------------------------------------------- 
    117112 
    118       IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, hur_a(:,:), hvr_a(:,:), ssha ) 
     113      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha ) 
    119114 
    120       IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) 
     115      IF( ll_dyn3d )   CALL bdy_dyn3d( kt ) 
    121116 
    122117      !------------------------------------------------------- 
    123118      ! Recombine velocities 
    124119      !------------------------------------------------------- 
    125  
     120      ! 
    126121      DO jk = 1 , jpkm1 
    127122         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 
    128123         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 
    129124      END DO 
    130  
     125      ! 
    131126      IF ( ll_orlanski ) THEN 
    132127         DO jk = 1 , jpkm1 
    … …  
    135130         END DO 
    136131      END IF 
    137  
    138       CALL wrk_dealloc(jpi,jpj,pua2d,pva2d)  
    139  
    140       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 
    141  
     132      ! 
     133      CALL wrk_dealloc( jpi,jpj,  pua2d, pva2d )  
     134      ! 
     135      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn') 
     136      ! 
    142137   END SUBROUTINE bdy_dyn 
    143138 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r5215 r7351  
    2929   PUBLIC   bdy_dyn3d_dmp ! routine called by step 
    3030 
    31    !! * Substitutions 
    32 #  include "domzgr_substitute.h90" 
    3331   !!---------------------------------------------------------------------- 
    3432   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    4543      !! 
    4644      !!---------------------------------------------------------------------- 
    47       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    48       !! 
    49       INTEGER               :: ib_bdy ! loop index 
    50       !! 
    51  
     45      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
     46      ! 
     47      INTEGER ::   ib_bdy  ! loop index 
     48      !!---------------------------------------------------------------------- 
     49      ! 
    5250      DO ib_bdy=1, nb_bdy 
    53  
     51         ! 
    5452         SELECT CASE( cn_dyn3d(ib_bdy) ) 
    55          CASE('none') 
    56             CYCLE 
    57          CASE('frs') 
    58             CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    59          CASE('specified') 
    60             CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    61          CASE('zero') 
    62             CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    63          CASE('orlanski') 
    64             CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
    65          CASE('orlanski_npo') 
    66             CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    67          CASE DEFAULT 
    68             CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
     53         CASE('none')        ;   CYCLE 
     54         CASE('frs' )        ;   CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     55         CASE('specified')   ;   CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     56         CASE('zero')        ;   CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     57         CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     58         CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
     59         CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    6960         END SELECT 
    70       ENDDO 
    71  
     61      END DO 
     62      ! 
    7263   END SUBROUTINE bdy_dyn3d 
     64 
    7365 
    7466   SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy ) 
    … …  
    8072      !! 
    8173      !!---------------------------------------------------------------------- 
    82       INTEGER                     ::   kt 
    83       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    84       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    85       INTEGER,        INTENT(in) ::   ib_bdy  ! BDY set index 
    86       !! 
     74      INTEGER        , INTENT(in) ::   kt      ! time step index 
     75      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     76      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
     77      INTEGER        , INTENT(in) ::   ib_bdy  ! BDY set index 
     78      ! 
    8779      INTEGER  ::   jb, jk         ! dummy loop indices 
    8880      INTEGER  ::   ii, ij, igrd   ! local integers 
    … …  
    112104      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    113105      ! 
    114       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    115  
     106      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     107      ! 
    116108      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_spe') 
    117  
     109      ! 
    118110   END SUBROUTINE bdy_dyn3d_spe 
    119111 
     112 
    120113   SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) 
    121114      !!---------------------------------------------------------------------- 
    … …  
    125118      !! 
    126119      !!---------------------------------------------------------------------- 
    127       INTEGER                     ::   kt 
    128       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    129       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     120      INTEGER        , INTENT(in) ::   kt      ! time step index 
     121      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     122      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    130123      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    131       !! 
     124      ! 
    132125      INTEGER  ::   ib, ik         ! dummy loop indices 
    133       INTEGER  ::   ii, ij, igrd, zcoef   ! local integers 
     126      INTEGER  ::   ii, ij, igrd   ! local integers 
    134127      REAL(wp) ::   zwgt           ! boundary weight 
    135128      !!---------------------------------------------------------------------- 
    … …  
    157150      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
    158151      ! 
    159       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    160  
    161       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zro') 
    162  
     152      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     153      ! 
     154      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_zro') 
     155      ! 
    163156   END SUBROUTINE bdy_dyn3d_zro 
     157 
    164158 
    165159   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy ) 
    … …  
    174168      !!               topography. Tellus, 365-382. 
    175169      !!---------------------------------------------------------------------- 
    176       INTEGER                     ::   kt 
    177       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    178       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     170      INTEGER        , INTENT(in) ::   kt      ! time step index 
     171      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     172      TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    179173      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    180       !! 
     174      ! 
    181175      INTEGER  ::   jb, jk         ! dummy loop indices 
    182176      INTEGER  ::   ii, ij, igrd   ! local integers 
    … …  
    208202      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    209203      ! 
    210       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    211  
    212       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs') 
    213  
     204      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     205      ! 
     206      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_frs') 
     207      ! 
    214208   END SUBROUTINE bdy_dyn3d_frs 
     209 
    215210 
    216211   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) 
    … …  
    259254      !! 
    260255      !!---------------------------------------------------------------------- 
    261       INTEGER                     ::   kt 
    262       !! 
     256      INTEGER, INTENT(in) ::   kt   ! time step index 
     257      ! 
    263258      INTEGER  ::   jb, jk         ! dummy loop indices 
     259      INTEGER  ::   ib_bdy         ! loop index 
    264260      INTEGER  ::   ii, ij, igrd   ! local integers 
    265261      REAL(wp) ::   zwgt           ! boundary weight 
    266       INTEGER  ::  ib_bdy          ! loop index 
    267       !!---------------------------------------------------------------------- 
    268       ! 
    269       IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_dmp') 
    270       ! 
    271       !------------------------------------------------------- 
    272  
     262      !!---------------------------------------------------------------------- 
     263      ! 
     264      IF( nn_timing == 1 )   CALL timing_start('bdy_dyn3d_dmp') 
     265      ! 
    273266      DO ib_bdy=1, nb_bdy 
    274267         IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN 
    … …  
    295288            END DO 
    296289         ENDIF 
    297       ENDDO 
     290      END DO 
    298291      ! 
    299292      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated 
    300293      ! 
    301       IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_dmp') 
    302  
     294      IF( nn_timing == 1 )   CALL timing_stop('bdy_dyn3d_dmp') 
     295      ! 
    303296   END SUBROUTINE bdy_dyn3d_dmp 
    304297 
    … …  
    311304      WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt 
    312305   END SUBROUTINE bdy_dyn3d 
    313  
    314306   SUBROUTINE bdy_dyn3d_dmp( kt )      ! Empty routine 
    315307      WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt 
    316308   END SUBROUTINE bdy_dyn3d_dmp 
    317  
    318309#endif 
    319310 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r5836 r7351  
    1212   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    1313   !!            3.4  !  2012     (J. Chanut) straight open boundary case update 
    14    !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Updates for the  
    15    !!                             optimization of BDY communications 
     14   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) optimization of BDY communications 
    1615   !!---------------------------------------------------------------------- 
    1716#if defined key_bdy 
    … …  
    1918   !!   'key_bdy'                     Unstructured Open Boundary Conditions 
    2019   !!---------------------------------------------------------------------- 
    21    !!   bdy_init       : Initialization of unstructured open boundaries 
     20   !!   bdy_init      : Initialization of unstructured open boundaries 
    2221   !!---------------------------------------------------------------------- 
    23    USE wrk_nemo        ! Memory Allocation 
    24    USE timing          ! Timing 
    25    USE oce             ! ocean dynamics and tracers variables 
    26    USE dom_oce         ! ocean space and time domain 
    27    USE bdy_oce         ! unstructured open boundary conditions 
    28    USE in_out_manager  ! I/O units 
    29    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    30    USE lib_mpp         ! for mpp_sum   
    31    USE iom             ! I/O 
    32    USE sbctide, ONLY: lk_tide ! Tidal forcing or not 
    33    USE phycst, ONLY: rday 
     22   USE oce            ! ocean dynamics and tracers variables 
     23   USE dom_oce        ! ocean space and time domain 
     24   USE bdy_oce        ! unstructured open boundary conditions 
     25   USE sbctide  , ONLY: lk_tide ! Tidal forcing or not 
     26   USE phycst   , ONLY: rday 
     27   ! 
     28   USE in_out_manager ! I/O units 
     29   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     30   USE lib_mpp        ! for mpp_sum   
     31   USE iom            ! I/O 
     32   USE wrk_nemo       ! Memory Allocation 
     33   USE timing         ! Timing 
    3434 
    3535   IMPLICIT NONE 
    … …  
    3838   PUBLIC   bdy_init   ! routine called in nemo_init 
    3939 
    40    INTEGER, PARAMETER          :: jp_nseg = 100 
    41    INTEGER, PARAMETER          :: nrimmax = 20 ! maximum rimwidth in structured 
     40   INTEGER, PARAMETER ::   jp_nseg = 100   !  
     41   INTEGER, PARAMETER ::   nrimmax =  20  ! maximum rimwidth in structured 
    4242                                               ! open boundary data files 
    4343   ! Straight open boundary segment parameters: 
    44    INTEGER  :: nbdysege, nbdysegw, nbdysegn, nbdysegs  
    45    INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft, npckge 
    46    INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft, npckgw 
    47    INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft, npckgn 
    48    INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft, npckgs 
     44   INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs  
     45   INTEGER, DIMENSION(jp_nseg) ::   jpieob, jpjedt, jpjeft, npckge   ! 
     46   INTEGER, DIMENSION(jp_nseg) ::   jpiwob, jpjwdt, jpjwft, npckgw   ! 
     47   INTEGER, DIMENSION(jp_nseg) ::   jpjnob, jpindt, jpinft, npckgn   ! 
     48   INTEGER, DIMENSION(jp_nseg) ::   jpjsob, jpisdt, jpisft, npckgs   ! 
    4949   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     50   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    5151   !! $Id$  
    5252   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6666      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    6767      !!----------------------------------------------------------------------       
    68       ! namelist variables 
    69       !------------------- 
    70       CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile 
    71       CHARACTER(LEN=1)   ::   ctypebdy 
    72       INTEGER :: nbdyind, nbdybeg, nbdyend 
    7368 
    7469      ! local variables 
    … …  
    8176      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
    8277      INTEGER  ::   i_offset, j_offset                     !   -       - 
    83       INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts 
     78      INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts 
    8479      REAL(wp), POINTER  ::  flagu, flagv                  !    -   - 
    8580      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
    … …  
    9489      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
    9590      REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    96  
     91      !! 
     92      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile     ! Namelist variables 
     93      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        -  
     94      INTEGER                              ::   nbdyind, nbdybeg, nbdyend 
    9795      !! 
    9896      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,                 & 
    … …  
    103101         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
    104102         &             ln_vol, nn_volctl, nn_rimwidth 
    105       !! 
     103         ! 
    106104      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 
    107105      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    108106      !!---------------------------------------------------------------------- 
    109  
    110       IF( nn_timing == 1 ) CALL timing_start('bdy_init') 
    111  
     107      ! 
     108      IF( nn_timing == 1 )   CALL timing_start('bdy_init') 
     109      ! 
    112110      IF(lwp) WRITE(numout,*) 
    113111      IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries' 
    114112      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    115113      ! 
    116  
    117114      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   & 
    118115         &                               ' and general open boundary condition are not compatible' ) 
    119116 
    120       cgrid= (/'t','u','v'/) 
     117      cgrid = (/'t','u','v'/) 
    121118       
    122119      ! ------------------------ 
    123120      ! Read namelist parameters 
    124121      ! ------------------------ 
    125  
    126122      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries   
    127123      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
    128 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
    129  
     124901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp ) 
     125      ! 
    130126      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    131127      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    132 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
     128902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 
    133129      IF(lwm) WRITE ( numond, nambdy ) 
    134130 
    … …  
    137133      ! ----------------------------------------- 
    138134      !                                   ! control prints 
    139       IF(lwp) WRITE(numout,*) '         nambdy' 
    140  
    141       IF( nb_bdy .eq. 0 ) THEN  
     135      IF(lwp) WRITE(numout,*) '   nambdy' 
     136 
     137      IF( nb_bdy == 0 ) THEN  
    142138        IF(lwp) WRITE(numout,*) 'nb_bdy = 0, NO OPEN BOUNDARIES APPLIED.' 
    143139      ELSE 
    144         IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ',nb_bdy 
     140        IF(lwp) WRITE(numout,*) 'Number of open boundary sets : ', nb_bdy 
    145141      ENDIF 
    146142 
    … …  
    158154        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
    159155        SELECT CASE( cn_dyn2d(ib_bdy) )                   
    160           CASE('none')          
     156          CASE( 'none' )          
    161157             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    162158             dta_bdy(ib_bdy)%ll_ssh = .false. 
    163159             dta_bdy(ib_bdy)%ll_u2d = .false. 
    164160             dta_bdy(ib_bdy)%ll_v2d = .false. 
    165           CASE('frs')           
     161          CASE( 'frs' )           
    166162             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    167163             dta_bdy(ib_bdy)%ll_ssh = .false. 
    168164             dta_bdy(ib_bdy)%ll_u2d = .true. 
    169165             dta_bdy(ib_bdy)%ll_v2d = .true. 
    170           CASE('flather')       
     166          CASE( 'flather' )       
    171167             IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
    172168             dta_bdy(ib_bdy)%ll_ssh = .true. 
    173169             dta_bdy(ib_bdy)%ll_u2d = .true. 
    174170             dta_bdy(ib_bdy)%ll_v2d = .true. 
    175           CASE('orlanski')      
     171          CASE( 'orlanski' )      
    176172             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
    177173             dta_bdy(ib_bdy)%ll_ssh = .false. 
    178174             dta_bdy(ib_bdy)%ll_u2d = .true. 
    179175             dta_bdy(ib_bdy)%ll_v2d = .true. 
    180           CASE('orlanski_npo')  
     176          CASE( 'orlanski_npo' )  
    181177             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
    182178             dta_bdy(ib_bdy)%ll_ssh = .false. 
    … …  
    392388      REWIND( numnam_cfg )      
    393389 
    394       !!---------------------------------------------------------------------- 
    395  
    396                
    397                 
    398390      nblendta(:,:) = 0 
    399391      nbdysege = 0 
    … …  
    492484               nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 
    493485               jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) 
    494             ENDDO 
     486            END DO 
    495487            CALL iom_close( inum ) 
    496  
     488            ! 
    497489         ENDIF  
    498  
    499       ENDDO ! ib_bdy 
     490         ! 
     491      END DO ! ib_bdy 
    500492 
    501493      IF (nb_bdy>0) THEN 
    … …  
    514506      ! Now look for crossings in user (namelist) defined open boundary segments: 
    515507      !-------------------------------------------------------------------------- 
    516       IF ( icount>0 ) CALL bdy_ctl_seg 
     508      IF( icount>0 )  CALL bdy_ctl_seg 
    517509 
    518510      ! Calculate global boundary index arrays or read in from file 
    … …  
    520512      ! 1. Read global index arrays from boundary coordinates file. 
    521513      DO ib_bdy = 1, nb_bdy 
    522  
     514         ! 
    523515         IF( ln_coords_file(ib_bdy) ) THEN 
    524  
     516            ! 
    525517            CALL iom_open( cn_coords_file(ib_bdy), inum ) 
    526518            DO igrd = 1, jpbgrd 
    … …  
    537529                  nbrdta(ii,igrd,ib_bdy) = INT( dta_global(ii,1,1) ) 
    538530               END DO 
    539  
     531               ! 
    540532               ibr_max = MAXVAL( nbrdta(:,igrd,ib_bdy) ) 
    541533               IF(lwp) WRITE(numout,*) 
    … …  
    546538            END DO 
    547539            CALL iom_close( inum ) 
    548  
     540            ! 
    549541         ENDIF  
    550  
    551       ENDDO       
     542         ! 
     543      END DO       
    552544     
    553545      ! 2. Now fill indices corresponding to straight open boundary arrays: 
    … …  
    792784 
    793785      ! Work out dimensions of boundary data on each neighbour process 
    794       IF(nbondi .eq. 0) THEN 
     786      IF(nbondi == 0) THEN 
    795787         iw_b(1) = jpizoom + nimppt(nowe+1) 
    796788         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
    … …  
    802794         is_b(2) = jpjzoom + njmppt(noea+1) 
    803795         in_b(2) = jpjzoom + njmppt(noea+1)+nlcjt(noea+1)-3 
    804       ELSEIF(nbondi .eq. 1) THEN 
     796      ELSEIF(nbondi == 1) THEN 
    805797         iw_b(1) = jpizoom + nimppt(nowe+1) 
    806798         ie_b(1) = jpizoom + nimppt(nowe+1)+nlcit(nowe+1)-3 
    807799         is_b(1) = jpjzoom + njmppt(nowe+1) 
    808800         in_b(1) = jpjzoom + njmppt(nowe+1)+nlcjt(nowe+1)-3 
    809       ELSEIF(nbondi .eq. -1) THEN 
     801      ELSEIF(nbondi == -1) THEN 
    810802         iw_b(2) = jpizoom + nimppt(noea+1) 
    811803         ie_b(2) = jpizoom + nimppt(noea+1)+nlcit(noea+1)-3 
    … …  
    814806      ENDIF 
    815807 
    816       IF(nbondj .eq. 0) THEN 
     808      IF(nbondj == 0) THEN 
    817809         iw_b(3) = jpizoom + nimppt(noso+1) 
    818810         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
    … …  
    824816         is_b(4) = jpjzoom + njmppt(nono+1) 
    825817         in_b(4) = jpjzoom + njmppt(nono+1)+nlcjt(nono+1)-3 
    826       ELSEIF(nbondj .eq. 1) THEN 
     818      ELSEIF(nbondj == 1) THEN 
    827819         iw_b(3) = jpizoom + nimppt(noso+1) 
    828820         ie_b(3) = jpizoom + nimppt(noso+1)+nlcit(noso+1)-3 
    829821         is_b(3) = jpjzoom + njmppt(noso+1) 
    830822         in_b(3) = jpjzoom + njmppt(noso+1)+nlcjt(noso+1)-3 
    831       ELSEIF(nbondj .eq. -1) THEN 
     823      ELSEIF(nbondj == -1) THEN 
    832824         iw_b(4) = jpizoom + nimppt(nono+1) 
    833825         ie_b(4) = jpizoom + nimppt(nono+1)+nlcit(nono+1)-3 
    … …  
    867859         ! Allocate index arrays for this boundary set 
    868860         !-------------------------------------------- 
    869          ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:)) 
    870          ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) ) 
    871          ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) ) 
    872          ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 
    873          ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) ) 
     861         ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) ) 
     862         ALLOCATE( idx_bdy(ib_bdy)%nbi   (ilen1,jpbgrd) ) 
     863         ALLOCATE( idx_bdy(ib_bdy)%nbj   (ilen1,jpbgrd) ) 
     864         ALLOCATE( idx_bdy(ib_bdy)%nbr   (ilen1,jpbgrd) ) 
     865         ALLOCATE( idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) ) 
    874866         ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 
    875          ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 
    876          ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 
    877          ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1,jpbgrd) ) 
    878          ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1,jpbgrd) ) 
     867         ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ) 
     868         ALLOCATE( idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) ) 
     869         ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) ) 
     870         ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 
    879871 
    880872         ! Dispatch mapping indices and discrete distances on each processor 
    881873         ! ----------------------------------------------------------------- 
    882874 
    883          com_east = 0 
    884          com_west = 0 
     875         com_east  = 0 
     876         com_west  = 0 
    885877         com_south = 0 
    886878         com_north = 0 
    887879 
    888          com_east_b = 0 
    889          com_west_b = 0 
     880         com_east_b  = 0 
     881         com_west_b  = 0 
    890882         com_south_b = 0 
    891883         com_north_b = 0 
    … …  
    912904                     ii = idx_bdy(ib_bdy)%nbi(icount,igrd) 
    913905                     ij = idx_bdy(ib_bdy)%nbj(icount,igrd) 
    914                      if((com_east .ne. 1) .and. (ii .eq. (nlci-1)) .and. (nbondi .le. 0)) then 
     906                     if((com_east .ne. 1) .and. (ii == (nlci-1)) .and. (nbondi .le. 0)) then 
    915907                        com_east = 1 
    916                      elseif((com_west .ne. 1) .and. (ii .eq. 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 
     908                     elseif((com_west .ne. 1) .and. (ii == 2) .and. (nbondi .ge. 0) .and. (nbondi .ne. 2)) then 
    917909                        com_west = 1 
    918910                     endif  
    919                      if((com_south .ne. 1) .and. (ij .eq. 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 
     911                     if((com_south .ne. 1) .and. (ij == 2) .and. (nbondj .ge. 0) .and. (nbondj .ne. 2)) then 
    920912                        com_south = 1 
    921                      elseif((com_north .ne. 1) .and. (ij .eq. (nlcj-1)) .and. (nbondj .le. 0)) then 
     913                     elseif((com_north .ne. 1) .and. (ij == (nlcj-1)) .and. (nbondj .le. 0)) then 
    922914                        com_north = 1 
    923915                     endif  
    … …  
    926918                  ENDIF 
    927919                  ! check if point has to be received from a neighbour 
    928                   IF(nbondi .eq. 0) THEN 
     920                  IF(nbondi == 0) THEN 
    929921                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
    930922                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
    931923                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    932924                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    933                        if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then 
     925                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 
    934926                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    935                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     927                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    936928                            com_south = 1 
    937                           elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     929                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    938930                            com_north = 1 
    939931                          endif 
    … …  
    945937                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    946938                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    947                        if((com_east_b .ne. 1) .and. (ii .eq. 2)) then 
     939                       if((com_east_b .ne. 1) .and. (ii == 2)) then 
    948940                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    949                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     941                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    950942                            com_south = 1 
    951                           elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     943                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    952944                            com_north = 1 
    953945                          endif 
    … …  
    955947                       endif  
    956948                     ENDIF 
    957                   ELSEIF(nbondi .eq. 1) THEN 
     949                  ELSEIF(nbondi == 1) THEN 
    958950                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(1) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(1) .AND.   & 
    959951                       & nbjdta(ib,igrd,ib_bdy) >= is_b(1) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(1) .AND.   & 
    960952                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    961953                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    962                        if((com_west_b .ne. 1) .and. (ii .eq. (nlcit(nowe+1)-1))) then 
     954                       if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 
    963955                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    964                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     956                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    965957                            com_south = 1 
    966                           elseif((ij .eq. nlcjt(nowe+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     958                          elseif((ij == nlcjt(nowe+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    967959                            com_north = 1 
    968960                          endif 
    … …  
    970962                       endif  
    971963                     ENDIF 
    972                   ELSEIF(nbondi .eq. -1) THEN 
     964                  ELSEIF(nbondi == -1) THEN 
    973965                     IF( nbidta(ib,igrd,ib_bdy) >= iw_b(2) .AND. nbidta(ib,igrd,ib_bdy) <= ie_b(2) .AND.   & 
    974966                       & nbjdta(ib,igrd,ib_bdy) >= is_b(2) .AND. nbjdta(ib,igrd,ib_bdy) <= in_b(2) .AND.   & 
    975967                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    976968                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    977                        if((com_east_b .ne. 1) .and. (ii .eq. 2)) then 
     969                       if((com_east_b .ne. 1) .and. (ii == 2)) then 
    978970                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    979                           if((ij .eq. 2) .and. (nbondj .eq. 0 .or. nbondj .eq. 1)) then 
     971                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
    980972                            com_south = 1 
    981                           elseif((ij .eq. nlcjt(noea+1)-1) .and. (nbondj .eq. 0 .or. nbondj .eq. -1)) then 
     973                          elseif((ij == nlcjt(noea+1)-1) .and. (nbondj == 0 .or. nbondj == -1)) then 
    982974                            com_north = 1 
    983975                          endif 
    … …  
    986978                     ENDIF 
    987979                  ENDIF 
    988                   IF(nbondj .eq. 0) THEN 
     980                  IF(nbondj == 0) THEN 
    989981                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  & 
    990982                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
    … …  
    1001993                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    1002994                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
    1003                        if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then 
     995                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 
    1004996                          com_south_b = 1 
    1005997                       endif  
    … …  
    10091001                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    10101002                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
    1011                        if((com_north_b .ne. 1) .and. (ij .eq. 2)) then 
     1003                       if((com_north_b .ne. 1) .and. (ij == 2)) then 
    10121004                          com_north_b = 1 
    10131005                       endif  
    10141006                     ENDIF 
    1015                   ELSEIF(nbondj .eq. 1) THEN 
     1007                  ELSEIF(nbondj == 1) THEN 
    10161008                     IF( com_south_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(3)-1 .OR. & 
    10171009                       & nbidta(ib,igrd,ib_bdy) == ie_b(3)+1) .AND. & 
    … …  
    10231015                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    10241016                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(3)+2 
    1025                        if((com_south_b .ne. 1) .and. (ij .eq. (nlcjt(noso+1)-1))) then 
     1017                       if((com_south_b .ne. 1) .and. (ij == (nlcjt(noso+1)-1))) then 
    10261018                          com_south_b = 1 
    10271019                       endif  
    10281020                     ENDIF 
    1029                   ELSEIF(nbondj .eq. -1) THEN 
     1021                  ELSEIF(nbondj == -1) THEN 
    10301022                     IF(com_north_b .ne. 1 .AND. (nbidta(ib,igrd,ib_bdy) == iw_b(4)-1  & 
    10311023                       & .OR. nbidta(ib,igrd,ib_bdy) == ie_b(4)+1) .AND. & 
    … …  
    10371029                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    10381030                       ij = nbjdta(ib,igrd,ib_bdy)- is_b(4)+2 
    1039                        if((com_north_b .ne. 1) .and. (ij .eq. 2)) then 
     1031                       if((com_north_b .ne. 1) .and. (ij == 2)) then 
    10401032                          com_north_b = 1 
    10411033                       endif  
    … …  
    10461038         ENDDO  
    10471039 
    1048          ! definition of the i- and j- direction local boundaries arrays 
    1049          ! used for sending the boudaries 
    1050          IF((com_east .eq. 1) .and. (com_west .eq. 1)) THEN 
    1051             nbondi_bdy(ib_bdy) = 0 
    1052          ELSEIF ((com_east .eq. 1) .and. (com_west .eq. 0)) THEN 
    1053             nbondi_bdy(ib_bdy) = -1 
    1054          ELSEIF ((com_east .eq. 0) .and. (com_west .eq. 1)) THEN 
    1055             nbondi_bdy(ib_bdy) = 1 
     1040         ! definition of the i- and j- direction local boundaries arrays used for sending the boundaries 
     1041         IF(     (com_east  == 1) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  0 
     1042         ELSEIF( (com_east  == 1) .and. (com_west  == 0) ) THEN   ;   nbondi_bdy(ib_bdy) = -1 
     1043         ELSEIF( (com_east  == 0) .and. (com_west  == 1) ) THEN   ;   nbondi_bdy(ib_bdy) =  1 
    10561044         ENDIF 
    1057  
    1058          IF((com_north .eq. 1) .and. (com_south .eq. 1)) THEN 
    1059             nbondj_bdy(ib_bdy) = 0 
    1060          ELSEIF ((com_north .eq. 1) .and. (com_south .eq. 0)) THEN 
    1061             nbondj_bdy(ib_bdy) = -1 
    1062          ELSEIF ((com_north .eq. 0) .and. (com_south .eq. 1)) THEN 
    1063             nbondj_bdy(ib_bdy) = 1 
     1045         IF(     (com_north == 1) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  0 
     1046         ELSEIF( (com_north == 1) .and. (com_south == 0) ) THEN   ;   nbondj_bdy(ib_bdy) = -1 
     1047         ELSEIF( (com_north == 0) .and. (com_south == 1) ) THEN   ;   nbondj_bdy(ib_bdy) =  1 
    10641048         ENDIF 
    10651049 
    1066          ! definition of the i- and j- direction local boundaries arrays 
    1067          ! used for receiving the boudaries 
    1068          IF((com_east_b .eq. 1) .and. (com_west_b .eq. 1)) THEN 
    1069             nbondi_bdy_b(ib_bdy) = 0 
    1070          ELSEIF ((com_east_b .eq. 1) .and. (com_west_b .eq. 0)) THEN 
    1071             nbondi_bdy_b(ib_bdy) = -1 
    1072          ELSEIF ((com_east_b .eq. 0) .and. (com_west_b .eq. 1)) THEN 
    1073             nbondi_bdy_b(ib_bdy) = 1 
     1050         ! definition of the i- and j- direction local boundaries arrays used for receiving the boundaries 
     1051         IF(     (com_east_b  == 1) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  0 
     1052         ELSEIF( (com_east_b  == 1) .and. (com_west_b  == 0) ) THEN   ;   nbondi_bdy_b(ib_bdy) = -1 
     1053         ELSEIF( (com_east_b  == 0) .and. (com_west_b  == 1) ) THEN   ;   nbondi_bdy_b(ib_bdy) =  1 
    10741054         ENDIF 
    1075  
    1076          IF((com_north_b .eq. 1) .and. (com_south_b .eq. 1)) THEN 
    1077             nbondj_bdy_b(ib_bdy) = 0 
    1078          ELSEIF ((com_north_b .eq. 1) .and. (com_south_b .eq. 0)) THEN 
    1079             nbondj_bdy_b(ib_bdy) = -1 
    1080          ELSEIF ((com_north_b .eq. 0) .and. (com_south_b .eq. 1)) THEN 
    1081             nbondj_bdy_b(ib_bdy) = 1 
     1055         IF(     (com_north_b == 1) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  0 
     1056         ELSEIF( (com_north_b == 1) .and. (com_south_b == 0) ) THEN   ;   nbondj_bdy_b(ib_bdy) = -1 
     1057         ELSEIF( (com_north_b == 0) .and. (com_south_b == 1) ) THEN   ;   nbondj_bdy_b(ib_bdy) =  1 
    10821058         ENDIF 
    10831059 
    … …  
    10871063            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    10881064               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
    1089                idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation 
    1090 !               idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.  ! quadratic 
    1091 !               idx_bdy(ib_bdy)%nbw(ib,igrd) =  FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy))       ! linear 
     1065               idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( REAL( nbr - 1 ) *0.5 )      ! tanh formulation 
     1066!               idx_bdy(ib_bdy)%nbw(ib,igrd) = (REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.  ! quadratic 
     1067!               idx_bdy(ib_bdy)%nbw(ib,igrd) =  REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy))       ! linear 
    10921068            END DO 
    10931069         END DO  
    … …  
    10991075               nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 
    11001076               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) &  
    1101                & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     1077               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    11021078               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) &  
    1103                & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     1079               & *(REAL(nn_rimwidth(ib_bdy)+1-nbr)/REAL(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    11041080            END DO 
    11051081         END DO  
    … …  
    11221098 
    11231099         ! Derive mask on U and V grid from mask on T grid 
    1124          bdyumask(:,:) = 0.e0 
    1125          bdyvmask(:,:) = 0.e0 
     1100         bdyumask(:,:) = 0._wp 
     1101         bdyvmask(:,:) = 0._wp 
    11261102         DO ij=1, jpjm1 
    11271103            DO ii=1, jpim1 
    1128                bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij ) 
    1129                bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)   
     1104               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
     1105               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    11301106            END DO 
    11311107         END DO 
    … …  
    11411117                  umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij) 
    11421118                  vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij) 
    1143                   bmask(ii,ij)    = bmask(ii,ij)    * bdytmask(ii,ij) 
    11441119               END DO       
    11451120            END DO 
    1146          END DO 
    1147  
    1148          DO ik = 1, jpkm1 
    11491121            DO ij = 2, jpjm1 
    11501122               DO ii = 2, jpim1 
    … …  
    11541126            END DO 
    11551127         END DO 
    1156  
    11571128         tmask_i (:,:) = ssmask(:,:) * tmask_i(:,:) 
    1158  
     1129         ! 
    11591130      ENDIF ! ln_mask_file=.TRUE. 
    11601131       
    11611132      bdytmask(:,:) = ssmask(:,:) 
    1162       IF( .not. ln_mask_file ) THEN 
    1163          ! If .not. ln_mask_file then we need to derive mask on U and V grid  
    1164          ! from mask on T grid here. 
    1165          bdyumask(:,:) = 0.e0 
    1166          bdyvmask(:,:) = 0.e0 
    1167          DO ij=1, jpjm1 
    1168             DO ii=1, jpim1 
    1169                bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij ) 
    1170                bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)   
     1133      IF( .NOT.ln_mask_file ) THEN 
     1134         ! If .not. ln_mask_file then we need to derive mask on U and V grid from mask on T grid here. 
     1135         bdyumask(:,:) = 0._wp 
     1136         bdyvmask(:,:) = 0._wp 
     1137         DO ij = 1, jpjm1 
     1138            DO ii = 1, jpim1 
     1139               bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1, ij ) 
     1140               bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
    11711141            END DO 
    11721142         END DO 
    … …  
    11741144      ENDIF 
    11751145 
    1176       ! bdy masks and bmask are now set to zero on boundary points: 
    1177       igrd = 1       ! In the free surface case, bmask is at T-points 
    1178       DO ib_bdy = 1, nb_bdy 
    1179         DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)      
    1180           bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
    1181         ENDDO 
    1182       ENDDO 
     1146      ! bdy masks are now set to zero on boundary points: 
    11831147      ! 
    11841148      igrd = 1 
    11851149      DO ib_bdy = 1, nb_bdy 
    11861150        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)       
    1187           bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
    1188         ENDDO 
    1189       ENDDO 
     1151          bdytmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
     1152        END DO 
     1153      END DO 
    11901154      ! 
    11911155      igrd = 2 
    11921156      DO ib_bdy = 1, nb_bdy 
    11931157        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1194           bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
    1195         ENDDO 
    1196       ENDDO 
     1158          bdyumask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
     1159        END DO 
     1160      END DO 
    11971161      ! 
    11981162      igrd = 3 
    11991163      DO ib_bdy = 1, nb_bdy 
    12001164        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1201           bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0 
     1165          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
    12021166        ENDDO 
    12031167      ENDDO 
    … …  
    12051169      ! For the flagu/flagv calculation below we require a version of fmask without 
    12061170      ! the land boundary condition (shlat) included: 
    1207       CALL wrk_alloc(jpi,jpj,zfmask)  
     1171      CALL wrk_alloc(jpi,jpj,  zfmask )  
    12081172      DO ij = 2, jpjm1 
    12091173         DO ii = 2, jpim1 
    … …  
    12201184      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    12211185 
    1222          idx_bdy(ib_bdy)%flagu(:,:) = 0.e0 
    1223          idx_bdy(ib_bdy)%flagv(:,:) = 0.e0 
     1186         idx_bdy(ib_bdy)%flagu(:,:) = 0._wp 
     1187         idx_bdy(ib_bdy)%flagv(:,:) = 0._wp 
    12241188         icount = 0  
    12251189 
    … …  
    12311195         DO igrd = 1,jpbgrd  
    12321196            SELECT CASE( igrd ) 
    1233                CASE( 1 ) 
    1234                   pmask => umask(:,:,1) 
    1235                   i_offset = 0 
    1236                CASE( 2 )  
    1237                   pmask => bdytmask 
    1238                   i_offset = 1 
    1239                CASE( 3 )  
    1240                   pmask => zfmask(:,:) 
    1241                   i_offset = 0 
     1197               CASE( 1 )   ;   pmask => umask   (:,:,1)   ;   i_offset = 0 
     1198               CASE( 2 )   ;   pmask => bdytmask(:,:)     ;   i_offset = 1 
     1199               CASE( 3 )   ;   pmask => zfmask  (:,:)     ;   i_offset = 0 
    12421200            END SELECT  
    12431201            icount = 0 
    … …  
    12701228         ! flagv =  1 : v is normal to the boundary and is direction is inward 
    12711229 
    1272          DO igrd = 1,jpbgrd  
     1230         DO igrd = 1, jpbgrd  
    12731231            SELECT CASE( igrd ) 
    1274                CASE( 1 ) 
    1275                   pmask => vmask(:,:,1) 
    1276                   j_offset = 0 
    1277                CASE( 2 ) 
    1278                   pmask => zfmask(:,:) 
    1279                   j_offset = 0 
    1280                CASE( 3 ) 
    1281                   pmask => bdytmask 
    1282                   j_offset = 1 
     1232               CASE( 1 )   ;   pmask => vmask (:,:,1)   ;   j_offset = 0 
     1233               CASE( 2 )   ;   pmask => zfmask(:,:)     ;   j_offset = 0 
     1234               CASE( 3 )   ;   pmask => bdytmask        ;   j_offset = 1 
    12831235            END SELECT  
    12841236            icount = 0 
    … …  
    12861238               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    12871239               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1288                znfl = pmask(nbi,nbj+j_offset-1  ) 
    1289                zsfl = pmask(nbi,nbj+j_offset) 
     1240               znfl = pmask(nbi,nbj+j_offset-1) 
     1241               zsfl = pmask(nbi,nbj+j_offset  ) 
    12901242               ! This error check only works if you are using the bdyXmask arrays 
    12911243               IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN 
    … …  
    13051257            ENDIF  
    13061258         END DO 
    1307  
     1259         ! 
    13081260      END DO 
    13091261 
    13101262      ! Compute total lateral surface for volume correction: 
    13111263      ! ---------------------------------------------------- 
    1312       ! JC: this must be done at each time step with key_vvl 
    1313       bdysurftot = 0.e0  
     1264      ! JC: this must be done at each time step with non-linear free surface 
     1265      bdysurftot = 0._wp  
    13141266      IF( ln_vol ) THEN   
    13151267         igrd = 2      ! Lateral surface at U-points 
    … …  
    13191271               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    13201272               flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 
    1321                bdysurftot = bdysurftot + hu     (nbi  , nbj)                           & 
     1273               bdysurftot = bdysurftot + hu_n   (nbi  , nbj)                           & 
    13221274                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) & 
    13231275                  &                    * tmask_i(nbi  , nbj)                           & 
    13241276                  &                    * tmask_i(nbi+1, nbj)                    
    1325             ENDDO 
    1326          ENDDO 
     1277            END DO 
     1278         END DO 
    13271279 
    13281280         igrd=3 ! Add lateral surface at V-points 
    … …  
    13321284               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    13331285               flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 
    1334                bdysurftot = bdysurftot + hv     (nbi, nbj  )                           & 
     1286               bdysurftot = bdysurftot + hv_n   (nbi, nbj  )                           & 
    13351287                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) & 
    13361288                  &                    * tmask_i(nbi, nbj  )                           & 
    13371289                  &                    * tmask_i(nbi, nbj+1) 
    1338             ENDDO 
    1339          ENDDO 
     1290            END DO 
     1291         END DO 
    13401292         ! 
    13411293         IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain 
    … …  
    13441296      ! Tidy up 
    13451297      !-------- 
    1346       IF (nb_bdy>0) THEN 
    1347          DEALLOCATE(nbidta, nbjdta, nbrdta) 
    1348       ENDIF 
    1349  
    1350       CALL wrk_dealloc(jpi,jpj,zfmask)  
    1351  
    1352       IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 
    1353  
     1298      IF( nb_bdy>0 )   DEALLOCATE( nbidta, nbjdta, nbrdta ) 
     1299      ! 
     1300      CALL wrk_dealloc(jpi,jpj,   zfmask )  
     1301      ! 
     1302      IF( nn_timing == 1 )   CALL timing_stop('bdy_init') 
     1303      ! 
    13541304   END SUBROUTINE bdy_init 
     1305 
    13551306 
    13561307   SUBROUTINE bdy_ctl_seg 
    … …  
    17431694      itest = 0 
    17441695 
    1745       IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2)) itest = itest + 1 
    1746       IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2)) itest = itest + 1 
    1747       IF (cn_tra(ib1)/=cn_tra(ib2)) itest = itest + 1 
    1748       ! 
    1749       IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1 
    1750       IF (nn_dyn3d_dta(ib1)/=nn_dyn3d_dta(ib2)) itest = itest + 1 
    1751       IF (nn_tra_dta(ib1)/=nn_tra_dta(ib2)) itest = itest + 1 
    1752       ! 
    1753       IF (nn_rimwidth(ib1)/=nn_rimwidth(ib2)) itest = itest + 1    
    1754       ! 
    1755       IF ( itest>0 ) THEN 
     1696      IF( cn_dyn2d(ib1) /= cn_dyn2d(ib2) )  itest = itest + 1 
     1697      IF( cn_dyn3d(ib1) /= cn_dyn3d(ib2) )  itest = itest + 1 
     1698      IF( cn_tra  (ib1) /= cn_tra  (ib2) )  itest = itest + 1 
     1699      ! 
     1700      IF( nn_dyn2d_dta(ib1) /= nn_dyn2d_dta(ib2) )  itest = itest + 1 
     1701      IF( nn_dyn3d_dta(ib1) /= nn_dyn3d_dta(ib2) )  itest = itest + 1 
     1702      IF( nn_tra_dta  (ib1) /= nn_tra_dta  (ib2) )  itest = itest + 1 
     1703      ! 
     1704      IF( nn_rimwidth(ib1) /= nn_rimwidth(ib2) )  itest = itest + 1    
     1705      ! 
     1706      IF( itest>0 ) THEN 
    17561707         IF(lwp) WRITE(numout,*) ' E R R O R : Segments ', ib1, 'and ', ib2 
    17571708         IF(lwp) WRITE(numout,*) ' ==========  have different open bdy schemes'                                                   

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90

    r5215 r7351  
    44   !! Unstructured Open Boundary Cond. :  Library module of generic boundary algorithms. 
    55   !!====================================================================== 
    6    !! History :  3.6  !  2013     (D. Storkey) new module 
     6   !! History :  3.6  !  2013     (D. Storkey) original code 
    77   !!---------------------------------------------------------------------- 
    88#if defined key_bdy  
    … …  
    1313   !!   bdy_orlanski_3d 
    1414   !!---------------------------------------------------------------------- 
    15    USE timing          ! Timing 
    16    USE oce             ! ocean dynamics and tracers  
    17    USE dom_oce         ! ocean space and time domain 
    18    USE bdy_oce         ! ocean open boundary conditions 
    19    USE phycst          ! physical constants 
    20    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    21    USE in_out_manager  ! 
     15   USE oce            ! ocean dynamics and tracers  
     16   USE dom_oce        ! ocean space and time domain 
     17   USE bdy_oce        ! ocean open boundary conditions 
     18   USE phycst         ! physical constants 
     19   ! 
     20   USE in_out_manager ! 
     21   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     22   USE timing         ! Timing 
    2223 
    2324   IMPLICIT NONE 
    … …  
    4546      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    4647      !!---------------------------------------------------------------------- 
    47       TYPE(OBC_INDEX),            INTENT(in)    ::   idx      ! BDY indices 
    48       INTEGER,                    INTENT(in)    ::   igrd     ! grid index 
    49       REAL(wp), DIMENSION(:,:),   INTENT(in)    ::   phib     ! model before 2D field 
    50       REAL(wp), DIMENSION(:,:),   INTENT(inout) ::   phia     ! model after 2D field (to be updated) 
    51       REAL(wp), DIMENSION(:),     INTENT(in)    ::   phi_ext  ! external forcing data 
    52       LOGICAL,                    INTENT(in)    ::   ll_npo   ! switch for NPO version 
    53  
     48      TYPE(OBC_INDEX),          INTENT(in   ) ::   idx      ! BDY indices 
     49      INTEGER ,                 INTENT(in   ) ::   igrd     ! grid index 
     50      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   phib     ! model before 2D field 
     51      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   phia     ! model after 2D field (to be updated) 
     52      REAL(wp), DIMENSION(:)  , INTENT(in   ) ::   phi_ext  ! external forcing data 
     53      LOGICAL ,                 INTENT(in   ) ::   ll_npo   ! switch for NPO version 
     54      ! 
    5455      INTEGER  ::   jb                                     ! dummy loop indices 
    5556      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses 
    … …  
    7071      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    7172      !!---------------------------------------------------------------------- 
    72  
    73       IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_2d') 
    74  
     73      ! 
     74      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_2d') 
     75      ! 
    7576      ! ----------------------------------! 
    7677      ! Orlanski boundary conditions     :! 
    … …  
    7980      SELECT CASE(igrd) 
    8081         CASE(1) 
    81             pmask => tmask(:,:,1) 
     82            pmask      => tmask(:,:,1) 
    8283            pmask_xdif => umask(:,:,1) 
    8384            pmask_ydif => vmask(:,:,1) 
    84             pe_xdif => e1u(:,:) 
    85             pe_ydif => e2v(:,:) 
     85            pe_xdif    => e1u(:,:) 
     86            pe_ydif    => e2v(:,:) 
    8687            ii_offset = 0 
    8788            ij_offset = 0 
    8889         CASE(2) 
    89             pmask => umask(:,:,1) 
     90            pmask      => umask(:,:,1) 
    9091            pmask_xdif => tmask(:,:,1) 
    9192            pmask_ydif => fmask(:,:,1) 
    92             pe_xdif => e1t(:,:) 
    93             pe_ydif => e2f(:,:) 
     93            pe_xdif    => e1t(:,:) 
     94            pe_ydif    => e2f(:,:) 
    9495            ii_offset = 1 
    9596            ij_offset = 0 
    9697         CASE(3) 
    97             pmask => vmask(:,:,1) 
     98            pmask      => vmask(:,:,1) 
    9899            pmask_xdif => fmask(:,:,1) 
    99100            pmask_ydif => tmask(:,:,1) 
    100             pe_xdif => e1f(:,:) 
    101             pe_ydif => e2t(:,:) 
     101            pe_xdif    => e1f(:,:) 
     102            pe_ydif    => e2t(:,:) 
    102103            ii_offset = 0 
    103104            ij_offset = 1 
    … …  
    188189      END DO 
    189190      ! 
    190       IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_2d') 
    191  
     191      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_2d') 
     192      ! 
    192193   END SUBROUTINE bdy_orlanski_2d 
    193194 
    … …  
    204205      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    205206      !!---------------------------------------------------------------------- 
    206       TYPE(OBC_INDEX),            INTENT(in)    ::   idx      ! BDY indices 
    207       INTEGER,                    INTENT(in)    ::   igrd     ! grid index 
    208       REAL(wp), DIMENSION(:,:,:), INTENT(in)    ::   phib     ! model before 3D field 
    209       REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated) 
    210       REAL(wp), DIMENSION(:,:),   INTENT(in)    ::   phi_ext  ! external forcing data 
    211       LOGICAL,                    INTENT(in)    ::   ll_npo   ! switch for NPO version 
    212  
     207      TYPE(OBC_INDEX),            INTENT(in   ) ::   idx      ! BDY indices 
     208      INTEGER ,                   INTENT(in   ) ::   igrd     ! grid index 
     209      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   phib     ! model before 3D field 
     210      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phia     ! model after 3D field (to be updated) 
     211      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   phi_ext  ! external forcing data 
     212      LOGICAL ,                   INTENT(in   ) ::   ll_npo   ! switch for NPO version 
     213      ! 
    213214      INTEGER  ::   jb, jk                                 ! dummy loop indices 
    214215      INTEGER  ::   ii, ij, iibm1, iibm2, ijbm1, ijbm2     ! 2D addresses 
    … …  
    229230      REAL(wp), POINTER, DIMENSION(:,:)          :: pe_ydif    ! scale factors for y-derivatives 
    230231      !!---------------------------------------------------------------------- 
    231  
    232       IF( nn_timing == 1 ) CALL timing_start('bdy_orlanski_3d') 
    233  
     232      ! 
     233      IF( nn_timing == 1 )   CALL timing_start('bdy_orlanski_3d') 
     234      ! 
    234235      ! ----------------------------------! 
    235236      ! Orlanski boundary conditions     :! 
    236237      ! ----------------------------------!  
    237       
     238      ! 
    238239      SELECT CASE(igrd) 
    239240         CASE(1) 
    240             pmask => tmask(:,:,:) 
     241            pmask      => tmask(:,:,:) 
    241242            pmask_xdif => umask(:,:,:) 
    242243            pmask_ydif => vmask(:,:,:) 
    243             pe_xdif => e1u(:,:) 
    244             pe_ydif => e2v(:,:) 
     244            pe_xdif    => e1u(:,:) 
     245            pe_ydif    => e2v(:,:) 
    245246            ii_offset = 0 
    246247            ij_offset = 0 
    247248         CASE(2) 
    248             pmask => umask(:,:,:) 
     249            pmask      => umask(:,:,:) 
    249250            pmask_xdif => tmask(:,:,:) 
    250251            pmask_ydif => fmask(:,:,:) 
    251             pe_xdif => e1t(:,:) 
    252             pe_ydif => e2f(:,:) 
     252            pe_xdif    => e1t(:,:) 
     253            pe_ydif    => e2f(:,:) 
    253254            ii_offset = 1 
    254255            ij_offset = 0 
    255256         CASE(3) 
    256             pmask => vmask(:,:,:) 
     257            pmask      => vmask(:,:,:) 
    257258            pmask_xdif => fmask(:,:,:) 
    258259            pmask_ydif => tmask(:,:,:) 
    259             pe_xdif => e1f(:,:) 
    260             pe_ydif => e2t(:,:) 
     260            pe_xdif    => e1f(:,:) 
     261            pe_ydif    => e2t(:,:) 
    261262            ii_offset = 0 
    262263            ij_offset = 1 
    … …  
    349350         ! 
    350351      END DO 
    351  
    352       IF( nn_timing == 1 ) CALL timing_stop('bdy_orlanski_3d') 
    353  
     352      ! 
     353      IF( nn_timing == 1 )   CALL timing_stop('bdy_orlanski_3d') 
     354      ! 
    354355   END SUBROUTINE bdy_orlanski_3d 
    355356 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r5930 r7351  
    1515   !!   'key_bdy'     Open Boundary Condition 
    1616   !!---------------------------------------------------------------------- 
    17    !!   PUBLIC 
    18    !!      bdytide_init     : read of namelist and initialisation of tidal harmonics data 
    19    !!      tide_update   : calculation of tidal forcing at each timestep 
    20    !!---------------------------------------------------------------------- 
    21    USE timing          ! Timing 
    22    USE oce             ! ocean dynamics and tracers  
    23    USE dom_oce         ! ocean space and time domain 
    24    USE iom 
    25    USE in_out_manager  ! I/O units 
    26    USE phycst          ! physical constants 
    27    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    28    USE bdy_par         ! Unstructured boundary parameters 
    29    USE bdy_oce         ! ocean open boundary conditions 
    30    USE daymod          ! calendar 
    31    USE wrk_nemo        ! Memory allocation 
    32    USE tideini 
    33 !   USE tide_mod       ! Useless ?? 
    34    USE fldread 
     17   !!   bdytide_init  : read of namelist and initialisation of tidal harmonics data 
     18   !!   tide_update   : calculation of tidal forcing at each timestep 
     19   !!---------------------------------------------------------------------- 
     20   USE oce            ! ocean dynamics and tracers  
     21   USE dom_oce        ! ocean space and time domain 
     22   USE phycst         ! physical constants 
     23   USE bdy_par        ! Unstructured boundary parameters 
     24   USE bdy_oce        ! ocean open boundary conditions 
     25   USE tideini        !  
     26   USE daymod         ! calendar 
     27   ! 
     28   USE in_out_manager ! I/O units 
     29   USE iom            ! xIO server 
     30   USE fldread        ! 
     31   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     32   USE wrk_nemo       ! Memory allocation 
     33   USE timing         ! timing 
    3534 
    3635   IMPLICIT NONE 
    … …  
    4241 
    4342   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data 
    44       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0       !: Tidal constituents : SSH0 (read in file) 
    45       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0         !: Tidal constituents : U0   (read in file) 
    46       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v0         !: Tidal constituents : V0   (read in file) 
    47       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH  (after nodal cor.) 
    48       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U    (after nodal cor.) 
    49       REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V    (after nodal cor.) 
     43      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh0     !: Tidal constituents : SSH0   (read in file) 
     44      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u0, v0   !: Tidal constituents : U0, V0 (read in file) 
     45      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh      !: Tidal constituents : SSH    (after nodal cor.) 
     46      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u , v    !: Tidal constituents : U , V  (after nodal cor.) 
    5047   END TYPE TIDES_DATA 
    5148 
    … …  
    5754   !!---------------------------------------------------------------------- 
    5855   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    59    !! $Id$  
     56   !! $Id$ 
    6057   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6158   !!---------------------------------------------------------------------- 
    … …  
    9188      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj 
    9289      !!---------------------------------------------------------------------- 
    93  
    94       IF( nn_timing == 1 ) CALL timing_start('bdytide_init') 
    95  
     90      ! 
     91      IF( nn_timing == 1 )   CALL timing_start('bdytide_init') 
     92      ! 
    9693      IF (nb_bdy>0) THEN 
    9794         IF(lwp) WRITE(numout,*) 
    … …  
    263260            ENDIF ! ln_bdytide_2ddta=.true. 
    264261            ! 
    265             IF ( ln_bdytide_conj ) THEN ! assume complex conjugate in data files 
     262            IF( ln_bdytide_conj ) THEN    ! assume complex conjugate in data files 
    266263               td%ssh0(:,:,2) = - td%ssh0(:,:,2) 
    267264               td%u0  (:,:,2) = - td%u0  (:,:,2) 
    … …  
    274271            ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
    275272            ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
    276             dta_bdy_s(ib_bdy)%ssh(:) = 0.e0 
    277             dta_bdy_s(ib_bdy)%u2d(:) = 0.e0 
    278             dta_bdy_s(ib_bdy)%v2d(:) = 0.e0 
     273            dta_bdy_s(ib_bdy)%ssh(:) = 0._wp 
     274            dta_bdy_s(ib_bdy)%u2d(:) = 0._wp 
     275            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    279276            ! 
    280277         ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 
    281278         ! 
    282279      END DO ! loop on ib_bdy 
    283  
    284       IF( nn_timing == 1 ) CALL timing_stop('bdytide_init') 
    285  
     280      ! 
     281      IF( nn_timing == 1 )   CALL timing_stop('bdytide_init') 
     282      ! 
    286283   END SUBROUTINE bdytide_init 
    287284 
    288    SUBROUTINE bdytide_update ( kt, idx, dta, td, jit, time_offset ) 
     285 
     286   SUBROUTINE bdytide_update( kt, idx, dta, td, jit, time_offset ) 
    289287      !!---------------------------------------------------------------------- 
    290288      !!                 ***  SUBROUTINE bdytide_update  *** 
    … …  
    293291      !!                 
    294292      !!---------------------------------------------------------------------- 
    295       INTEGER, INTENT( in )            ::   kt          ! Main timestep counter 
    296       TYPE(OBC_INDEX), INTENT( in )    ::   idx         ! OBC indices 
    297       TYPE(OBC_DATA),  INTENT(inout)  ::   dta         ! OBC external data 
    298       TYPE(TIDES_DATA),INTENT( inout ) ::   td          ! tidal harmonics data 
    299       INTEGER,INTENT(in),OPTIONAL      ::   jit         ! Barotropic timestep counter (for timesplitting option) 
    300       INTEGER,INTENT( in ), OPTIONAL  ::   time_offset ! time offset in units of timesteps. NB. if jit 
    301                                                         ! is present then units = subcycle timesteps. 
    302                                                         ! time_offset = 0  => get data at "now"    time level 
    303                                                         ! time_offset = -1 => get data at "before" time level 
    304                                                         ! time_offset = +1 => get data at "after"  time level 
    305                                                         ! etc. 
    306       !! 
    307       INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays) 
    308       INTEGER                          :: itide, igrd, ib   ! dummy loop indices 
    309       INTEGER                          :: time_add          ! time offset in units of timesteps 
    310       REAL(wp)                         :: z_arg, z_sarg, zflag, zramp       
     293      INTEGER          , INTENT(in   ) ::   kt          ! Main timestep counter 
     294      TYPE(OBC_INDEX)  , INTENT(in   ) ::   idx         ! OBC indices 
     295      TYPE(OBC_DATA)   , INTENT(inout) ::   dta         ! OBC external data 
     296      TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data 
     297      INTEGER, OPTIONAL, INTENT(in   ) ::   jit         ! Barotropic timestep counter (for timesplitting option) 
     298      INTEGER, OPTIONAL, INTENT(in   ) ::   time_offset ! time offset in units of timesteps. NB. if jit 
     299      !                                                 ! is present then units = subcycle timesteps. 
     300      !                                                 ! time_offset = 0  => get data at "now"    time level 
     301      !                                                 ! time_offset = -1 => get data at "before" time level 
     302      !                                                 ! time_offset = +1 => get data at "after"  time level 
     303      !                                                 ! etc. 
     304      ! 
     305      INTEGER  ::   itide, igrd, ib       ! dummy loop indices 
     306      INTEGER  ::   time_add              ! time offset in units of timesteps 
     307      INTEGER, DIMENSION(3) ::   ilen0    ! length of boundary data (from OBC arrays) 
     308      REAL(wp) ::   z_arg, z_sarg, zflag, zramp   ! local scalars     
    311309      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost 
    312310      !!---------------------------------------------------------------------- 
    313  
    314       IF( nn_timing == 1 ) CALL timing_start('bdytide_update') 
    315  
     311      ! 
     312      IF( nn_timing == 1 )   CALL timing_start('bdytide_update') 
     313      ! 
    316314      ilen0(1) =  SIZE(td%ssh(:,1,1)) 
    317315      ilen0(2) =  SIZE(td%u(:,1,1)) 
    … …  
    323321      ENDIF 
    324322 
    325       IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. zflag==1 ) THEN 
     323      IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN 
    326324        ! 
    327         kt_tide = kt 
     325        kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
    328326        ! 
    329327        IF(lwp) THEN 
    … …  
    374372      END DO 
    375373      ! 
    376       IF( nn_timing == 1 ) CALL timing_stop('bdytide_update') 
     374      IF( nn_timing == 1 )   CALL timing_stop('bdytide_update') 
    377375      ! 
    378376   END SUBROUTINE bdytide_update 
    … …  
    385383      !!                 
    386384      !!---------------------------------------------------------------------- 
    387       INTEGER, INTENT( in )            ::   kt          ! Main timestep counter 
    388       INTEGER, INTENT( in ),OPTIONAL  ::   kit         ! Barotropic timestep counter (for timesplitting option) 
    389       INTEGER, INTENT( in ),OPTIONAL  ::   time_offset ! time offset in units of timesteps. NB. if kit 
    390                                                         ! is present then units = subcycle timesteps. 
    391                                                         ! time_offset = 0  => get data at "now"    time level 
    392                                                         ! time_offset = -1 => get data at "before" time level 
    393                                                         ! time_offset = +1 => get data at "after"  time level 
    394                                                         ! etc. 
    395       !! 
    396       LOGICAL  :: lk_first_btstp  ! =.TRUE. if time splitting and first barotropic step 
    397       INTEGER, DIMENSION(jpbgrd) :: ilen0  
    398       INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim  ! short cuts 
    399       INTEGER  :: itide, ib_bdy, ib, igrd                     ! loop indices 
    400       INTEGER  :: time_add                                    ! time offset in units of timesteps 
    401       REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist       
    402       !!---------------------------------------------------------------------- 
    403  
    404       IF( nn_timing == 1 ) CALL timing_start('bdy_dta_tides') 
    405  
     385      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter 
     386      INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option) 
     387      INTEGER, OPTIONAL, INTENT(in) ::   time_offset ! time offset in units of timesteps. NB. if kit 
     388      !                                              ! is present then units = subcycle timesteps. 
     389      !                                              ! time_offset = 0  => get data at "now"    time level 
     390      !                                              ! time_offset = -1 => get data at "before" time level 
     391      !                                              ! time_offset = +1 => get data at "after"  time level 
     392      !                                              ! etc. 
     393      ! 
     394      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
     395      INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices 
     396      INTEGER  ::   time_add                  ! time offset in units of timesteps 
     397      INTEGER, DIMENSION(jpbgrd)   ::   ilen0  
     398      INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts 
     399      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist       
     400      !!---------------------------------------------------------------------- 
     401      ! 
     402      IF( nn_timing == 1 )   CALL timing_start('bdy_dta_tides') 
     403      ! 
    406404      lk_first_btstp=.TRUE. 
    407405      IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF 
    … …  
    438436            ! We refresh nodal factors every day below 
    439437            ! This should be done somewhere else 
    440             IF ( nsec_day == NINT(0.5_wp * rdttra(1)) .AND. lk_first_btstp ) THEN 
    441                ! 
    442                kt_tide = kt                
     438            IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 
     439               ! 
     440               kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
    443441               ! 
    444442               IF(lwp) THEN 
    … …  
    502500   END SUBROUTINE bdy_dta_tides 
    503501 
     502 
    504503   SUBROUTINE tide_init_elevation( idx, td ) 
    505504      !!---------------------------------------------------------------------- 
    506505      !!                 ***  ROUTINE tide_init_elevation  *** 
    507506      !!---------------------------------------------------------------------- 
    508       TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices 
    509       TYPE(TIDES_DATA),INTENT( inout )   ::   td      ! tidal harmonics data 
    510       !! * Local declarations 
    511       INTEGER, DIMENSION(1)            ::   ilen0       !: length of boundary data (from OBC arrays) 
     507      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices 
     508      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
     509      ! 
     510      INTEGER ::   itide, igrd, ib       ! dummy loop indices 
     511      INTEGER, DIMENSION(1) ::   ilen0   ! length of boundary data (from OBC arrays) 
    512512      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    513       INTEGER                            ::   itide, igrd, ib      ! dummy loop indices 
    514  
     513      !!---------------------------------------------------------------------- 
     514      ! 
    515515      igrd=1    
    516516                              ! SSH on tracer grid. 
    517     
    518517      ilen0(1) =  SIZE(td%ssh0(:,1,1)) 
    519  
    520       ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd))) 
    521  
     518      ! 
     519      ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 
     520      ! 
    522521      DO itide = 1, nb_harmo 
    523522         DO ib = 1, ilen0(igrd) 
    … …  
    534533         ENDDO 
    535534      END DO 
    536  
    537       DEALLOCATE(mod_tide,phi_tide) 
    538  
     535      ! 
     536      DEALLOCATE( mod_tide, phi_tide ) 
     537      ! 
    539538   END SUBROUTINE tide_init_elevation 
    540539 
     540 
    541541   SUBROUTINE tide_init_velocities( idx, td ) 
    542542      !!---------------------------------------------------------------------- 
    543543      !!                 ***  ROUTINE tide_init_elevation  *** 
    544544      !!---------------------------------------------------------------------- 
    545       TYPE(OBC_INDEX), INTENT( in )      ::   idx     ! OBC indices 
    546       TYPE(TIDES_DATA),INTENT( inout )      ::   td      ! tidal harmonics data 
    547       !! * Local declarations 
    548       INTEGER, DIMENSION(3)            ::   ilen0       !: length of boundary data (from OBC arrays) 
     545      TYPE(OBC_INDEX) , INTENT(in   ) ::   idx   ! OBC indices 
     546      TYPE(TIDES_DATA), INTENT(inout) ::   td    ! tidal harmonics data 
     547      ! 
     548      INTEGER ::   itide, igrd, ib       ! dummy loop indices 
     549      INTEGER, DIMENSION(3) ::   ilen0   ! length of boundary data (from OBC arrays) 
    549550      REAL(wp),ALLOCATABLE, DIMENSION(:) ::   mod_tide, phi_tide 
    550       INTEGER                            ::   itide, igrd, ib      ! dummy loop indices 
    551  
     551      !!---------------------------------------------------------------------- 
     552      ! 
    552553      ilen0(2) =  SIZE(td%u0(:,1,1)) 
    553554      ilen0(3) =  SIZE(td%v0(:,1,1)) 
    554  
     555      ! 
    555556      igrd=2                                 ! U grid. 
    556  
    557       ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd))) 
    558  
     557      ! 
     558      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
     559      ! 
    559560      DO itide = 1, nb_harmo 
    560561         DO ib = 1, ilen0(igrd) 
    … …  
    571572         ENDDO 
    572573      END DO 
    573  
    574       DEALLOCATE(mod_tide,phi_tide) 
    575  
     574      ! 
     575      DEALLOCATE( mod_tide , phi_tide ) 
     576      ! 
    576577      igrd=3                                 ! V grid. 
    577  
    578       ALLOCATE(mod_tide(ilen0(igrd)),phi_tide(ilen0(igrd))) 
     578      ! 
     579      ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 
    579580 
    580581      DO itide = 1, nb_harmo 
    … …  
    592593         ENDDO 
    593594      END DO 
    594  
    595       DEALLOCATE(mod_tide,phi_tide) 
    596  
     595      ! 
     596      DEALLOCATE( mod_tide, phi_tide ) 
     597      ! 
    597598  END SUBROUTINE tide_init_velocities 
     599 
    598600#else 
    599601   !!---------------------------------------------------------------------- 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r4292 r7351  
    1616   !!   bdy_tra_frs        : Apply Flow Relaxation Scheme 
    1717   !!---------------------------------------------------------------------- 
    18    USE timing          ! Timing 
    19    USE oce             ! ocean dynamics and tracers variables 
    20    USE dom_oce         ! ocean space and time domain variables  
    21    USE bdy_oce         ! ocean open boundary conditions 
    22    USE bdylib          ! for orlanski library routines 
    23    USE bdydta, ONLY:   bf 
    24    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    25    USE in_out_manager  ! I/O manager 
    26  
     18   USE oce            ! ocean dynamics and tracers variables 
     19   USE dom_oce        ! ocean space and time domain variables  
     20   USE bdy_oce        ! ocean open boundary conditions 
     21   USE bdylib         ! for orlanski library routines 
     22   USE bdydta   , ONLY:   bf   !  
     23   ! 
     24   USE in_out_manager ! I/O manager 
     25   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     26   USE timing         ! Timing 
    2727 
    2828   IMPLICIT NONE 
    2929   PRIVATE 
    3030 
    31    PUBLIC bdy_tra      ! routine called in tranxt.F90  
    32    PUBLIC bdy_tra_dmp  ! routine called in step.F90  
     31   PUBLIC   bdy_tra      ! called in tranxt.F90  
     32   PUBLIC   bdy_tra_dmp  ! called in step.F90  
    3333 
    3434   !!---------------------------------------------------------------------- 
    … …  
    4646      !! 
    4747      !!---------------------------------------------------------------------- 
    48       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    49       !! 
    50       INTEGER               :: ib_bdy ! Loop index 
     48      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
     49      ! 
     50      INTEGER ::   ib_bdy   ! Loop index 
     51      !!---------------------------------------------------------------------- 
    5152 
    5253      DO ib_bdy=1, nb_bdy 
    53  
     54         ! 
    5455         SELECT CASE( cn_tra(ib_bdy) ) 
    55          CASE('none') 
    56             CYCLE 
    57          CASE('frs') 
    58             CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    59          CASE('specified') 
    60             CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    61          CASE('neumann') 
    62             CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    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') 
    68             CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    69          CASE DEFAULT 
    70             CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
     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' ) 
    7164         END SELECT 
    7265         ! Boundary points should be updated 
    7366         CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 
    7467         CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 
    75       ENDDO 
    76       ! 
    77  
     68      END DO 
     69      ! 
    7870   END SUBROUTINE bdy_tra 
    7971 
     72 
    8073   SUBROUTINE bdy_tra_frs( idx, dta, kt ) 
    8174      !!---------------------------------------------------------------------- 
    … …  
    8679      !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    8780      !!---------------------------------------------------------------------- 
    88       INTEGER,         INTENT(in) ::   kt 
    89       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    90       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    91       !!  
     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      ! 
    9285      REAL(wp) ::   zwgt           ! boundary weight 
    9386      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    … …  
    9588      !!---------------------------------------------------------------------- 
    9689      ! 
    97       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs') 
     90      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_frs') 
    9891      ! 
    9992      igrd = 1                       ! Everything is at T-points here 
    … …  
    108101      END DO  
    109102      ! 
    110       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    111       ! 
    112       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs') 
     103      IF( kt .eq. nit000 )   CLOSE( unit = 102 ) 
     104      ! 
     105      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_frs') 
    113106      ! 
    114107   END SUBROUTINE bdy_tra_frs 
    115    
     108 
     109 
    116110   SUBROUTINE bdy_tra_spe( idx, dta, kt ) 
    117111      !!---------------------------------------------------------------------- 
    … …  
    121115      !!  
    122116      !!---------------------------------------------------------------------- 
    123       INTEGER,         INTENT(in) ::   kt 
    124       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    125       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    126       !!  
     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      ! 
    127121      REAL(wp) ::   zwgt           ! boundary weight 
    128122      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    … …  
    142136      END DO 
    143137      ! 
    144       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    145       ! 
    146       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe') 
     138      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     139      ! 
     140      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_spe') 
    147141      ! 
    148142   END SUBROUTINE bdy_tra_spe 
    149143 
     144 
    150145   SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 
    151146      !!---------------------------------------------------------------------- 
    … …  
    155150      !!  
    156151      !!---------------------------------------------------------------------- 
    157       INTEGER,         INTENT(in) ::   kt 
    158       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    159       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    160       !!  
     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      ! 
    161156      REAL(wp) ::   zwgt           ! boundary weight 
    162157      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    … …  
    164159      !!---------------------------------------------------------------------- 
    165160      ! 
    166       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 
     161      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_nmn') 
    167162      ! 
    168163      igrd = 1                       ! Everything is at T-points here 
    … …  
    196191      END DO 
    197192      ! 
    198       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    199       ! 
    200       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 
     193      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     194      ! 
     195      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_nmn') 
    201196      ! 
    202197   END SUBROUTINE bdy_tra_nmn 
    … …  
    213208      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    214209      !!---------------------------------------------------------------------- 
    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  
     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      ! 
    219214      INTEGER  ::   igrd                                    ! grid index 
    220215      !!---------------------------------------------------------------------- 
    221  
     216      ! 
    222217      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 
    223218      ! 
    … …  
    230225      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 
    231226      ! 
    232       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 
    233       ! 
    234  
     227      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_orlanski') 
     228      ! 
    235229   END SUBROUTINE bdy_tra_orlanski 
    236230 
    … …  
    245239      !!  
    246240      !!---------------------------------------------------------------------- 
    247       INTEGER,         INTENT(in) ::   kt 
    248       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    249       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    250       !!  
     241      INTEGER        , INTENT(in) ::   kt    !  
     242      TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
     243      TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
     244      ! 
    251245      REAL(wp) ::   zwgt           ! boundary weight 
    252246      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    … …  
    254248      !!---------------------------------------------------------------------- 
    255249      ! 
    256       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf') 
     250      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_rnf') 
    257251      ! 
    258252      igrd = 1                       ! Everything is at T-points here 
    … …  
    268262      END DO 
    269263      ! 
    270       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    271       ! 
    272       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 
     264      IF( kt == nit000 )  CLOSE( unit = 102 ) 
     265      ! 
     266      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_rnf') 
    273267      ! 
    274268   END SUBROUTINE bdy_tra_rnf 
    275269 
     270 
    276271   SUBROUTINE bdy_tra_dmp( kt ) 
    277272      !!---------------------------------------------------------------------- 
    … …  
    281276      !!  
    282277      !!---------------------------------------------------------------------- 
    283       INTEGER,         INTENT(in) ::   kt 
    284       !!  
     278      INTEGER, INTENT(in) ::   kt   ! 
     279      ! 
    285280      REAL(wp) ::   zwgt           ! boundary weight 
    286281      REAL(wp) ::   zta, zsa, ztime 
    … …  
    290285      !!---------------------------------------------------------------------- 
    291286      ! 
    292       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp') 
    293       ! 
    294       DO ib_bdy=1, nb_bdy 
    295          IF ( ln_tra_dmp(ib_bdy) ) THEN 
     287      IF( nn_timing == 1 )   CALL timing_start('bdy_tra_dmp') 
     288      ! 
     289      DO ib_bdy = 1, nb_bdy 
     290         IF( ln_tra_dmp(ib_bdy) ) THEN 
    296291            igrd = 1                       ! Everything is at T-points here 
    297292            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    … …  
    307302            END DO 
    308303         ENDIF 
    309       ENDDO 
    310       ! 
    311       IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp') 
     304      END DO 
     305      ! 
     306      IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_dmp') 
    312307      ! 
    313308   END SUBROUTINE bdy_tra_dmp 
    … …  
    325320      WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt 
    326321   END SUBROUTINE bdy_tra_dmp 
    327  
    328322#endif 
    329323 

  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r5930 r7351  
    1010   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    1111   !!---------------------------------------------------------------------- 
    12 #if   defined key_bdy 
     12#if defined key_bdy 
    1313   !!---------------------------------------------------------------------- 
    14    !!   'key_bdy'      unstructured open boundary conditions 
     14   !!   'key_bdy'                     unstructured open boundary conditions 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce             ! ocean dynamics and tracers  
    17    USE bdy_oce         ! ocean open boundary conditions 
    18    USE sbc_oce         ! ocean surface boundary conditions 
    19    USE dom_oce         ! ocean space and time domain  
    20    USE phycst          ! physical constants 
    21    USE sbcisf          ! ice shelf 
     16   USE oce            ! ocean dynamics and tracers  
     17   USE bdy_oce        ! ocean open boundary conditions 
     18   USE sbc_oce        ! ocean surface boundary conditions 
     19   USE dom_oce        ! ocean space and time domain  
     20   USE phycst         ! physical constants 
     21   USE sbcisf         ! ice shelf 
    2222   ! 
    23    USE in_out_manager  ! I/O manager 
    24    USE lib_mpp         ! for mppsum 
    25    USE timing          ! Timing 
    26    USE lib_fortran     ! Fortran routines library 
     23   USE in_out_manager ! I/O manager 
     24   USE lib_mpp        ! for mppsum 
     25   USE timing         ! Timing 
     26   USE lib_fortran    ! Fortran routines library 
    2727 
    2828   IMPLICIT NONE 
    2929   PRIVATE 
    3030 
    31    PUBLIC bdy_vol       
     31   PUBLIC   bdy_vol    ! called by ??? 
    3232 
    33    !! * Substitutions 
    34 #  include "domzgr_substitute.h90" 
    3533   !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.6 , NEMO Consortium (2014) 
     34   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    3735   !! $Id$  
    3836   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4543      !! 
    4644      !! ** Purpose :   This routine controls the volume of the system.  
    47       !!      A correction velocity is calculated 
    48       !!      to correct the total transport through the unstructured OBC.  
     45      !!      A correction velocity is calculated to correct the total transport  
     46      !!      through the unstructured OBC.  
    4947      !!      The total depth used is constant (H0) to be consistent with the  
    50       !!      linear free surface coded in OPA 8.2 
     48      !!      linear free surface coded in OPA 8.2    <<<=== !!gm  ???? true ???? 
    5149      !! 
    5250      !! ** Method  :   The correction velocity (zubtpecor here) is defined calculating 
    … …  
    7270      !!            (set nn_volctl to 1 in tne namelist for this option) 
    7371      !!---------------------------------------------------------------------- 
    74       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    75       !! 
     72      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     73      ! 
    7674      INTEGER  ::   ji, jj, jk, jb, jgrd 
    7775      INTEGER  ::   ib_bdy, ii, ij 
    … …  
    9391      ! ----------------------------------------------------------------------- 
    9492!!gm replace these lines : 
    95       z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
     93      z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
    9694      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain 
    9795!!gm   by : 
    … …  
    110108               ii = idx%nbi(jb,jgrd) 
    111109               ij = idx%nbj(jb,jgrd) 
    112                zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     110               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 
    113111            END DO 
    114112         END DO 
    … …  
    118116               ii = idx%nbi(jb,jgrd) 
    119117               ij = idx%nbj(jb,jgrd) 
    120                zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
     118               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * e3v_n(ii,ij,jk)  
    121119            END DO 
    122120         END DO 
    … …  
    127125      ! The normal velocity correction 
    128126      ! ------------------------------ 
    129       IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot  
    130       ELSE                      ;   zubtpecor =   zubtpecor             / bdysurftot 
     127      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot  
     128      ELSE                      ;   zubtpecor =   zubtpecor               / bdysurftot 
    131129      END IF 
    132130 
    … …  
    143141               ij = idx%nbj(jb,jgrd) 
    144142               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk) 
    145                ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     143               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 
    146144            END DO 
    147145         END DO 
    … …  
    152150               ij = idx%nbj(jb,jgrd) 
    153151               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk) 
    154                ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
     152               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 
    155153            END DO 
    156154         END DO 
    … …  
    161159      ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 
    162160      ! ------------------------------------------------------ 
    163       IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 
     161      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN 
    164162         IF(lwp) WRITE(numout,*) 
    165163         IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt 
    … …  
    171169      END IF  
    172170      ! 
    173       IF( nn_timing == 1 ) CALL timing_stop('bdy_vol') 
     171      IF( nn_timing == 1 )   CALL timing_stop('bdy_vol') 
    174172      ! 
    175173      END IF ! ln_vol 
Note: See TracChangeset for help on using the changeset viewer.