Changeset 12377 for NEMO/trunk/src/OCE/BDY/bdydta.F90
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 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/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
Note: See TracChangeset
for help on using the changeset viewer.