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 12127 for NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/BDY/bdytides.F90 – NEMO

Ignore:
Timestamp:
2019-12-09T18:42:54+01:00 (4 years ago)
Author:
smasson
Message:

dev_r12114_ticket_2263: replace integer kt_offset by real pt_offset, see #2263

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r12114_ticket_2263/src/OCE/BDY/bdytides.F90

    r11536 r12127  
    262262 
    263263 
    264    SUBROUTINE bdytide_update( kt, idx, dta, td, kit, kt_offset ) 
     264   SUBROUTINE bdytide_update( kt, idx, dta, td, kit, pt_offset ) 
    265265      !!---------------------------------------------------------------------- 
    266266      !!                 ***  SUBROUTINE bdytide_update  *** 
     
    274274      TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data 
    275275      INTEGER, OPTIONAL, INTENT(in   ) ::   kit         ! Barotropic timestep counter (for timesplitting option) 
    276       INTEGER, OPTIONAL, INTENT(in   ) ::   kt_offset   ! time offset in units of timesteps. NB. if kit 
     276      REAL(wp), OPTIONAL,INTENT(in   ) ::   pt_offset   ! time offset in units of timesteps. NB. if kit 
    277277      !                                                 ! is present then units = subcycle timesteps. 
    278       !                                                 ! kt_offset = 0  => get data at "now"    time level 
    279       !                                                 ! kt_offset = -1 => get data at "before" time level 
    280       !                                                 ! kt_offset = +1 => get data at "after"  time level 
    281       !                                                 ! etc. 
    282278      ! 
    283279      INTEGER  ::   itide, igrd, ib       ! dummy loop indices 
    284       INTEGER  ::   time_add              ! time offset in units of timesteps 
    285280      INTEGER, DIMENSION(3) ::   ilen0    ! length of boundary data (from OBC arrays) 
    286       REAL(wp) ::   z_arg, z_sarg, zflag, zramp   ! local scalars     
     281      REAL(wp) ::   z_arg, z_sarg, zflag, zramp, zt_offset  ! local scalars     
    287282      REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost 
    288283      !!---------------------------------------------------------------------- 
     
    299294      IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN 
    300295        ! 
    301         kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
     296        kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rdt)/rdt) 
    302297        ! 
    303298        IF(lwp) THEN 
     
    312307      ENDIF  
    313308 
    314       time_add = 0 
    315       IF( PRESENT(kt_offset) ) THEN 
    316          time_add = kt_offset 
    317       ENDIF 
     309      zt_offset = 0._wp 
     310      IF( PRESENT(pt_offset) )   zt_offset = pt_offset 
    318311          
    319312      IF( PRESENT(kit) ) THEN   
    320          z_arg = ((kt-kt_tide) * rdt + (kit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) ) 
     313         z_arg =   REAL( kt - kt_tide, wp) * rdt + ( REAL(kit, wp) + 0.5_wp * ( zt_offset - 1._wp ) ) * rdt / REAL(nn_baro, wp) 
    321314      ELSE                               
    322          z_arg = ((kt-kt_tide)+time_add) * rdt 
     315         z_arg = ( REAL( kt - kt_tide, wp) + zt_offset ) * rdt 
    323316      ENDIF 
    324317 
    325318      ! Linear ramp on tidal component at open boundaries  
    326319      zramp = 1._wp 
    327       IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0._wp),1._wp) 
     320      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + REAL(kt_tide-nit000,wp)*rdt)/(rdttideramp*rday),0._wp),1._wp) 
    328321 
    329322      DO itide = 1, nb_harmo 
     
    351344 
    352345 
    353    SUBROUTINE bdy_dta_tides( kt, kit, kt_offset ) 
     346   SUBROUTINE bdy_dta_tides( kt, kit, pt_offset ) 
    354347      !!---------------------------------------------------------------------- 
    355348      !!                 ***  SUBROUTINE bdy_dta_tides  *** 
     
    360353      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter 
    361354      INTEGER, OPTIONAL, INTENT(in) ::   kit         ! Barotropic timestep counter (for timesplitting option) 
    362       INTEGER, OPTIONAL, INTENT(in) ::   kt_offset   ! time offset in units of timesteps. NB. if kit 
     355      REAL(wp),OPTIONAL, INTENT(in) ::   pt_offset   ! time offset in units of timesteps. NB. if kit 
    363356      !                                              ! is present then units = subcycle timesteps. 
    364       !                                              ! kt_offset = 0  => get data at "now"    time level 
    365       !                                              ! kt_offset = -1 => get data at "before" time level 
    366       !                                              ! kt_offset = +1 => get data at "after"  time level 
    367       !                                              ! etc. 
    368357      ! 
    369358      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
    370359      INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices 
    371       INTEGER  ::   time_add                  ! time offset in units of timesteps 
    372360      INTEGER, DIMENSION(jpbgrd)   ::   ilen0  
    373361      INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts 
    374       REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist       
     362      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset    
    375363      !!---------------------------------------------------------------------- 
    376364      ! 
     
    378366      IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF 
    379367 
    380       time_add = 0 
    381       IF( PRESENT(kt_offset) ) THEN 
    382          time_add = kt_offset 
    383       ENDIF 
     368      zt_offset = 0._wp 
     369      IF( PRESENT(pt_offset) )   zt_offset = pt_offset 
    384370       
    385371      ! Absolute time from model initialization:    
    386372      IF( PRESENT(kit) ) THEN   
    387          z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 
     373         z_arg = ( REAL(kt, wp) + ( REAL(kit, wp) + zt_offset - 1. ) / REAL(nn_baro, wp) ) * rdt 
    388374      ELSE                               
    389          z_arg = ( kt + time_add ) * rdt 
     375         z_arg = ( REAL(kt, wp) + zt_offset ) * rdt 
    390376      ENDIF 
    391377 
    392378      ! Linear ramp on tidal component at open boundaries  
    393379      zramp = 1. 
    394       IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rdttideramp*rday),0.),1.) 
     380      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - REAL(nit000, wp)*rdt)/(rdttideramp*rday),0.),1.) 
    395381 
    396382      DO ib_bdy = 1,nb_bdy 
     
    409395            IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 
    410396               ! 
    411                kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
     397               kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rdt)/rdt) 
    412398               ! 
    413399               IF(lwp) THEN 
     
    421407               ! 
    422408            ENDIF 
    423             zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time 
     409            zoff = REAL(-kt_tide,wp) * rdt ! time offset relative to nodal factor computation time 
    424410            ! 
    425411            ! If time splitting, initialize arrays from slow varying open boundary data: 
Note: See TracChangeset for help on using the changeset viewer.