- Timestamp:
- 2017-05-23T10:32:39+02:00 (7 years ago)
- Location:
- branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY
- Files:
-
- 7 edited
-
bdy_oce.F90 (modified) (1 diff)
-
bdydta.F90 (modified) (1 diff)
-
bdydyn3d.F90 (modified) (3 diffs)
-
bdyini.F90 (modified) (2 diffs)
-
bdylib.F90 (modified) (3 diffs)
-
bdytides.F90 (modified) (4 diffs)
-
bdytra.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r8058 r8059 71 71 REAL, POINTER, DIMENSION(:,:) :: ht_s !: now snow thickness 72 72 #endif 73 #if defined key_top 74 CHARACTER(LEN=20) :: cn_obc !: type of boundary condition to apply 75 REAL(wp) :: rn_fac !: multiplicative scaling factor 76 REAL(wp), POINTER, DIMENSION(:,:) :: trc !: now field of the tracer 77 LOGICAL :: dmp !: obc damping term 78 #endif 79 73 80 END TYPE OBC_DATA 74 81 -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r8058 r8059 37 37 #endif 38 38 USE sbcapr 39 #if defined key_top 40 USE par_trc 41 USE trc, ONLY: trn 42 #endif 39 43 40 44 IMPLICIT NONE -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r8058 r8059 61 61 CASE('zero') 62 62 CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 63 CASE('zerograd') 64 CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 65 CASE('neumann') 66 CALL bdy_dyn3d_nmn( idx_bdy(ib_bdy), ib_bdy ) 63 67 CASE('orlanski') 64 68 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) … … 117 121 118 122 END SUBROUTINE bdy_dyn3d_spe 123 124 SUBROUTINE bdy_dyn3d_zgrad( idx, dta, kt , ib_bdy ) 125 !!---------------------------------------------------------------------- 126 !! *** SUBROUTINE bdy_dyn3d_zgrad *** 127 !! 128 !! ** Purpose : - Enforce a zero gradient of normal velocity 129 !! 130 !!---------------------------------------------------------------------- 131 INTEGER :: kt 132 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 133 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 134 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 135 !! 136 INTEGER :: jb, jk ! dummy loop indices 137 INTEGER :: ii, ij, igrd ! local integers 138 REAL(wp) :: zwgt ! boundary weight 139 INTEGER :: fu, fv 140 !!---------------------------------------------------------------------- 141 ! 142 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_zgrad') 143 ! 144 igrd = 2 ! Copying tangential velocity into bdy points 145 DO jb = 1, idx%nblenrim(igrd) 146 DO jk = 1, jpkm1 147 ii = idx%nbi(jb,igrd) 148 ij = idx%nbj(jb,igrd) 149 fu = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 150 ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 151 &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 152 END DO 153 END DO 154 ! 155 igrd = 3 ! Copying tangential velocity into bdy points 156 DO jb = 1, idx%nblenrim(igrd) 157 DO jk = 1, jpkm1 158 ii = idx%nbi(jb,igrd) 159 ij = idx%nbj(jb,igrd) 160 fv = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 161 va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 162 &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 163 END DO 164 END DO 165 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 166 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 167 ! 168 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 169 170 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_zgrad') 171 172 END SUBROUTINE bdy_dyn3d_zgrad 119 173 120 174 SUBROUTINE bdy_dyn3d_zro( idx, dta, kt, ib_bdy ) … … 303 357 END SUBROUTINE bdy_dyn3d_dmp 304 358 359 SUBROUTINE bdy_dyn3d_nmn( idx, ib_bdy ) 360 !!---------------------------------------------------------------------- 361 !! *** SUBROUTINE bdy_dyn3d_nmn *** 362 !! 363 !! - Apply Neumann condition to baroclinic velocities. 364 !! - Wrapper routine for bdy_nmn 365 !! 366 !! 367 !!---------------------------------------------------------------------- 368 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 369 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 370 371 INTEGER :: jb, igrd ! dummy loop indices 372 !!---------------------------------------------------------------------- 373 374 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_nmn') 375 ! 376 !! Note that at this stage the ub and ua arrays contain the baroclinic velocities. 377 ! 378 igrd = 2 ! Neumann bc on u-velocity; 379 ! 380 CALL bdy_nmn( idx, igrd, ua ) 381 382 igrd = 3 ! Neumann bc on v-velocity 383 ! 384 CALL bdy_nmn( idx, igrd, va ) 385 ! 386 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 387 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 388 ! 389 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_nmn') 390 ! 391 END SUBROUTINE bdy_dyn3d_nmn 392 393 305 394 #else 306 395 !!---------------------------------------------------------------------- -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r8058 r8059 213 213 dta_bdy(ib_bdy)%ll_u3d = .true. 214 214 dta_bdy(ib_bdy)%ll_v3d = .true. 215 CASE('neumann') 216 IF(lwp) WRITE(numout,*) ' Neumann conditions' 217 dta_bdy(ib_bdy)%ll_u3d = .false. 218 dta_bdy(ib_bdy)%ll_v3d = .false. 219 CASE('zerograd') 220 IF(lwp) WRITE(numout,*) ' Zero gradient for baroclinic velocities' 221 dta_bdy(ib_bdy)%ll_u3d = .false. 222 dta_bdy(ib_bdy)%ll_v3d = .false. 215 223 CASE('zero') 216 224 IF(lwp) WRITE(numout,*) ' Zero baroclinic velocities (runoff case)' … … 1087 1095 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 1088 1096 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 1089 idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 ) ! tanh formulation 1097 idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) * 0.5 & 1098 & *(10./ FLOAT(nn_rimwidth(ib_bdy))) ) ! JGraham:modified for rim=15 1099 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = 1.- TANH( FLOAT( nbr - 1 ) *0.5 ) ! tanh formulation 1090 1100 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic 1091 1101 ! idx_bdy(ib_bdy)%nbw(ib,igrd) = FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)) ! linear -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
r8058 r8059 26 26 PUBLIC bdy_orlanski_2d ! routine called where? 27 27 PUBLIC bdy_orlanski_3d ! routine called where? 28 PUBLIC bdy_nmn ! routine called where? 28 29 29 30 !!---------------------------------------------------------------------- … … 354 355 END SUBROUTINE bdy_orlanski_3d 355 356 357 SUBROUTINE bdy_nmn( idx, igrd, phia ) 358 !!---------------------------------------------------------------------- 359 !! *** SUBROUTINE bdy_nmn *** 360 !! 361 !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 362 !! 363 !!---------------------------------------------------------------------- 364 INTEGER, INTENT(in) :: igrd ! grid index 365 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated) 366 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 367 !! 368 REAL(wp) :: zcoef, zcoef1, zcoef2 369 REAL(wp), POINTER, DIMENSION(:,:,:) :: pmask ! land/sea mask for field 370 REAL(wp), POINTER, DIMENSION(:,:) :: bdypmask ! land/sea mask for field 371 INTEGER :: ib, ik ! dummy loop indices 372 INTEGER :: ii, ij, ip, jp ! 2D addresses 373 !!---------------------------------------------------------------------- 374 ! 375 IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 376 ! 377 SELECT CASE(igrd) 378 CASE(1) 379 pmask => tmask(:,:,:) 380 bdypmask => bdytmask(:,:) 381 CASE(2) 382 pmask => umask(:,:,:) 383 bdypmask => bdyumask(:,:) 384 CASE(3) 385 pmask => vmask(:,:,:) 386 bdypmask => bdyvmask(:,:) 387 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 388 END SELECT 389 DO ib = 1, idx%nblenrim(igrd) 390 ii = idx%nbi(ib,igrd) 391 ij = idx%nbj(ib,igrd) 392 DO ik = 1, jpkm1 393 ! search the sense of the gradient 394 zcoef1 = bdypmask(ii-1,ij )*pmask(ii-1,ij,ik) + bdypmask(ii+1,ij )*pmask(ii+1,ij,ik) 395 zcoef2 = bdypmask(ii ,ij-1)*pmask(ii,ij-1,ik) + bdypmask(ii ,ij+1)*pmask(ii,ij+1,ik) 396 IF ( nint(zcoef1+zcoef2) == 0) THEN 397 ! corner **** we probably only want to set the tangentail component for the dynamics here 398 zcoef = pmask(ii-1,ij,ik) + pmask(ii+1,ij,ik) + pmask(ii,ij-1,ik) + pmask(ii,ij+1,ik) 399 IF (zcoef > .5_wp) THEN ! Only set none isolated points. 400 phia(ii,ij,ik) = phia(ii-1,ij ,ik) * pmask(ii-1,ij ,ik) + & 401 & phia(ii+1,ij ,ik) * pmask(ii+1,ij ,ik) + & 402 & phia(ii ,ij-1,ik) * pmask(ii ,ij-1,ik) + & 403 & phia(ii ,ij+1,ik) * pmask(ii ,ij+1,ik) 404 phia(ii,ij,ik) = ( phia(ii,ij,ik) / zcoef ) * pmask(ii,ij,ik) 405 ELSE 406 phia(ii,ij,ik) = phia(ii,ij ,ik) * pmask(ii,ij ,ik) 407 ENDIF 408 ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 409 ! oblique corner **** we probably only want to set the normal component for the dynamics here 410 zcoef = pmask(ii-1,ij,ik)*bdypmask(ii-1,ij ) + pmask(ii+1,ij,ik)*bdypmask(ii+1,ij ) + & 411 & pmask(ii,ij-1,ik)*bdypmask(ii,ij -1 ) + pmask(ii,ij+1,ik)*bdypmask(ii,ij+1 ) 412 phia(ii,ij,ik) = phia(ii-1,ij ,ik) * pmask(ii-1,ij ,ik)*bdypmask(ii-1,ij ) + & 413 & phia(ii+1,ij ,ik) * pmask(ii+1,ij ,ik)*bdypmask(ii+1,ij ) + & 414 & phia(ii ,ij-1,ik) * pmask(ii ,ij-1,ik)*bdypmask(ii,ij -1 ) + & 415 & phia(ii ,ij+1,ik) * pmask(ii ,ij+1,ik)*bdypmask(ii,ij+1 ) 416 417 phia(ii,ij,ik) = ( phia(ii,ij,ik) / MAX(1._wp, zcoef) ) * pmask(ii,ij,ik) 418 ELSE 419 ip = nint(bdypmask(ii+1,ij )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij )*pmask(ii-1,ij,ik)) 420 jp = nint(bdypmask(ii ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii ,ij-1)*pmask(ii,ij-1,ik)) 421 phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 422 ENDIF 423 END DO 424 END DO 425 ! 426 IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 427 ! 428 END SUBROUTINE bdy_nmn 429 356 430 357 431 #else … … 366 440 WRITE(*,*) 'bdy_orlanski_3d: You should not have seen this print! error?', kt 367 441 END SUBROUTINE bdy_orlanski_3d 442 SUBROUTINE bdy_nmn( idx, igrd, phia ) ! Empty routine 443 WRITE(*,*) 'bdy_nmn: You should not have seen this print! error?', kt 444 END SUBROUTINE bdy_nmn 368 445 #endif 369 446 -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r8058 r8059 50 50 REAL(wp), POINTER, DIMENSION(:,:,:) :: v !: Tidal constituents : V (after nodal cor.) 51 51 END TYPE TIDES_DATA 52 INTEGER, PUBLIC, PARAMETER :: jptides_max = 15 !: Max number of tidal contituents 53 LOGICAL, PUBLIC :: ln_harm_ana_store !: =T Stores data for harmonic Analysis 54 LOGICAL, PUBLIC :: ln_harm_ana_compute !: =T Compute harmonic Analysis 55 LOGICAL, PUBLIC :: ln_harmana_read !: =T Decide to do the analysis 56 !from scratch or continue previous run 52 57 53 58 !$AGRIF_DO_NOT_TREAT … … 90 95 TYPE(MAP_POINTER), DIMENSION(jpbgrd) :: ibmap_ptr !: array of pointers to nbmap 91 96 !! 92 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj 97 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta, ln_bdytide_conj, ln_harm_ana_store, ln_harm_ana_compute, ln_harmana_read 93 98 !!---------------------------------------------------------------------- 94 99 … … 102 107 103 108 REWIND(numnam_cfg) 109 REWIND(numnam_ref) ! slwa 104 110 105 111 DO ib_bdy = 1, nb_bdy … … 125 131 IF(lwp) WRITE(numout,*) ' assume complex conjugate : ', ln_bdytide_conj 126 132 IF(lwp) WRITE(numout,*) ' Number of tidal components to read: ', nb_harmo 133 IF(lwp) WRITE(numout,*) ' Use PCOMS harmonic ananalysis or not: ', ln_harm_ana_store 134 IF(lwp) WRITE(numout,*) ' Compute Final harmonic ananalysis or not: ', ln_harm_ana_compute 135 IF(lwp) WRITE(numout,*) ' Read in previous days harmonic data or start afresh: ', ln_harmana_read 127 136 IF(lwp) THEN 128 137 WRITE(numout,*) ' Tidal components: ' -
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r8058 r8059 91 91 !! 92 92 REAL(wp) :: zwgt ! boundary weight 93 INTEGER :: ib, ik, igrd ! dummy loop indices 94 INTEGER :: ii, ij ! 2D addresses 93 REAL(wp) :: zcoef, zcoef1,zcoef2 94 INTEGER :: ib, ik, igrd ! dummy loop indices 95 INTEGER :: ii, ij, ip, jp ! 2D addresses 95 96 !!---------------------------------------------------------------------- 96 97 ! … … 160 161 !! 161 162 REAL(wp) :: zwgt ! boundary weight 162 INTEGER :: ib, ik, igrd ! dummy loop indices 163 INTEGER :: ii, ij,zcoef, zcoef1,zcoef2, ip, jp ! 2D addresses 163 REAL(wp) :: zcoef, zcoef1,zcoef2 164 INTEGER :: ib, ik, igrd ! dummy loop indices 165 INTEGER :: ii, ij, ip, jp ! 2D addresses 164 166 !!---------------------------------------------------------------------- 165 167 ! … … 174 176 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij ) 175 177 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1) 176 IF ( zcoef1+zcoef2 == 0) THEN178 IF ( NINT(zcoef1+zcoef2) == 0) THEN 177 179 ! corner 178 180 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik) … … 181 183 & tsa(ii ,ij-1,ik,jp_tem) * tmask(ii ,ij-1,ik) + & 182 184 & tsa(ii ,ij+1,ik,jp_tem) * tmask(ii ,ij+1,ik) 183 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1 , zcoef) ) * tmask(ii,ij,ik)185 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1._wp, zcoef) ) * tmask(ii,ij,ik) 184 186 tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij ,ik,jp_sal) * tmask(ii-1,ij ,ik) + & 185 187 & tsa(ii+1,ij ,ik,jp_sal) * tmask(ii+1,ij ,ik) + & 186 188 & tsa(ii ,ij-1,ik,jp_sal) * tmask(ii ,ij-1,ik) + & 187 189 & tsa(ii ,ij+1,ik,jp_sal) * tmask(ii ,ij+1,ik) 188 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1 , zcoef) ) * tmask(ii,ij,ik)190 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1._wp, zcoef) ) * tmask(ii,ij,ik) 189 191 ELSE 190 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij )191 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1)192 ip = NINT(bdytmask(ii+1,ij ) - bdytmask(ii-1,ij )) 193 jp = NINT(bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1)) 192 194 tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 193 195 tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik)
Note: See TracChangeset
for help on using the changeset viewer.
