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 12377 for NEMO/trunk/src/OCE/BDY – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/trunk/src/OCE/BDY/bdy_oce.F90

    r11536 r12377  
    141141   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyext   !: mark needed communication for given boundary, grid and neighbour 
    142142   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyext   !:  when searching towards the exterior of the computational domain 
     143   !! * Substitutions 
     144#  include "do_loop_substitute.h90" 
    143145   !!---------------------------------------------------------------------- 
    144146   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
  • NEMO/trunk/src/OCE/BDY/bdydta.F90

    r12049 r12377  
    2323   USE phycst         ! physical constants 
    2424   USE sbcapr         ! atmospheric pressure forcing 
    25    USE sbctide        ! Tidal forcing or not 
     25   USE tide_mod, ONLY: ln_tide ! tidal forcing 
    2626   USE bdy_oce        ! ocean open boundary conditions   
    2727   USE bdytides       ! tidal forcing at boundaries 
     
    6868!$AGRIF_END_DO_NOT_TREAT 
    6969 
     70   !! * Substitutions 
     71#  include "do_loop_substitute.h90" 
    7072   !!---------------------------------------------------------------------- 
    7173   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    7577CONTAINS 
    7678 
    77    SUBROUTINE bdy_dta( kt, kit, kt_offset ) 
     79   SUBROUTINE bdy_dta( kt, Kmm ) 
    7880      !!---------------------------------------------------------------------- 
    7981      !!                   ***  SUBROUTINE bdy_dta  *** 
     
    8587      !!---------------------------------------------------------------------- 
    8688      INTEGER, INTENT(in)           ::   kt           ! ocean time-step index  
    87       INTEGER, INTENT(in), OPTIONAL ::   kit          ! subcycle time-step index (for timesplitting option) 
    88       INTEGER, INTENT(in), OPTIONAL ::   kt_offset    ! time offset in units of timesteps. NB. if kit 
    89       !                                               ! is present then units = subcycle timesteps. 
    90       !                                               ! kt_offset = 0 => get data at "now" time level 
    91       !                                               ! kt_offset = -1 => get data at "before" time level 
    92       !                                               ! kt_offset = +1 => get data at "after" time level 
    93       !                                               ! etc. 
     89      INTEGER, INTENT(in)           ::   Kmm          ! ocean time level index 
    9490      ! 
    9591      INTEGER ::  jbdy, jfld, jstart, jend, ib, jl    ! dummy loop indices 
     
    105101      ! Initialise data arrays once for all from initial conditions where required 
    106102      !--------------------------------------------------------------------------- 
    107       IF( kt == nit000 .AND. .NOT.PRESENT(kit) ) THEN 
     103      IF( kt == nit000 ) THEN 
    108104 
    109105         ! Calculate depth-mean currents 
     
    122118                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    123119                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    124                      dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
     120                     dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1)          
    125121                  END DO 
    126122               ENDIF 
     
    130126                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    131127                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    132                      dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1)          
     128                     dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1)          
    133129                  END DO 
    134130                  igrd = 3 
     
    136132                     ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    137133                     ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    138                      dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1)          
     134                     dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1)          
    139135                  END DO 
    140136               ENDIF 
     
    149145                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    150146                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    151                         dta_bdy(jbdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)          
     147                        dta_bdy(jbdy)%u3d(ib,ik) =  ( uu(ii,ij,ik,Kmm) - uu_b(ii,ij,Kmm) ) * umask(ii,ij,ik)          
    152148                     END DO 
    153149                  END DO 
     
    157153                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    158154                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    159                         dta_bdy(jbdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)          
     155                        dta_bdy(jbdy)%v3d(ib,ik) =  ( vv(ii,ij,ik,Kmm) - vv_b(ii,ij,Kmm) ) * vmask(ii,ij,ik)          
    160156                     END DO 
    161157                  END DO 
     
    171167                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    172168                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    173                         dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
    174                         dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
     169                        dta_bdy(jbdy)%tem(ib,ik) = ts(ii,ij,ik,jp_tem,Kmm) * tmask(ii,ij,ik)          
     170                        dta_bdy(jbdy)%sal(ib,ik) = ts(ii,ij,ik,jp_sal,Kmm) * tmask(ii,ij,ik)          
    175171                     END DO 
    176172                  END DO 
     
    216212         ! read/update all bdy data 
    217213         ! ------------------------ 
    218          CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset ) 
    219  
     214         ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 
     215         CALL fld_read( kt, 1, bf_alias, pt_offset = 0.5_wp, Kmm = Kmm ) 
    220216         ! apply some corrections in some specific cases... 
    221217         ! -------------------------------------------------- 
     
    254250               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    255251               DO ik = 1, jpkm1 
    256                   dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
     252                  dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 
    257253               END DO 
    258                dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu_n(ii,ij) 
     254               dta_alias%u2d(ib) =  dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) 
    259255               DO ik = 1, jpkm1            ! compute barocline zonal velocity and put it in u3d 
    260256                  dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib) 
     
    267263               ij   = idx_bdy(jbdy)%nbj(ib,igrd) 
    268264               DO ik = 1, jpkm1 
    269                   dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
     265                  dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 
    270266               END DO 
    271                dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv_n(ii,ij) 
     267               dta_alias%v2d(ib) =  dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) 
    272268               DO ik = 1, jpkm1            ! compute barocline meridional velocity and put it in v3d 
    273269                  dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib) 
     
    275271            END DO 
    276272         ENDIF   ! ltotvel 
    277  
    278          ! update tidal harmonic forcing 
    279          IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 
    280             CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy),   &  
    281                &                 kit = kit, kt_offset = kt_offset ) 
    282          ENDIF 
    283273 
    284274         !  atm surface pressure : add inverted barometer effect to ssh if it was read 
     
    343333                  nblen => idx_bdy(jbdy)%nblen 
    344334                  nblenrim => idx_bdy(jbdy)%nblenrim 
    345                   IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF  
    346                      IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 
    347                      IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 
    348                      IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 
    349                   ENDIF 
    350                END DO 
    351             ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
    352                ! 
    353                CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset ) 
    354             ENDIF 
     335                  IF( cn_dyn2d(jbdy) == 'frs' ) THEN   ;   ilen1(:)=nblen(:) 
     336                  ELSE                                 ;   ilen1(:)=nblenrim(:) 
     337                  ENDIF 
     338                  IF ( dta_bdy(jbdy)%lneed_ssh   ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 
     339                  IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 
     340                  IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 
     341               ENDIF 
     342            END DO 
     343         ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
     344            ! 
     345            ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step 
     346            CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 
    355347         ENDIF 
    356          ! 
    357          IF( ln_timing )   CALL timing_stop('bdy_dta') 
    358          ! 
    359       END SUBROUTINE bdy_dta 
     348      ENDIF 
     349      ! 
     350      IF( ln_timing )   CALL timing_stop('bdy_dta') 
     351      ! 
     352   END SUBROUTINE bdy_dta 
    360353 
    361354 
     
    373366      INTEGER ::   ierror, ios     !  
    374367      ! 
     368      INTEGER ::   nbdy_rdstart, nbdy_loc 
     369      CHARACTER(LEN=50)                      ::   cerrmsg       ! error string 
    375370      CHARACTER(len=3)                       ::   cl3           !  
    376371      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
     
    415410      ! Read namelists 
    416411      ! -------------- 
    417       REWIND(numnam_cfg) 
     412      nbdy_rdstart = 1 
    418413      DO jbdy = 1, nb_bdy 
    419414 
     
    421416         WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy 
    422417 
    423          ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we do a rewind  
    424          REWIND(numnam_ref) 
     418         ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we read from the beginning 
    425419         READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
    426420901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' ) 
     
    431425            & .OR. ( dta_bdy(jbdy)%lneed_tra   .AND.       nn_tra_dta(jbdy)    == 1 )   & 
    432426            & .OR. ( dta_bdy(jbdy)%lneed_ice   .AND.       nn_ice_dta(jbdy)    == 1 )   )   THEN 
    433             ! WARNING: we don't do a rewind here, each bdy reads its own nambdy_dta block one after another 
    434             READ  ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 
     427            ! 
     428            ! Need to support possibility of reading more than one 
     429            ! nambdy_dta from the namelist_cfg internal file. 
     430            ! Do this by finding the jbdy'th occurence of nambdy_dta in the 
     431            ! character buffer as the starting point. 
     432            ! 
     433            nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_dta' ) 
     434            IF( nbdy_loc .GT. 0 ) THEN 
     435               nbdy_rdstart = nbdy_rdstart + nbdy_loc 
     436            ELSE 
     437               WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',jbdy,' of nambdy_dta not found' 
     438               ios = -1 
     439               CALL ctl_nam ( ios , cerrmsg ) 
     440            ENDIF 
     441            READ  ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_dta, IOSTAT = ios, ERR = 902) 
    435442902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' ) 
    436443            IF(lwm) WRITE( numond, nambdy_dta )            
     
    442449            IF( nn_ice_dta(jbdy) == 1 ) THEN   ! if we get ice bdy data from netcdf file 
    443450               CALL fld_fill(  bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 )   ! use namelist info 
    444                CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday )   ! not a problem when we call it again after 
     451               CALL fld_def( bf(jp_bdya_i,jbdy) ) 
     452               CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num ) 
    445453               idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 
    446454               IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN   ;   ipl = i4dimsz(3)   ! xylt or xyl 
    447455               ELSE                                                            ;   ipl = 1            ! xy or xyt 
    448456               ENDIF 
     457               CALL iom_close( bf(jp_bdya_i,jbdy)%num ) 
    449458               bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED'   ! reset to default value as this subdomain may not need to read this bdy 
    450459            ENDIF 
  • NEMO/trunk/src/OCE/BDY/bdydyn.F90

    r10068 r12377  
    3737CONTAINS 
    3838 
    39    SUBROUTINE bdy_dyn( kt, dyn3d_only ) 
     39   SUBROUTINE bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only ) 
    4040      !!---------------------------------------------------------------------- 
    4141      !!                  ***  SUBROUTINE bdy_dyn  *** 
     
    4444      !! 
    4545      !!---------------------------------------------------------------------- 
    46       INTEGER, INTENT(in)           ::   kt           ! Main time step counter 
    47       LOGICAL, INTENT(in), OPTIONAL ::   dyn3d_only   ! T => only update baroclinic velocities 
     46      INTEGER                             , INTENT(in)    ::   kt           ! Main time step counter 
     47      INTEGER                             , INTENT(in)    ::   Kbb, Kaa     ! Ocean time level indices 
     48      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv     ! Ocean velocities (to be updated at open boundaries) 
     49      LOGICAL, OPTIONAL                   , INTENT(in)    ::   dyn3d_only   ! T => only update baroclinic velocities 
    4850      ! 
    4951      INTEGER ::   jk, ii, ij, ib_bdy, ib, igrd     ! Loop counter 
    5052      LOGICAL ::   ll_dyn2d, ll_dyn3d, ll_orlanski 
    51       REAL(wp), DIMENSION(jpi,jpj) :: pua2d, pva2d     ! after barotropic velocities 
     53      REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d     ! after barotropic velocities 
    5254      !!---------------------------------------------------------------------- 
    5355      ! 
     
    7072 
    7173      !                          ! "After" velocities:  
    72       pua2d(:,:) = 0._wp 
    73       pva2d(:,:) = 0._wp      
     74      zua2d(:,:) = 0._wp 
     75      zva2d(:,:) = 0._wp      
    7476      DO jk = 1, jpkm1 
    75          pua2d(:,:) = pua2d(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    76          pva2d(:,:) = pva2d(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
     77         zua2d(:,:) = zua2d(:,:) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 
     78         zva2d(:,:) = zva2d(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    7779      END DO 
    78       pua2d(:,:) = pua2d(:,:) * r1_hu_a(:,:) 
    79       pva2d(:,:) = pva2d(:,:) * r1_hv_a(:,:) 
     80      zua2d(:,:) = zua2d(:,:) * r1_hu(:,:,Kaa) 
     81      zva2d(:,:) = zva2d(:,:) * r1_hv(:,:,Kaa) 
    8082 
    8183      DO jk = 1 , jpkm1 
    82          ua(:,:,jk) = ( ua(:,:,jk) - pua2d(:,:) ) * umask(:,:,jk) 
    83          va(:,:,jk) = ( va(:,:,jk) - pva2d(:,:) ) * vmask(:,:,jk) 
     84         puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zua2d(:,:) ) * umask(:,:,jk) 
     85         pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zva2d(:,:) ) * vmask(:,:,jk) 
    8486      END DO 
    8587 
     
    8789      IF( ll_orlanski ) THEN     ! "Before" velocities (Orlanski condition only)  
    8890         DO jk = 1 , jpkm1 
    89             ub(:,:,jk) = ( ub(:,:,jk) - ub_b(:,:) ) * umask(:,:,jk) 
    90             vb(:,:,jk) = ( vb(:,:,jk) - vb_b(:,:) ) * vmask(:,:,jk) 
     91            puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) - uu_b(:,:,Kbb) ) * umask(:,:,jk) 
     92            pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) - vv_b(:,:,Kbb) ) * vmask(:,:,jk) 
    9193         END DO 
    9294      ENDIF 
     
    9799      !------------------------------------------------------- 
    98100 
    99       IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha ) 
     101      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu(:,:,Kaa), r1_hv(:,:,Kaa), ssh(:,:,Kaa) ) 
    100102 
    101       IF( ll_dyn3d )   CALL bdy_dyn3d( kt ) 
     103      IF( ll_dyn3d )   CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 
    102104 
    103105      !------------------------------------------------------- 
     
    106108      ! 
    107109      DO jk = 1 , jpkm1 
    108          ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 
    109          va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 
     110         puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) + zua2d(:,:) ) * umask(:,:,jk) 
     111         pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) + zva2d(:,:) ) * vmask(:,:,jk) 
    110112      END DO 
    111113      ! 
    112114      IF ( ll_orlanski ) THEN 
    113115         DO jk = 1 , jpkm1 
    114             ub(:,:,jk) = ( ub(:,:,jk) + ub_b(:,:) ) * umask(:,:,jk) 
    115             vb(:,:,jk) = ( vb(:,:,jk) + vb_b(:,:) ) * vmask(:,:,jk) 
     116            puu(:,:,jk,Kbb) = ( puu(:,:,jk,Kbb) + uu_b(:,:,Kbb) ) * umask(:,:,jk) 
     117            pvv(:,:,jk,Kbb) = ( pvv(:,:,jk,Kbb) + vv_b(:,:,Kbb) ) * vmask(:,:,jk) 
    116118         END DO 
    117119      END IF 
  • NEMO/trunk/src/OCE/BDY/bdydyn3d.F90

    r11536 r12377  
    3333CONTAINS 
    3434 
    35    SUBROUTINE bdy_dyn3d( kt ) 
     35   SUBROUTINE bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 
    3636      !!---------------------------------------------------------------------- 
    3737      !!                  ***  SUBROUTINE bdy_dyn3d  *** 
     
    4040      !! 
    4141      !!---------------------------------------------------------------------- 
    42       INTEGER, INTENT(in) ::   kt   ! Main time step counter 
     42      INTEGER                             , INTENT( in    ) ::   kt        ! Main time step counter 
     43      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices 
     44      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
    4345      ! 
    4446      INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index 
     
    5860            CASE('none')        ;   CYCLE 
    5961            CASE('frs' )        ! treat the whole boundary at once 
    60                IF( ir == 0) CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     62                       IF( ir == 0) CALL bdy_dyn3d_frs( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    6163            CASE('specified')   ! treat the whole rim      at once 
    62                IF( ir == 0) CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     64                       IF( ir == 0) CALL bdy_dyn3d_spe( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    6365            CASE('zero')        ! treat the whole rim      at once 
    64                IF( ir == 0) CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    65             CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. ) 
    66             CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true.  ) 
    67             CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 ) 
    68             CASE('neumann')     ;   CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy, llrim0 ) 
     66                       IF( ir == 0) CALL bdy_dyn3d_zro( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     67            CASE('orlanski' )   ;   CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.false. ) 
     68            CASE('orlanski_npo');   CALL bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, llrim0, ll_npo=.true.  ) 
     69            CASE('zerograd')    ;   CALL bdy_dyn3d_zgrad( puu, pvv, Kaa, idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy, llrim0 ) 
     70            CASE('neumann')     ;   CALL bdy_dyn3d_nmn( puu, pvv, Kaa, idx_bdy(ib_bdy), ib_bdy, llrim0 ) 
    6971            CASE DEFAULT        ;   CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    7072            END SELECT 
     
    9799         ! 
    98100         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    99             CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     101            CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
    100102         END IF 
    101103         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    102             CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     104            CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
    103105         END IF 
    104106      END DO   ! ir 
     
    107109 
    108110 
    109    SUBROUTINE bdy_dyn3d_spe( idx, dta, kt , ib_bdy ) 
     111   SUBROUTINE bdy_dyn3d_spe( puu, pvv, Kaa, idx, dta, kt, ib_bdy ) 
    110112      !!---------------------------------------------------------------------- 
    111113      !!                  ***  SUBROUTINE bdy_dyn3d_spe  *** 
     
    115117      !! 
    116118      !!---------------------------------------------------------------------- 
    117       INTEGER        , INTENT(in) ::   kt      ! time step index 
    118       TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    119       TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    120       INTEGER        , INTENT(in) ::   ib_bdy  ! BDY set index 
     119      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
     120      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     121      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
     122      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
     123      INTEGER                             , INTENT( in    ) ::   kt        ! Time step 
     124      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index 
    121125      ! 
    122126      INTEGER  ::   jb, jk         ! dummy loop indices 
     
    129133            ii   = idx%nbi(jb,igrd) 
    130134            ij   = idx%nbj(jb,igrd) 
    131             ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk) 
     135            puu(ii,ij,jk,Kaa) = dta%u3d(jb,jk) * umask(ii,ij,jk) 
    132136         END DO 
    133137      END DO 
     
    138142            ii   = idx%nbi(jb,igrd) 
    139143            ij   = idx%nbj(jb,igrd) 
    140             va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 
     144            pvv(ii,ij,jk,Kaa) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 
    141145         END DO 
    142146      END DO 
     
    145149 
    146150 
    147    SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt, ib_bdy, llrim0 ) 
     151   SUBROUTINE bdy_dyn3d_zgrad( puu, pvv, Kaa, idx, dta, kt, ib_bdy, llrim0 ) 
    148152      !!---------------------------------------------------------------------- 
    149153      !!                  ***  SUBROUTINE bdy_dyn3d_zgrad  *** 
     
    152156      !! 
    153157      !!---------------------------------------------------------------------- 
    154       INTEGER                     ::   kt 
    155       TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices 
    156       TYPE(OBC_DATA),  INTENT(in) ::   dta      ! OBC external data 
    157       INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index 
    158       LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     158      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
     159      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     160      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
     161      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
     162      INTEGER                             , INTENT( in    ) ::   kt 
     163      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index 
     164      LOGICAL                             , INTENT( in    ) ::   llrim0   ! indicate if rim 0 is treated 
    159165      !! 
    160166      INTEGER  ::   jb, jk         ! dummy loop indices 
     
    178184            ! 
    179185            DO jk = 1, jpkm1 
    180                ua(ii,ij,jk) = ua(ii,ij+flagv,jk) * umask(ii,ij+flagv,jk) 
     186               puu(ii,ij,jk,Kaa) = puu(ii,ij+flagv,jk,Kaa) * umask(ii,ij+flagv,jk) 
    181187            END DO 
    182188            ! 
     
    198204            ! 
    199205            DO jk = 1, jpkm1 
    200                va(ii,ij,jk) = va(ii+flagu,ij,jk) * vmask(ii+flagu,ij,jk) 
     206               pvv(ii,ij,jk,Kaa) = pvv(ii+flagu,ij,jk,Kaa) * vmask(ii+flagu,ij,jk) 
    201207            END DO 
    202208            ! 
     
    207213 
    208214 
    209    SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) 
     215   SUBROUTINE bdy_dyn3d_zro( puu, pvv, Kaa, idx, dta, kt, ib_bdy ) 
    210216      !!---------------------------------------------------------------------- 
    211217      !!                  ***  SUBROUTINE bdy_dyn3d_zro  *** 
     
    214220      !! 
    215221      !!---------------------------------------------------------------------- 
    216       INTEGER        , INTENT(in) ::   kt      ! time step index 
    217       TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    218       TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    219       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     222      INTEGER                             , INTENT( in    ) ::   kt        ! time step index 
     223      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
     224      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     225      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
     226      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
     227      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index 
    220228      ! 
    221229      INTEGER  ::   ib, ik         ! dummy loop indices 
     
    228236         ij = idx%nbj(ib,igrd) 
    229237         DO ik = 1, jpkm1 
    230             ua(ii,ij,ik) = 0._wp 
     238            puu(ii,ij,ik,Kaa) = 0._wp 
    231239         END DO 
    232240      END DO 
     
    237245         ij = idx%nbj(ib,igrd) 
    238246         DO ik = 1, jpkm1 
    239             va(ii,ij,ik) = 0._wp 
     247            pvv(ii,ij,ik,Kaa) = 0._wp 
    240248         END DO 
    241249      END DO 
     
    244252 
    245253 
    246    SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy ) 
     254   SUBROUTINE bdy_dyn3d_frs( puu, pvv, Kaa, idx, dta, kt, ib_bdy ) 
    247255      !!---------------------------------------------------------------------- 
    248256      !!                  ***  SUBROUTINE bdy_dyn3d_frs  *** 
     
    255263      !!               topography. Tellus, 365-382. 
    256264      !!---------------------------------------------------------------------- 
    257       INTEGER        , INTENT(in) ::   kt      ! time step index 
    258       TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    259       TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    260       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     265      INTEGER                             , INTENT( in    ) ::   kt        ! time step index 
     266      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
     267      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     268      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
     269      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
     270      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index 
    261271      ! 
    262272      INTEGER  ::   jb, jk         ! dummy loop indices 
     
    271281            ij   = idx%nbj(jb,igrd) 
    272282            zwgt = idx%nbw(jb,igrd) 
    273             ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk) 
     283            puu(ii,ij,jk,Kaa) = ( puu(ii,ij,jk,Kaa) + zwgt * ( dta%u3d(jb,jk) - puu(ii,ij,jk,Kaa) ) ) * umask(ii,ij,jk) 
    274284         END DO 
    275285      END DO 
     
    281291            ij   = idx%nbj(jb,igrd) 
    282292            zwgt = idx%nbw(jb,igrd) 
    283             va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk) 
     293            pvv(ii,ij,jk,Kaa) = ( pvv(ii,ij,jk,Kaa) + zwgt * ( dta%v3d(jb,jk) - pvv(ii,ij,jk,Kaa) ) ) * vmask(ii,ij,jk) 
    284294         END DO 
    285295      END DO    
     
    288298 
    289299 
    290    SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, llrim0, ll_npo ) 
     300   SUBROUTINE bdy_dyn3d_orlanski( Kbb, puu, pvv, Kaa, idx, dta, ib_bdy, llrim0, ll_npo ) 
    291301      !!---------------------------------------------------------------------- 
    292302      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  *** 
     
    298308      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    299309      !!---------------------------------------------------------------------- 
    300       TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    301       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    302       INTEGER,                      INTENT(in) ::   ib_bdy   ! BDY set index 
    303       LOGICAL,                      INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    304       LOGICAL,                      INTENT(in) ::   ll_npo   ! switch for NPO version 
     310      INTEGER                             , INTENT( in    ) ::   Kbb, Kaa  ! Time level indices 
     311      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     312      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
     313      TYPE(OBC_DATA)                      , INTENT( in    ) ::   dta       ! OBC external data 
     314      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index 
     315      LOGICAL                             , INTENT( in    ) ::   llrim0    ! indicate if rim 0 is treated 
     316      LOGICAL                             , INTENT( in    ) ::   ll_npo    ! switch for NPO version 
    305317 
    306318      INTEGER  ::   jb, igrd                               ! dummy loop indices 
    307319      !!---------------------------------------------------------------------- 
    308320      ! 
    309       !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
     321      !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities.  
    310322      ! 
    311323      igrd = 2      ! Orlanski bc on u-velocity;  
    312324      !             
    313       CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo, llrim0 ) 
     325      CALL bdy_orlanski_3d( idx, igrd, puu(:,:,:,Kbb), puu(:,:,:,Kaa), dta%u3d, ll_npo, llrim0 ) 
    314326 
    315327      igrd = 3      ! Orlanski bc on v-velocity 
    316328      !   
    317       CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo, llrim0 ) 
     329      CALL bdy_orlanski_3d( idx, igrd, pvv(:,:,:,Kbb), pvv(:,:,:,Kaa), dta%v3d, ll_npo, llrim0 ) 
    318330      ! 
    319331   END SUBROUTINE bdy_dyn3d_orlanski 
    320332 
    321333 
    322    SUBROUTINE bdy_dyn3d_dmp( kt ) 
     334   SUBROUTINE bdy_dyn3d_dmp( kt, Kbb, puu, pvv, Krhs ) 
    323335      !!---------------------------------------------------------------------- 
    324336      !!                  ***  SUBROUTINE bdy_dyn3d_dmp  *** 
     
    327339      !! 
    328340      !!---------------------------------------------------------------------- 
    329       INTEGER, INTENT(in) ::   kt   ! time step index 
     341      INTEGER                             , INTENT( in    ) ::   kt        ! time step 
     342      INTEGER                             , INTENT( in    ) ::   Kbb, Krhs ! Time level indices 
     343      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities and trends (to be updated at open boundaries) 
    330344      ! 
    331345      INTEGER  ::   jb, jk         ! dummy loop indices 
     
    345359               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 
    346360               DO jk = 1, jpkm1 
    347                   ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 
    348                                    ub(ii,ij,jk) + ub_b(ii,ij)) ) * umask(ii,ij,jk) 
     361                  puu(ii,ij,jk,Krhs) = ( puu(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 
     362                                   puu(ii,ij,jk,Kbb) + uu_b(ii,ij,Kbb)) ) * umask(ii,ij,jk) 
    349363               END DO 
    350364            END DO 
     
    356370               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 
    357371               DO jk = 1, jpkm1 
    358                   va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  & 
    359                                    vb(ii,ij,jk) + vb_b(ii,ij)) ) * vmask(ii,ij,jk) 
     372                  pvv(ii,ij,jk,Krhs) = ( pvv(ii,ij,jk,Krhs) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  & 
     373                                   pvv(ii,ij,jk,Kbb) + vv_b(ii,ij,Kbb)) ) * vmask(ii,ij,jk) 
    360374               END DO 
    361375            END DO 
     
    368382 
    369383 
    370    SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy, llrim0 ) 
     384   SUBROUTINE bdy_dyn3d_nmn( puu, pvv, Kaa, idx, ib_bdy, llrim0 ) 
    371385      !!---------------------------------------------------------------------- 
    372386      !!                 ***  SUBROUTINE bdy_dyn3d_nmn  *** 
     
    377391      !! 
    378392      !!---------------------------------------------------------------------- 
    379       TYPE(OBC_INDEX), INTENT(in) ::   idx      ! OBC indices 
    380       INTEGER,         INTENT(in) ::   ib_bdy   ! BDY set index 
    381       LOGICAL,         INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     393      INTEGER                             , INTENT( in    ) ::   Kaa       ! Time level index 
     394      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) ::   puu, pvv  ! Ocean velocities (to be updated at open boundaries) 
     395      TYPE(OBC_INDEX)                     , INTENT( in    ) ::   idx       ! OBC indices 
     396      INTEGER                             , INTENT( in    ) ::   ib_bdy    ! BDY set index 
     397      LOGICAL                             , INTENT( in    ) ::   llrim0    ! indicate if rim 0 is treated 
    382398      INTEGER  ::   igrd                        ! dummy indice 
    383399      !!---------------------------------------------------------------------- 
    384400      ! 
    385       !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
     401      !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities.  
    386402      ! 
    387403      igrd = 2      ! Neumann bc on u-velocity;  
    388404      !             
    389       CALL bdy_nmn( idx, igrd, ua, llrim0 )   ! ua is masked 
     405      CALL bdy_nmn( idx, igrd, puu(:,:,:,Kaa), llrim0 ) 
    390406 
    391407      igrd = 3      ! Neumann bc on v-velocity 
    392408      !   
    393       CALL bdy_nmn( idx, igrd, va, llrim0 )   ! va is masked 
     409      CALL bdy_nmn( idx, igrd, pvv(:,:,:,Kaa), llrim0 ) 
    394410      ! 
    395411   END SUBROUTINE bdy_dyn3d_nmn 
  • NEMO/trunk/src/OCE/BDY/bdyini.F90

    r12142 r12377  
    2222   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine) 
    2323   USE bdytides       ! open boundary cond. setting   (bdytide_init routine) 
    24    USE sbctide        ! Tidal forcing or not 
     24   USE tide_mod, ONLY: ln_tide ! tidal forcing 
    2525   USE phycst   , ONLY: rday 
    2626   ! 
     
    7575      ! Read namelist parameters 
    7676      ! ------------------------ 
    77       REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries 
    7877      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 
    7978901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' ) 
     
    9392      cn_ice         (2:jp_bdy) = cn_ice         (1) 
    9493      nn_ice_dta     (2:jp_bdy) = nn_ice_dta     (1) 
    95       REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries 
    9694      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 
    9795902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist' ) 
     
    364362      ! ------------------------------------------------- 
    365363 
    366       REWIND( numnam_cfg )      
    367364      nblendta(:,:) = 0 
    368365      nbdysege = 0 
     
    10801077      INTEGER          ::   ios                 ! Local integer output status for namelist read 
    10811078      INTEGER          ::   nbdyind, nbdybeg, nbdyend 
     1079      INTEGER          ::   nbdy_count, nbdy_rdstart, nbdy_loc 
    10821080      CHARACTER(LEN=1) ::   ctypebdy   !     -        -  
     1081      CHARACTER(LEN=50)::   cerrmsg    !     -        -  
    10831082      NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 
    10841083      !!---------------------------------------------------------------------- 
    1085  
    1086       ! No REWIND here because may need to read more than one nambdy_index namelist. 
    1087       ! Read only namelist_cfg to avoid unseccessfull overwrite  
    1088       ! keep full control of the configuration namelist 
    1089       READ  ( numnam_cfg, nambdy_index, IOSTAT = ios, ERR = 904 ) 
     1084      ! Need to support possibility of reading more than one nambdy_index from 
     1085      ! the namelist_cfg internal file. 
     1086      ! Do this by finding the kb_bdy'th occurence of nambdy_index in the 
     1087      ! character buffer as the starting point. 
     1088      nbdy_rdstart = 1 
     1089      DO nbdy_count = 1, kb_bdy 
     1090       nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_index' ) 
     1091       IF( nbdy_loc .GT. 0 ) THEN 
     1092          nbdy_rdstart = nbdy_rdstart + nbdy_loc 
     1093       ELSE 
     1094          WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',kb_bdy,' of nambdy_index not found' 
     1095          ios = -1 
     1096          CALL ctl_nam ( ios , cerrmsg ) 
     1097       ENDIF 
     1098      END DO 
     1099      nbdy_rdstart = MAX( 1, nbdy_rdstart - 2 ) 
     1100      READ  ( numnam_cfg( nbdy_rdstart: ), nambdy_index, IOSTAT = ios, ERR = 904) 
    10901101904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_index in configuration namelist' ) 
    10911102      IF(lwm) WRITE ( numond, nambdy_index ) 
  • NEMO/trunk/src/OCE/BDY/bdylib.F90

    r11536 r12377  
    3535CONTAINS 
    3636 
    37    SUBROUTINE bdy_frs( idx, pta, dta ) 
     37   SUBROUTINE bdy_frs( idx, phia, dta ) 
    3838      !!---------------------------------------------------------------------- 
    3939      !!                 ***  SUBROUTINE bdy_frs  *** 
     
    4545      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
    4646      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
    47       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     47      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend 
    4848      !! 
    4949      REAL(wp) ::   zwgt           ! boundary weight 
     
    5858            ij = idx%nbj(ib,igrd) 
    5959            zwgt = idx%nbw(ib,igrd) 
    60             pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 
     60            phia(ii,ij,ik) = ( phia(ii,ij,ik) + zwgt * (dta(ib,ik) - phia(ii,ij,ik) ) ) * tmask(ii,ij,ik) 
    6161         END DO 
    6262      END DO 
     
    6565 
    6666 
    67    SUBROUTINE bdy_spe( idx, pta, dta ) 
     67   SUBROUTINE bdy_spe( idx, phia, dta ) 
    6868      !!---------------------------------------------------------------------- 
    6969      !!                 ***  SUBROUTINE bdy_spe  *** 
     
    7474      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
    7575      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
    76       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend 
    7777      !! 
    7878      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     
    8585         ij = idx%nbj(ib,igrd) 
    8686         DO ik = 1, jpkm1 
    87             pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 
     87            phia(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 
    8888         END DO 
    8989      END DO 
     
    9292 
    9393 
    94    SUBROUTINE bdy_orl( idx, ptb, pta, dta, lrim0, ll_npo ) 
     94   SUBROUTINE bdy_orl( idx, phib, phia, dta, lrim0, ll_npo ) 
    9595      !!---------------------------------------------------------------------- 
    9696      !!                 ***  SUBROUTINE bdy_orl  *** 
     
    102102      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
    103103      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptb  ! before tracer field 
    105       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     104      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phib  ! before tracer field 
     105      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phia  ! tracer trend 
    106106      LOGICAL                 , OPTIONAL,  INTENT(in) ::   lrim0   ! indicate if rim 0 is treated 
    107107      LOGICAL,                             INTENT(in) ::   ll_npo  ! switch for NPO version 
     
    112112      igrd = 1                       ! Everything is at T-points here 
    113113      ! 
    114       CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, lrim0, ll_npo ) 
     114      CALL bdy_orlanski_3d( idx, igrd, phib(:,:,:), phia(:,:,:), dta, lrim0, ll_npo ) 
    115115      ! 
    116116   END SUBROUTINE bdy_orl 
  • NEMO/trunk/src/OCE/BDY/bdytides.F90

    r11536 r12377  
    1818   USE phycst         ! physical constants 
    1919   USE bdy_oce        ! ocean open boundary conditions 
    20    USE tideini        !  
     20   USE tide_mod       !  
    2121   USE daymod         ! calendar 
    2222   ! 
     
    3030 
    3131   PUBLIC   bdytide_init     ! routine called in bdy_init 
    32    PUBLIC   bdytide_update   ! routine called in bdy_dta 
    3332   PUBLIC   bdy_dta_tides    ! routine called in dyn_spg_ts 
    3433 
     
    4544   TYPE(OBC_DATA)  , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component) 
    4645 
     46   INTEGER ::   kt_tide 
     47 
     48   !! * Substitutions 
     49#  include "do_loop_substitute.h90" 
    4750   !!---------------------------------------------------------------------- 
    4851   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6467      CHARACTER(len=80)                         ::   filtide             !: Filename root for tidal input files 
    6568      LOGICAL                                   ::   ln_bdytide_2ddta    !: If true, read 2d harmonic data 
    66       LOGICAL                                   ::   ln_bdytide_conj     !: If true, assume complex conjugate tidal data 
    6769      !! 
    6870      INTEGER                                   ::   ib_bdy, itide, ib   !: dummy loop indices 
     
    7173      INTEGER, DIMENSION(3)                     ::   ilen0       !: length of boundary data (from OBC arrays) 
    7274      INTEGER                                   ::   ios                 ! Local integer output status for namelist read 
     75      INTEGER                                   ::   nbdy_rdstart, nbdy_loc 
     76      CHARACTER(LEN=50)                         ::   cerrmsg             !: error string 
    7377      CHARACTER(len=80)                         ::   clfile              !: full file name for tidal input file  
    7478      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read            !: work space to read in tidal harmonics data 
     
    7781      TYPE(TIDES_DATA),  POINTER                ::   td                  !: local short cut    
    7882      !! 
    79       NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj 
     83      NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta 
    8084      !!---------------------------------------------------------------------- 
    8185      ! 
     
    8488      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    8589 
    86       REWIND(numnam_cfg) 
    87  
     90 
     91      nbdy_rdstart = 1 
    8892      DO ib_bdy = 1, nb_bdy 
    8993         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
     
    9498            filtide(:) = '' 
    9599 
    96             REWIND( numnam_ref ) 
    97100            READ  ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901) 
    98101901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_tide in reference namelist' ) 
    99             ! Don't REWIND here - may need to read more than one of these namelists.  
    100             READ  ( numnam_cfg, nambdy_tide, IOSTAT = ios, ERR = 902 ) 
     102            ! 
     103            ! Need to support possibility of reading more than one 
     104            ! nambdy_tide from the namelist_cfg internal file. 
     105            ! Do this by finding the ib_bdy'th occurence of nambdy_tide in the 
     106            ! character buffer as the starting point. 
     107            ! 
     108            nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_tide' ) 
     109            IF( nbdy_loc .GT. 0 ) THEN 
     110               nbdy_rdstart = nbdy_rdstart + nbdy_loc 
     111            ELSE 
     112               WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',ib_bdy,' of nambdy_tide not found' 
     113               ios = -1 
     114               CALL ctl_nam ( ios , cerrmsg ) 
     115            ENDIF 
     116            READ  ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_tide, IOSTAT = ios, ERR = 902) 
    101117902         IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' ) 
    102118            IF(lwm) WRITE ( numond, nambdy_tide ) 
     
    105121            IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries' 
    106122            IF(lwp) WRITE(numout,*) '             read tidal data in 2d files: ', ln_bdytide_2ddta 
    107             IF(lwp) WRITE(numout,*) '             assume complex conjugate   : ', ln_bdytide_conj 
    108123            IF(lwp) WRITE(numout,*) '             Number of tidal components to read: ', nb_harmo 
    109124            IF(lwp) THEN  
    110125                    WRITE(numout,*) '             Tidal components: '  
    111126               DO itide = 1, nb_harmo 
    112                   WRITE(numout,*)  '                 ', Wave(ntide(itide))%cname_tide  
     127                  WRITE(numout,*)  '                 ', tide_harmonics(itide)%cname_tide  
    113128               END DO 
    114129            ENDIF  
     
    151166               igrd = 1                       ! Everything is at T-points here 
    152167               DO itide = 1, nb_harmo 
    153                   CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
    154                   CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )  
     168                  CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
     169                  CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
    155170                  DO ib = 1, ilen0(igrd) 
    156171                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    168183               igrd = 2                       ! Everything is at U-points here 
    169184               DO itide = 1, nb_harmo 
    170                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 
    171                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 
     185                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
     186                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
    172187                  DO ib = 1, ilen0(igrd) 
    173188                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    185200               igrd = 3                       ! Everything is at V-points here 
    186201               DO itide = 1, nb_harmo 
    187                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 
    188                   CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 
     202                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
     203                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
    189204                  DO ib = 1, ilen0(igrd) 
    190205                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    210225               DO itide = 1, nb_harmo 
    211226                  !                                                              ! SSH fields 
    212                   clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_T.nc' 
     227                  clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 
    213228                  CALL iom_open( clfile, inum ) 
    214229                  CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 
     
    218233                  CALL iom_close( inum ) 
    219234                  !                                                              ! U fields 
    220                   clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_U.nc' 
     235                  clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 
    221236                  CALL iom_open( clfile, inum ) 
    222237                  CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 
     
    226241                  CALL iom_close( inum ) 
    227242                  !                                                              ! V fields 
    228                   clfile = TRIM(filtide)//TRIM(Wave(ntide(itide))%cname_tide)//'_grid_V.nc' 
     243                  clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 
    229244                  CALL iom_open( clfile, inum ) 
    230245                  CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 
     
    240255            ENDIF ! ln_bdytide_2ddta=.true. 
    241256            ! 
    242             IF( ln_bdytide_conj ) THEN    ! assume complex conjugate in data files 
    243                td%ssh0(:,:,2) = - td%ssh0(:,:,2) 
    244                td%u0  (:,:,2) = - td%u0  (:,:,2) 
    245                td%v0  (:,:,2) = - td%v0  (:,:,2) 
    246             ENDIF 
    247             ! 
    248257            ! Allocate slow varying data in the case of time splitting: 
    249258            ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
     
    262271 
    263272 
    264    SUBROUTINE bdytide_update( kt, idx, dta, td, kit, kt_offset ) 
    265       !!---------------------------------------------------------------------- 
    266       !!                 ***  SUBROUTINE bdytide_update  *** 
    267       !!                 
    268       !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays.  
    269       !!                 
    270       !!---------------------------------------------------------------------- 
    271       INTEGER          , INTENT(in   ) ::   kt          ! Main timestep counter 
    272       TYPE(OBC_INDEX)  , INTENT(in   ) ::   idx         ! OBC indices 
    273       TYPE(OBC_DATA)   , INTENT(inout) ::   dta         ! OBC external data 
    274       TYPE(TIDES_DATA) , INTENT(inout) ::   td          ! tidal harmonics data 
    275       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 
    277       !                                                 ! 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. 
    282       ! 
    283       INTEGER  ::   itide, igrd, ib       ! dummy loop indices 
    284       INTEGER  ::   time_add              ! time offset in units of timesteps 
    285       INTEGER, DIMENSION(3) ::   ilen0    ! length of boundary data (from OBC arrays) 
    286       REAL(wp) ::   z_arg, z_sarg, zflag, zramp   ! local scalars     
    287       REAL(wp), DIMENSION(jpmax_harmo) :: z_sist, z_cost 
    288       !!---------------------------------------------------------------------- 
    289       ! 
    290       ilen0(1) =  SIZE(td%ssh(:,1,1)) 
    291       ilen0(2) =  SIZE(td%u(:,1,1)) 
    292       ilen0(3) =  SIZE(td%v(:,1,1)) 
    293  
    294       zflag=1 
    295       IF ( PRESENT(kit) ) THEN 
    296         IF ( kit /= 1 ) zflag=0 
    297       ENDIF 
    298  
    299       IF ( (nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000) .AND. zflag==1 ) THEN 
    300         ! 
    301         kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
    302         ! 
    303         IF(lwp) THEN 
    304            WRITE(numout,*) 
    305            WRITE(numout,*) 'bdytide_update : (re)Initialization of the tidal bdy forcing at kt=',kt 
    306            WRITE(numout,*) '~~~~~~~~~~~~~~ ' 
    307         ENDIF 
    308         ! 
    309         CALL tide_init_elevation ( idx, td ) 
    310         CALL tide_init_velocities( idx, td ) 
    311         ! 
    312       ENDIF  
    313  
    314       time_add = 0 
    315       IF( PRESENT(kt_offset) ) THEN 
    316          time_add = kt_offset 
    317       ENDIF 
    318           
    319       IF( PRESENT(kit) ) THEN   
    320          z_arg = ((kt-kt_tide) * rdt + (kit+0.5_wp*(time_add-1)) * rdt / REAL(nn_baro,wp) ) 
    321       ELSE                               
    322          z_arg = ((kt-kt_tide)+time_add) * rdt 
    323       ENDIF 
    324  
    325       ! Linear ramp on tidal component at open boundaries  
    326       zramp = 1._wp 
    327       IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg + (kt_tide-nit000)*rdt)/(rdttideramp*rday),0._wp),1._wp) 
    328  
    329       DO itide = 1, nb_harmo 
    330          z_sarg = z_arg * omega_tide(itide) 
    331          z_cost(itide) = COS( z_sarg ) 
    332          z_sist(itide) = SIN( z_sarg ) 
    333       END DO 
    334  
    335       DO itide = 1, nb_harmo 
    336          igrd=1                              ! SSH on tracer grid 
    337          DO ib = 1, ilen0(igrd) 
    338             dta%ssh(ib) = dta%ssh(ib) + zramp*(td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide)) 
    339          END DO 
    340          igrd=2                              ! U grid 
    341          DO ib = 1, ilen0(igrd) 
    342             dta%u2d(ib) = dta%u2d(ib) + zramp*(td%u  (ib,itide,1)*z_cost(itide) + td%u  (ib,itide,2)*z_sist(itide)) 
    343          END DO 
    344          igrd=3                              ! V grid 
    345          DO ib = 1, ilen0(igrd)  
    346             dta%v2d(ib) = dta%v2d(ib) + zramp*(td%v  (ib,itide,1)*z_cost(itide) + td%v  (ib,itide,2)*z_sist(itide)) 
    347          END DO 
    348       END DO 
    349       ! 
    350    END SUBROUTINE bdytide_update 
    351  
    352  
    353    SUBROUTINE bdy_dta_tides( kt, kit, kt_offset ) 
     273   SUBROUTINE bdy_dta_tides( kt, kit, pt_offset ) 
    354274      !!---------------------------------------------------------------------- 
    355275      !!                 ***  SUBROUTINE bdy_dta_tides  *** 
     
    360280      INTEGER,           INTENT(in) ::   kt          ! Main timestep counter 
    361281      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 
    363       !                                              ! 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. 
     282      REAL(wp),OPTIONAL, INTENT(in) ::   pt_offset   ! time offset in units of timesteps 
    368283      ! 
    369284      LOGICAL  ::   lk_first_btstp            ! =.TRUE. if time splitting and first barotropic step 
    370285      INTEGER  ::   itide, ib_bdy, ib, igrd   ! loop indices 
    371       INTEGER  ::   time_add                  ! time offset in units of timesteps 
    372286      INTEGER, DIMENSION(jpbgrd)   ::   ilen0  
    373287      INTEGER, DIMENSION(1:jpbgrd) ::   nblen, nblenrim  ! short cuts 
    374       REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist       
     288      REAL(wp) ::   z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset    
    375289      !!---------------------------------------------------------------------- 
    376290      ! 
     
    378292      IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF 
    379293 
    380       time_add = 0 
    381       IF( PRESENT(kt_offset) ) THEN 
    382          time_add = kt_offset 
    383       ENDIF 
     294      zt_offset = 0._wp 
     295      IF( PRESENT(pt_offset) )   zt_offset = pt_offset 
    384296       
    385297      ! Absolute time from model initialization:    
    386298      IF( PRESENT(kit) ) THEN   
    387          z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 
     299         z_arg = ( REAL(kt, wp) + ( REAL(kit, wp) + zt_offset - 1. ) / REAL(nn_baro, wp) ) * rdt 
    388300      ELSE                               
    389          z_arg = ( kt + time_add ) * rdt 
     301         z_arg = ( REAL(kt, wp) + zt_offset ) * rdt 
    390302      ENDIF 
    391303 
    392304      ! Linear ramp on tidal component at open boundaries  
    393305      zramp = 1. 
    394       IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - nit000*rdt)/(rdttideramp*rday),0.),1.) 
     306      IF (ln_tide_ramp) zramp = MIN(MAX( (z_arg - REAL(nit000,wp)*rdt)/(rn_tide_ramp_dt*rday),0.),1.) 
    395307 
    396308      DO ib_bdy = 1,nb_bdy 
     
    409321            IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 
    410322               ! 
    411                kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
     323               kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rdt)/rdt) 
    412324               ! 
    413325               IF(lwp) THEN 
     
    421333               ! 
    422334            ENDIF 
    423             zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time 
     335            zoff = REAL(-kt_tide,wp) * rdt ! time offset relative to nodal factor computation time 
    424336            ! 
    425337            ! If time splitting, initialize arrays from slow varying open boundary data: 
     
    433345            DO itide = 1, nb_harmo 
    434346               ! 
    435                z_sarg = (z_arg + zoff) * omega_tide(itide) 
     347               z_sarg = (z_arg + zoff) * tide_harmonics(itide)%omega 
    436348               z_cost = zramp * COS( z_sarg ) 
    437349               z_sist = zramp * SIN( z_sarg ) 
     
    491403         END DO 
    492404         DO ib = 1 , ilen0(igrd) 
    493             mod_tide(ib)=mod_tide(ib)*ftide(itide) 
    494             phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 
     405            mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     406            phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 
    495407         ENDDO 
    496408         DO ib = 1 , ilen0(igrd) 
     
    530442         END DO 
    531443         DO ib = 1, ilen0(igrd) 
    532             mod_tide(ib)=mod_tide(ib)*ftide(itide) 
    533             phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 
     444            mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     445            phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    534446         ENDDO 
    535447         DO ib = 1, ilen0(igrd) 
     
    551463         END DO 
    552464         DO ib = 1, ilen0(igrd) 
    553             mod_tide(ib)=mod_tide(ib)*ftide(itide) 
    554             phi_tide(ib)=phi_tide(ib)+v0tide(itide)+utide(itide) 
     465            mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 
     466            phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 
    555467         ENDDO 
    556468         DO ib = 1, ilen0(igrd) 
  • NEMO/trunk/src/OCE/BDY/bdytra.F90

    r11536 r12377  
    4040CONTAINS 
    4141 
    42    SUBROUTINE bdy_tra( kt ) 
     42   SUBROUTINE bdy_tra( kt, Kbb, pts, Kaa ) 
    4343      !!---------------------------------------------------------------------- 
    4444      !!                  ***  SUBROUTINE bdy_tra  *** 
     
    4747      !! 
    4848      !!---------------------------------------------------------------------- 
    49       INTEGER, INTENT(in) ::   kt   ! Main time step counter 
     49      INTEGER                                  , INTENT(in)    :: kt        ! Main time step counter 
     50      INTEGER                                  , INTENT(in)    :: Kbb, Kaa  ! time level indices 
     51      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! tracer fields 
    5052      ! 
    5153      INTEGER                        :: ib_bdy, jn, igrd, ir   ! Loop indeces 
     
    7072               CASE('none'        )   ;   CYCLE 
    7173               CASE('frs'         )   ! treat the whole boundary at once 
    72                   IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     74                  IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), zdta(jn)%tra ) 
    7375               CASE('specified'   )   ! treat the whole rim      at once 
    74                   IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
    75                CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn), llrim0 )   ! tsa masked 
    76                CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), & 
     76                  IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), zdta(jn)%tra ) 
     77               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , pts(:,:,:,jn,Kaa), llrim0 )   ! tsa masked 
     78               CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), & 
    7779                    & zdta(jn)%tra, llrim0, ll_npo=.false. ) 
    78                CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), & 
     80               CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), & 
    7981                    & zdta(jn)%tra, llrim0, ll_npo=.true.  ) 
    80                CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), jn, llrim0 ) 
     82               CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), jn, llrim0 ) 
    8183               CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    8284               END SELECT 
     
    98100         END DO 
    99101         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    100             CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     102            CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    101103         END IF 
    102104         ! 
     
    106108 
    107109 
    108    SUBROUTINE bdy_rnf( idx, pta, jpa, llrim0 ) 
     110   SUBROUTINE bdy_rnf( idx, pt, jpa, llrim0 ) 
    109111      !!---------------------------------------------------------------------- 
    110112      !!                 ***  SUBROUTINE bdy_rnf  *** 
     
    116118      !!---------------------------------------------------------------------- 
    117119      TYPE(OBC_INDEX),                     INTENT(in) ::   idx      ! OBC indices 
    118       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta      ! tracer trend 
     120      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt       ! tracer trend 
    119121      INTEGER,                             INTENT(in) ::   jpa      ! TRA index 
    120122      LOGICAL,                             INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    121123      ! 
    122124      INTEGER  ::   ib, ii, ij, igrd   ! dummy loop indices 
    123       INTEGER  ::   ik, ip, jp ! 2D addresses 
    124125      !!---------------------------------------------------------------------- 
    125126      ! 
    126127      igrd = 1                       ! Everything is at T-points here 
    127128      IF(      jpa == jp_tem ) THEN 
    128          CALL bdy_nmn( idx, igrd, pta, llrim0 ) 
     129         CALL bdy_nmn( idx, igrd, pt, llrim0 ) 
    129130      ELSE IF( jpa == jp_sal ) THEN 
    130131         IF( .NOT. llrim0 )   RETURN 
     
    132133            ii = idx%nbi(ib,igrd) 
    133134            ij = idx%nbj(ib,igrd) 
    134             pta(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 
     135            pt(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 
    135136         END DO 
    136137      END IF 
     
    139140 
    140141 
    141    SUBROUTINE bdy_tra_dmp( kt ) 
     142   SUBROUTINE bdy_tra_dmp( kt, Kbb, pts, Krhs ) 
    142143      !!---------------------------------------------------------------------- 
    143144      !!                 ***  SUBROUTINE bdy_tra_dmp  *** 
     
    146147      !!  
    147148      !!---------------------------------------------------------------------- 
    148       INTEGER, INTENT(in) ::   kt   ! 
     149      INTEGER                                  , INTENT(in)    :: kt        ! time step 
     150      INTEGER                                  , INTENT(in)    :: Kbb, Krhs ! time level indices 
     151      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation 
    149152      ! 
    150153      REAL(wp) ::   zwgt           ! boundary weight 
     
    165168               zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 
    166169               DO ik = 1, jpkm1 
    167                   zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik) 
    168                   zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik) 
    169                   tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta 
    170                   tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa 
     170                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - pts(ii,ij,ik,jp_tem,Kbb) ) * tmask(ii,ij,ik) 
     171                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - pts(ii,ij,ik,jp_sal,Kbb) ) * tmask(ii,ij,ik) 
     172                  pts(ii,ij,ik,jp_tem,Krhs) = pts(ii,ij,ik,jp_tem,Krhs) + zta 
     173                  pts(ii,ij,ik,jp_sal,Krhs) = pts(ii,ij,ik,jp_sal,Krhs) + zsa 
    171174               END DO 
    172175            END DO 
  • NEMO/trunk/src/OCE/BDY/bdyvol.F90

    r12148 r12377  
    1414   USE bdy_oce        ! ocean open boundary conditions 
    1515   USE sbc_oce        ! ocean surface boundary conditions 
     16   USE isf_oce, ONLY : fwfisf_cav, fwfisf_par  ! ice shelf 
    1617   USE dom_oce        ! ocean space and time domain  
    1718   USE phycst         ! physical constants 
    18    USE sbcisf         ! ice shelf 
    1919   ! 
    2020   USE in_out_manager ! I/O manager 
     
    7777      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 
    7878      ! ----------------------------------------------------------------------- 
    79       IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0 
     79      IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0 
    8080 
    8181      ! Compute bdy surface each cycle if non linear free surface 
Note: See TracChangeset for help on using the changeset viewer.