Changeset 12377 for NEMO/trunk/src/OCE/BDY
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/BDY/bdy_oce.F90
r11536 r12377 141 141 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lsend_bdyext !: mark needed communication for given boundary, grid and neighbour 142 142 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lrecv_bdyext !: when searching towards the exterior of the computational domain 143 !! * Substitutions 144 # include "do_loop_substitute.h90" 143 145 !!---------------------------------------------------------------------- 144 146 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/OCE/BDY/bdydta.F90
r12049 r12377 23 23 USE phycst ! physical constants 24 24 USE sbcapr ! atmospheric pressure forcing 25 USE sbctide ! Tidal forcing or not25 USE tide_mod, ONLY: ln_tide ! tidal forcing 26 26 USE bdy_oce ! ocean open boundary conditions 27 27 USE bdytides ! tidal forcing at boundaries … … 68 68 !$AGRIF_END_DO_NOT_TREAT 69 69 70 !! * Substitutions 71 # include "do_loop_substitute.h90" 70 72 !!---------------------------------------------------------------------- 71 73 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 77 CONTAINS 76 78 77 SUBROUTINE bdy_dta( kt, kit, kt_offset)79 SUBROUTINE bdy_dta( kt, Kmm ) 78 80 !!---------------------------------------------------------------------- 79 81 !! *** SUBROUTINE bdy_dta *** … … 85 87 !!---------------------------------------------------------------------- 86 88 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 94 90 ! 95 91 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices … … 105 101 ! Initialise data arrays once for all from initial conditions where required 106 102 !--------------------------------------------------------------------------- 107 IF( kt == nit000 .AND. .NOT.PRESENT(kit)) THEN103 IF( kt == nit000 ) THEN 108 104 109 105 ! Calculate depth-mean currents … … 122 118 ii = idx_bdy(jbdy)%nbi(ib,igrd) 123 119 ij = idx_bdy(jbdy)%nbj(ib,igrd) 124 dta_bdy(jbdy)%ssh(ib) = ssh n(ii,ij) * tmask(ii,ij,1)120 dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1) 125 121 END DO 126 122 ENDIF … … 130 126 ii = idx_bdy(jbdy)%nbi(ib,igrd) 131 127 ij = idx_bdy(jbdy)%nbj(ib,igrd) 132 dta_bdy(jbdy)%u2d(ib) = u n_b(ii,ij) * umask(ii,ij,1)128 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 133 129 END DO 134 130 igrd = 3 … … 136 132 ii = idx_bdy(jbdy)%nbi(ib,igrd) 137 133 ij = idx_bdy(jbdy)%nbj(ib,igrd) 138 dta_bdy(jbdy)%v2d(ib) = v n_b(ii,ij) * vmask(ii,ij,1)134 dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1) 139 135 END DO 140 136 ENDIF … … 149 145 ii = idx_bdy(jbdy)%nbi(ib,igrd) 150 146 ij = idx_bdy(jbdy)%nbj(ib,igrd) 151 dta_bdy(jbdy)%u3d(ib,ik) = ( u n(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) 152 148 END DO 153 149 END DO … … 157 153 ii = idx_bdy(jbdy)%nbi(ib,igrd) 158 154 ij = idx_bdy(jbdy)%nbj(ib,igrd) 159 dta_bdy(jbdy)%v3d(ib,ik) = ( v n(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) 160 156 END DO 161 157 END DO … … 171 167 ii = idx_bdy(jbdy)%nbi(ib,igrd) 172 168 ij = idx_bdy(jbdy)%nbj(ib,igrd) 173 dta_bdy(jbdy)%tem(ib,ik) = ts n(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)174 dta_bdy(jbdy)%sal(ib,ik) = ts n(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) 175 171 END DO 176 172 END DO … … 216 212 ! read/update all bdy data 217 213 ! ------------------------ 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 ) 220 216 ! apply some corrections in some specific cases... 221 217 ! -------------------------------------------------- … … 254 250 ij = idx_bdy(jbdy)%nbj(ib,igrd) 255 251 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) 257 253 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) 259 255 DO ik = 1, jpkm1 ! compute barocline zonal velocity and put it in u3d 260 256 dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib) … … 267 263 ij = idx_bdy(jbdy)%nbj(ib,igrd) 268 264 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) 270 266 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) 272 268 DO ik = 1, jpkm1 ! compute barocline meridional velocity and put it in v3d 273 269 dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib) … … 275 271 END DO 276 272 ENDIF ! ltotvel 277 278 ! update tidal harmonic forcing279 IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN280 CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy), &281 & kit = kit, kt_offset = kt_offset )282 ENDIF283 273 284 274 ! atm surface pressure : add inverted barometer effect to ssh if it was read … … 343 333 nblen => idx_bdy(jbdy)%nblen 344 334 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 ) 355 347 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 360 353 361 354 … … 373 366 INTEGER :: ierror, ios ! 374 367 ! 368 INTEGER :: nbdy_rdstart, nbdy_loc 369 CHARACTER(LEN=50) :: cerrmsg ! error string 375 370 CHARACTER(len=3) :: cl3 ! 376 371 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files … … 415 410 ! Read namelists 416 411 ! -------------- 417 REWIND(numnam_cfg)412 nbdy_rdstart = 1 418 413 DO jbdy = 1, nb_bdy 419 414 … … 421 416 WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy 422 417 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 425 419 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 426 420 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' ) … … 431 425 & .OR. ( dta_bdy(jbdy)%lneed_tra .AND. nn_tra_dta(jbdy) == 1 ) & 432 426 & .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) 435 442 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' ) 436 443 IF(lwm) WRITE( numond, nambdy_dta ) … … 442 449 IF( nn_ice_dta(jbdy) == 1 ) THEN ! if we get ice bdy data from netcdf file 443 450 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 ) 445 453 idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 446 454 IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN ; ipl = i4dimsz(3) ! xylt or xyl 447 455 ELSE ; ipl = 1 ! xy or xyt 448 456 ENDIF 457 CALL iom_close( bf(jp_bdya_i,jbdy)%num ) 449 458 bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED' ! reset to default value as this subdomain may not need to read this bdy 450 459 ENDIF -
NEMO/trunk/src/OCE/BDY/bdydyn.F90
r10068 r12377 37 37 CONTAINS 38 38 39 SUBROUTINE bdy_dyn( kt, dyn3d_only )39 SUBROUTINE bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only ) 40 40 !!---------------------------------------------------------------------- 41 41 !! *** SUBROUTINE bdy_dyn *** … … 44 44 !! 45 45 !!---------------------------------------------------------------------- 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 48 50 ! 49 51 INTEGER :: jk, ii, ij, ib_bdy, ib, igrd ! Loop counter 50 52 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 51 REAL(wp), DIMENSION(jpi,jpj) :: pua2d, pva2d ! after barotropic velocities53 REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d ! after barotropic velocities 52 54 !!---------------------------------------------------------------------- 53 55 ! … … 70 72 71 73 ! ! "After" velocities: 72 pua2d(:,:) = 0._wp73 pva2d(:,:) = 0._wp74 zua2d(:,:) = 0._wp 75 zva2d(:,:) = 0._wp 74 76 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) 77 79 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) 80 82 81 83 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) 84 86 END DO 85 87 … … 87 89 IF( ll_orlanski ) THEN ! "Before" velocities (Orlanski condition only) 88 90 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) 91 93 END DO 92 94 ENDIF … … 97 99 !------------------------------------------------------- 98 100 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) ) 100 102 101 IF( ll_dyn3d ) CALL bdy_dyn3d( kt )103 IF( ll_dyn3d ) CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 102 104 103 105 !------------------------------------------------------- … … 106 108 ! 107 109 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) 110 112 END DO 111 113 ! 112 114 IF ( ll_orlanski ) THEN 113 115 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) 116 118 END DO 117 119 END IF -
NEMO/trunk/src/OCE/BDY/bdydyn3d.F90
r11536 r12377 33 33 CONTAINS 34 34 35 SUBROUTINE bdy_dyn3d( kt )35 SUBROUTINE bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 36 36 !!---------------------------------------------------------------------- 37 37 !! *** SUBROUTINE bdy_dyn3d *** … … 40 40 !! 41 41 !!---------------------------------------------------------------------- 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) 43 45 ! 44 46 INTEGER :: ib_bdy, ir ! BDY set index, rim index … … 58 60 CASE('none') ; CYCLE 59 61 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 ) 61 63 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 ) 63 65 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 ) 69 71 CASE DEFAULT ; CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 70 72 END SELECT … … 97 99 ! 98 100 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 ) 100 102 END IF 101 103 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 ) 103 105 END IF 104 106 END DO ! ir … … 107 109 108 110 109 SUBROUTINE bdy_dyn3d_spe( idx, dta, kt, ib_bdy )111 SUBROUTINE bdy_dyn3d_spe( puu, pvv, Kaa, idx, dta, kt, ib_bdy ) 110 112 !!---------------------------------------------------------------------- 111 113 !! *** SUBROUTINE bdy_dyn3d_spe *** … … 115 117 !! 116 118 !!---------------------------------------------------------------------- 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 121 125 ! 122 126 INTEGER :: jb, jk ! dummy loop indices … … 129 133 ii = idx%nbi(jb,igrd) 130 134 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) 132 136 END DO 133 137 END DO … … 138 142 ii = idx%nbi(jb,igrd) 139 143 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) 141 145 END DO 142 146 END DO … … 145 149 146 150 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 ) 148 152 !!---------------------------------------------------------------------- 149 153 !! *** SUBROUTINE bdy_dyn3d_zgrad *** … … 152 156 !! 153 157 !!---------------------------------------------------------------------- 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 159 165 !! 160 166 INTEGER :: jb, jk ! dummy loop indices … … 178 184 ! 179 185 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) 181 187 END DO 182 188 ! … … 198 204 ! 199 205 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) 201 207 END DO 202 208 ! … … 207 213 208 214 209 SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy )215 SUBROUTINE bdy_dyn3d_zro( puu, pvv, Kaa, idx, dta, kt, ib_bdy ) 210 216 !!---------------------------------------------------------------------- 211 217 !! *** SUBROUTINE bdy_dyn3d_zro *** … … 214 220 !! 215 221 !!---------------------------------------------------------------------- 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 220 228 ! 221 229 INTEGER :: ib, ik ! dummy loop indices … … 228 236 ij = idx%nbj(ib,igrd) 229 237 DO ik = 1, jpkm1 230 ua(ii,ij,ik) = 0._wp238 puu(ii,ij,ik,Kaa) = 0._wp 231 239 END DO 232 240 END DO … … 237 245 ij = idx%nbj(ib,igrd) 238 246 DO ik = 1, jpkm1 239 va(ii,ij,ik) = 0._wp247 pvv(ii,ij,ik,Kaa) = 0._wp 240 248 END DO 241 249 END DO … … 244 252 245 253 246 SUBROUTINE bdy_dyn3d_frs( idx, dta, kt, ib_bdy )254 SUBROUTINE bdy_dyn3d_frs( puu, pvv, Kaa, idx, dta, kt, ib_bdy ) 247 255 !!---------------------------------------------------------------------- 248 256 !! *** SUBROUTINE bdy_dyn3d_frs *** … … 255 263 !! topography. Tellus, 365-382. 256 264 !!---------------------------------------------------------------------- 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 261 271 ! 262 272 INTEGER :: jb, jk ! dummy loop indices … … 271 281 ij = idx%nbj(jb,igrd) 272 282 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) 274 284 END DO 275 285 END DO … … 281 291 ij = idx%nbj(jb,igrd) 282 292 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) 284 294 END DO 285 295 END DO … … 288 298 289 299 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 ) 291 301 !!---------------------------------------------------------------------- 292 302 !! *** SUBROUTINE bdy_dyn3d_orlanski *** … … 298 308 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 299 309 !!---------------------------------------------------------------------- 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 305 317 306 318 INTEGER :: jb, igrd ! dummy loop indices 307 319 !!---------------------------------------------------------------------- 308 320 ! 309 !! Note that at this stage the ub and uaarrays contain the baroclinic velocities.321 !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities. 310 322 ! 311 323 igrd = 2 ! Orlanski bc on u-velocity; 312 324 ! 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 ) 314 326 315 327 igrd = 3 ! Orlanski bc on v-velocity 316 328 ! 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 ) 318 330 ! 319 331 END SUBROUTINE bdy_dyn3d_orlanski 320 332 321 333 322 SUBROUTINE bdy_dyn3d_dmp( kt )334 SUBROUTINE bdy_dyn3d_dmp( kt, Kbb, puu, pvv, Krhs ) 323 335 !!---------------------------------------------------------------------- 324 336 !! *** SUBROUTINE bdy_dyn3d_dmp *** … … 327 339 !! 328 340 !!---------------------------------------------------------------------- 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) 330 344 ! 331 345 INTEGER :: jb, jk ! dummy loop indices … … 345 359 zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 346 360 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) 349 363 END DO 350 364 END DO … … 356 370 zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 357 371 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) 360 374 END DO 361 375 END DO … … 368 382 369 383 370 SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy, llrim0 )384 SUBROUTINE bdy_dyn3d_nmn( puu, pvv, Kaa, idx, ib_bdy, llrim0 ) 371 385 !!---------------------------------------------------------------------- 372 386 !! *** SUBROUTINE bdy_dyn3d_nmn *** … … 377 391 !! 378 392 !!---------------------------------------------------------------------- 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 382 398 INTEGER :: igrd ! dummy indice 383 399 !!---------------------------------------------------------------------- 384 400 ! 385 !! Note that at this stage the ub and uaarrays contain the baroclinic velocities.401 !! Note that at this stage the puu(:,:,:,Kbb) and puu(:,:,:,Kaa) arrays contain the baroclinic velocities. 386 402 ! 387 403 igrd = 2 ! Neumann bc on u-velocity; 388 404 ! 389 CALL bdy_nmn( idx, igrd, ua, llrim0 ) ! ua is masked405 CALL bdy_nmn( idx, igrd, puu(:,:,:,Kaa), llrim0 ) 390 406 391 407 igrd = 3 ! Neumann bc on v-velocity 392 408 ! 393 CALL bdy_nmn( idx, igrd, va, llrim0 ) ! va is masked409 CALL bdy_nmn( idx, igrd, pvv(:,:,:,Kaa), llrim0 ) 394 410 ! 395 411 END SUBROUTINE bdy_dyn3d_nmn -
NEMO/trunk/src/OCE/BDY/bdyini.F90
r12142 r12377 22 22 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 23 23 USE bdytides ! open boundary cond. setting (bdytide_init routine) 24 USE sbctide ! Tidal forcing or not24 USE tide_mod, ONLY: ln_tide ! tidal forcing 25 25 USE phycst , ONLY: rday 26 26 ! … … 75 75 ! Read namelist parameters 76 76 ! ------------------------ 77 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist :Unstructured open boundaries78 77 READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 901) 79 78 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist' ) … … 93 92 cn_ice (2:jp_bdy) = cn_ice (1) 94 93 nn_ice_dta (2:jp_bdy) = nn_ice_dta (1) 95 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist :Unstructured open boundaries96 94 READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 902 ) 97 95 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist' ) … … 364 362 ! ------------------------------------------------- 365 363 366 REWIND( numnam_cfg )367 364 nblendta(:,:) = 0 368 365 nbdysege = 0 … … 1080 1077 INTEGER :: ios ! Local integer output status for namelist read 1081 1078 INTEGER :: nbdyind, nbdybeg, nbdyend 1079 INTEGER :: nbdy_count, nbdy_rdstart, nbdy_loc 1082 1080 CHARACTER(LEN=1) :: ctypebdy ! - - 1081 CHARACTER(LEN=50):: cerrmsg ! - - 1083 1082 NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 1084 1083 !!---------------------------------------------------------------------- 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) 1090 1101 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_index in configuration namelist' ) 1091 1102 IF(lwm) WRITE ( numond, nambdy_index ) -
NEMO/trunk/src/OCE/BDY/bdylib.F90
r11536 r12377 35 35 CONTAINS 36 36 37 SUBROUTINE bdy_frs( idx, p ta, dta )37 SUBROUTINE bdy_frs( idx, phia, dta ) 38 38 !!---------------------------------------------------------------------- 39 39 !! *** SUBROUTINE bdy_frs *** … … 45 45 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 46 46 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 47 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p ta ! tracer trend47 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 48 48 !! 49 49 REAL(wp) :: zwgt ! boundary weight … … 58 58 ij = idx%nbj(ib,igrd) 59 59 zwgt = idx%nbw(ib,igrd) 60 p ta(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) 61 61 END DO 62 62 END DO … … 65 65 66 66 67 SUBROUTINE bdy_spe( idx, p ta, dta )67 SUBROUTINE bdy_spe( idx, phia, dta ) 68 68 !!---------------------------------------------------------------------- 69 69 !! *** SUBROUTINE bdy_spe *** … … 74 74 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 75 75 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 76 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p ta ! tracer trend76 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 77 77 !! 78 78 INTEGER :: ib, ik, igrd ! dummy loop indices … … 85 85 ij = idx%nbj(ib,igrd) 86 86 DO ik = 1, jpkm1 87 p ta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik)87 phia(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 88 88 END DO 89 89 END DO … … 92 92 93 93 94 SUBROUTINE bdy_orl( idx, p tb, pta, dta, lrim0, ll_npo )94 SUBROUTINE bdy_orl( idx, phib, phia, dta, lrim0, ll_npo ) 95 95 !!---------------------------------------------------------------------- 96 96 !! *** SUBROUTINE bdy_orl *** … … 102 102 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 103 103 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 104 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p tb ! before tracer field105 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: p ta ! tracer trend104 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phib ! before tracer field 105 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 106 106 LOGICAL , OPTIONAL, INTENT(in) :: lrim0 ! indicate if rim 0 is treated 107 107 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version … … 112 112 igrd = 1 ! Everything is at T-points here 113 113 ! 114 CALL bdy_orlanski_3d( idx, igrd, p tb(:,:,:), pta(:,:,:), dta, lrim0, ll_npo )114 CALL bdy_orlanski_3d( idx, igrd, phib(:,:,:), phia(:,:,:), dta, lrim0, ll_npo ) 115 115 ! 116 116 END SUBROUTINE bdy_orl -
NEMO/trunk/src/OCE/BDY/bdytides.F90
r11536 r12377 18 18 USE phycst ! physical constants 19 19 USE bdy_oce ! ocean open boundary conditions 20 USE tide ini!20 USE tide_mod ! 21 21 USE daymod ! calendar 22 22 ! … … 30 30 31 31 PUBLIC bdytide_init ! routine called in bdy_init 32 PUBLIC bdytide_update ! routine called in bdy_dta33 32 PUBLIC bdy_dta_tides ! routine called in dyn_spg_ts 34 33 … … 45 44 TYPE(OBC_DATA) , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component) 46 45 46 INTEGER :: kt_tide 47 48 !! * Substitutions 49 # include "do_loop_substitute.h90" 47 50 !!---------------------------------------------------------------------- 48 51 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 64 67 CHARACTER(len=80) :: filtide !: Filename root for tidal input files 65 68 LOGICAL :: ln_bdytide_2ddta !: If true, read 2d harmonic data 66 LOGICAL :: ln_bdytide_conj !: If true, assume complex conjugate tidal data67 69 !! 68 70 INTEGER :: ib_bdy, itide, ib !: dummy loop indices … … 71 73 INTEGER, DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays) 72 74 INTEGER :: ios ! Local integer output status for namelist read 75 INTEGER :: nbdy_rdstart, nbdy_loc 76 CHARACTER(LEN=50) :: cerrmsg !: error string 73 77 CHARACTER(len=80) :: clfile !: full file name for tidal input file 74 78 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read !: work space to read in tidal harmonics data … … 77 81 TYPE(TIDES_DATA), POINTER :: td !: local short cut 78 82 !! 79 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta , ln_bdytide_conj83 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta 80 84 !!---------------------------------------------------------------------- 81 85 ! … … 84 88 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 85 89 86 REWIND(numnam_cfg) 87 90 91 nbdy_rdstart = 1 88 92 DO ib_bdy = 1, nb_bdy 89 93 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN … … 94 98 filtide(:) = '' 95 99 96 REWIND( numnam_ref )97 100 READ ( numnam_ref, nambdy_tide, IOSTAT = ios, ERR = 901) 98 101 901 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) 101 117 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_tide in configuration namelist' ) 102 118 IF(lwm) WRITE ( numond, nambdy_tide ) … … 105 121 IF(lwp) WRITE(numout,*) ' Namelist nambdy_tide : tidal harmonic forcing at open boundaries' 106 122 IF(lwp) WRITE(numout,*) ' read tidal data in 2d files: ', ln_bdytide_2ddta 107 IF(lwp) WRITE(numout,*) ' assume complex conjugate : ', ln_bdytide_conj108 123 IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo 109 124 IF(lwp) THEN 110 125 WRITE(numout,*) ' Tidal components: ' 111 126 DO itide = 1, nb_harmo 112 WRITE(numout,*) ' ', Wave(ntide(itide))%cname_tide127 WRITE(numout,*) ' ', tide_harmonics(itide)%cname_tide 113 128 END DO 114 129 ENDIF … … 151 166 igrd = 1 ! Everything is at T-points here 152 167 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(:,:) ) 155 170 DO ib = 1, ilen0(igrd) 156 171 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 168 183 igrd = 2 ! Everything is at U-points here 169 184 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(:,:) ) 172 187 DO ib = 1, ilen0(igrd) 173 188 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 185 200 igrd = 3 ! Everything is at V-points here 186 201 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(:,:) ) 189 204 DO ib = 1, ilen0(igrd) 190 205 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 210 225 DO itide = 1, nb_harmo 211 226 ! ! 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' 213 228 CALL iom_open( clfile, inum ) 214 229 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) … … 218 233 CALL iom_close( inum ) 219 234 ! ! 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' 221 236 CALL iom_open( clfile, inum ) 222 237 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) … … 226 241 CALL iom_close( inum ) 227 242 ! ! 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' 229 244 CALL iom_open( clfile, inum ) 230 245 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) … … 240 255 ENDIF ! ln_bdytide_2ddta=.true. 241 256 ! 242 IF( ln_bdytide_conj ) THEN ! assume complex conjugate in data files243 td%ssh0(:,:,2) = - td%ssh0(:,:,2)244 td%u0 (:,:,2) = - td%u0 (:,:,2)245 td%v0 (:,:,2) = - td%v0 (:,:,2)246 ENDIF247 !248 257 ! Allocate slow varying data in the case of time splitting: 249 258 ! Do it anyway because at this stage knowledge of free surface scheme is unknown … … 262 271 263 272 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 ) 354 274 !!---------------------------------------------------------------------- 355 275 !! *** SUBROUTINE bdy_dta_tides *** … … 360 280 INTEGER, INTENT(in) :: kt ! Main timestep counter 361 281 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 368 283 ! 369 284 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 370 285 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices 371 INTEGER :: time_add ! time offset in units of timesteps372 286 INTEGER, DIMENSION(jpbgrd) :: ilen0 373 287 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 375 289 !!---------------------------------------------------------------------- 376 290 ! … … 378 292 IF ( PRESENT(kit).AND.( kit /= 1 ) ) THEN ; lk_first_btstp=.FALSE. ; ENDIF 379 293 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 384 296 385 297 ! Absolute time from model initialization: 386 298 IF( PRESENT(kit) ) THEN 387 z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt299 z_arg = ( REAL(kt, wp) + ( REAL(kit, wp) + zt_offset - 1. ) / REAL(nn_baro, wp) ) * rdt 388 300 ELSE 389 z_arg = ( kt + time_add) * rdt301 z_arg = ( REAL(kt, wp) + zt_offset ) * rdt 390 302 ENDIF 391 303 392 304 ! Linear ramp on tidal component at open boundaries 393 305 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.) 395 307 396 308 DO ib_bdy = 1,nb_bdy … … 409 321 IF ( ( nsec_day == NINT(0.5_wp * rdt) .OR. kt==nit000 ) .AND. lk_first_btstp ) THEN 410 322 ! 411 kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt323 kt_tide = kt - NINT((REAL(nsec_day,wp) - 0.5_wp * rdt)/rdt) 412 324 ! 413 325 IF(lwp) THEN … … 421 333 ! 422 334 ENDIF 423 zoff = -kt_tide* rdt ! time offset relative to nodal factor computation time335 zoff = REAL(-kt_tide,wp) * rdt ! time offset relative to nodal factor computation time 424 336 ! 425 337 ! If time splitting, initialize arrays from slow varying open boundary data: … … 433 345 DO itide = 1, nb_harmo 434 346 ! 435 z_sarg = (z_arg + zoff) * omega_tide(itide)347 z_sarg = (z_arg + zoff) * tide_harmonics(itide)%omega 436 348 z_cost = zramp * COS( z_sarg ) 437 349 z_sist = zramp * SIN( z_sarg ) … … 491 403 END DO 492 404 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 495 407 ENDDO 496 408 DO ib = 1 , ilen0(igrd) … … 530 442 END DO 531 443 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 534 446 ENDDO 535 447 DO ib = 1, ilen0(igrd) … … 551 463 END DO 552 464 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 555 467 ENDDO 556 468 DO ib = 1, ilen0(igrd) -
NEMO/trunk/src/OCE/BDY/bdytra.F90
r11536 r12377 40 40 CONTAINS 41 41 42 SUBROUTINE bdy_tra( kt )42 SUBROUTINE bdy_tra( kt, Kbb, pts, Kaa ) 43 43 !!---------------------------------------------------------------------- 44 44 !! *** SUBROUTINE bdy_tra *** … … 47 47 !! 48 48 !!---------------------------------------------------------------------- 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 50 52 ! 51 53 INTEGER :: ib_bdy, jn, igrd, ir ! Loop indeces … … 70 72 CASE('none' ) ; CYCLE 71 73 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 ) 73 75 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 masked76 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), & 77 79 & 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), & 79 81 & 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 ) 81 83 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 82 84 END SELECT … … 98 100 END DO 99 101 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 ) 101 103 END IF 102 104 ! … … 106 108 107 109 108 SUBROUTINE bdy_rnf( idx, pt a, jpa, llrim0 )110 SUBROUTINE bdy_rnf( idx, pt, jpa, llrim0 ) 109 111 !!---------------------------------------------------------------------- 110 112 !! *** SUBROUTINE bdy_rnf *** … … 116 118 !!---------------------------------------------------------------------- 117 119 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 118 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt a! tracer trend120 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt ! tracer trend 119 121 INTEGER, INTENT(in) :: jpa ! TRA index 120 122 LOGICAL, INTENT(in) :: llrim0 ! indicate if rim 0 is treated 121 123 ! 122 124 INTEGER :: ib, ii, ij, igrd ! dummy loop indices 123 INTEGER :: ik, ip, jp ! 2D addresses124 125 !!---------------------------------------------------------------------- 125 126 ! 126 127 igrd = 1 ! Everything is at T-points here 127 128 IF( jpa == jp_tem ) THEN 128 CALL bdy_nmn( idx, igrd, pt a, llrim0 )129 CALL bdy_nmn( idx, igrd, pt, llrim0 ) 129 130 ELSE IF( jpa == jp_sal ) THEN 130 131 IF( .NOT. llrim0 ) RETURN … … 132 133 ii = idx%nbi(ib,igrd) 133 134 ij = idx%nbj(ib,igrd) 134 pt a(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1)135 pt(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 135 136 END DO 136 137 END IF … … 139 140 140 141 141 SUBROUTINE bdy_tra_dmp( kt )142 SUBROUTINE bdy_tra_dmp( kt, Kbb, pts, Krhs ) 142 143 !!---------------------------------------------------------------------- 143 144 !! *** SUBROUTINE bdy_tra_dmp *** … … 146 147 !! 147 148 !!---------------------------------------------------------------------- 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 149 152 ! 150 153 REAL(wp) :: zwgt ! boundary weight … … 165 168 zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 166 169 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) + zta170 tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa170 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 171 174 END DO 172 175 END DO -
NEMO/trunk/src/OCE/BDY/bdyvol.F90
r12148 r12377 14 14 USE bdy_oce ! ocean open boundary conditions 15 15 USE sbc_oce ! ocean surface boundary conditions 16 USE isf_oce, ONLY : fwfisf_cav, fwfisf_par ! ice shelf 16 17 USE dom_oce ! ocean space and time domain 17 18 USE phycst ! physical constants 18 USE sbcisf ! ice shelf19 19 ! 20 20 USE in_out_manager ! I/O manager … … 77 77 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 78 78 ! ----------------------------------------------------------------------- 79 IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf (:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau079 IF ( kc == 1 ) z_cflxemp = glob_sum( 'bdyvol', ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 80 80 81 81 ! Compute bdy surface each cycle if non linear free surface
Note: See TracChangeset
for help on using the changeset viewer.