Changeset 5878
- Timestamp:
- 2015-11-11T19:11:01+01:00 (9 years ago)
- Location:
- branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 5 edited
-
BDY/bdy_oce.F90 (modified) (4 diffs)
-
BDY/bdyini.F90 (modified) (4 diffs)
-
DYN/dynldf_iso.F90 (modified) (9 diffs)
-
TRA/traldf_iso.F90 (modified) (4 diffs)
-
TRA/traldf_lap.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r5876 r5878 83 83 LOGICAL :: ln_mask_file !: =T read bdymask from file 84 84 LOGICAL :: ln_vol !: =T volume correction 85 LOGICAL, DIMENSION(jp_bdy) :: ln_sponge !: =T use sponge layer 85 86 ! 86 87 INTEGER :: nb_bdy !: number of open boundary sets … … 88 89 INTEGER :: nn_volctl !: = 0 the total volume will have the variability of the surface Flux E-P 89 90 ! ! = 1 the volume will be constant during all the integration. 91 REAL(wp) :: rn_sponge !: multiplier of diffusion for sponge layer 90 92 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_dyn2d ! Choice of boundary condition for barotropic variables (U,V,SSH) 91 93 INTEGER, DIMENSION(jp_bdy) :: nn_dyn2d_dta !: = 0 use the initial state as bdy dta ; … … 118 120 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: bdyumask !: Mask defining computational domain at U-points 119 121 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: bdyvmask !: Mask defining computational domain at V-points 122 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sponge_factor !: Multiplier for diffusion for sponge layer 120 123 121 124 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary 122 123 125 !!---------------------------------------------------------------------- 124 126 !! open boundary data variables … … 148 150 ! 149 151 ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 150 & STAT=bdy_oce_alloc )152 & sponge_factor(jpi,jpj), STAT=bdy_oce_alloc ) 151 153 ! 152 154 ! Initialize masks -
branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r5876 r5878 102 102 & cn_ice_lim, nn_ice_lim_dta, & 103 103 & rn_ice_tem, rn_ice_sal, rn_ice_age, & 104 & ln_vol, nn_volctl, nn_rimwidth 104 & ln_vol, nn_volctl, nn_rimwidth, & 105 & ln_sponge, rn_sponge 105 106 !! 106 107 NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend … … 365 366 IF(lwp) WRITE(numout,*) ' Width of relaxation zone = ', nn_rimwidth(ib_bdy) 366 367 IF(lwp) WRITE(numout,*) 368 IF( ln_sponge(ib_bdy) ) THEN ! check sponge layer choice 369 IF(lwp) WRITE(numout,*) 'Sponge layer applied at open boundaries' 370 IF(lwp) WRITE(numout,*) 'Multiplier for diffusion in sponge layer : ', rn_sponge 371 IF(lwp) WRITE(numout,*) 372 ELSE 373 IF(lwp) WRITE(numout,*) 'No volume correction applied at open boundaries' 374 IF(lwp) WRITE(numout,*) 375 ENDIF 367 376 368 377 ENDDO … … 383 392 ENDIF 384 393 ENDIF 394 395 sponge_factor(:,:) = 1.0 385 396 386 397 ! ------------------------------------------------- … … 1103 1114 END DO 1104 1115 END DO 1116 ! Compute multiplier for diffusion for sponge layer 1117 ! ------------------------------------------------- 1118 IF( ln_sponge(ib_bdy) ) THEN 1119 igrd=1 1120 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 1121 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1122 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1123 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 1124 sponge_factor(nbi,nbj) = 1.0 + (rn_sponge-1.0) * ( 1.- TANH( FLOAT( nbr - 1 ) *0.5 ) ) 1125 ! 0.5 factor says how fast tanh goes to 1 - reduce this to have 1126 ! effect on more of the rimwidth 1127 END DO 1128 ENDIF 1129 1105 1130 1106 1131 ENDDO -
branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r5876 r5878 30 30 USE wrk_nemo ! Memory Allocation 31 31 USE timing ! Timing 32 #if defined key_bdy 33 USE bdy_oce ! needed for extra diffusion in rim 34 #endif 32 35 33 36 IMPLICIT NONE … … 114 117 REAL(wp) :: zcoef0, zcoef3, zcoef4, zmkt, zmkf ! - - 115 118 REAL(wp) :: zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - 119 REAL(wp), DIMENSION(jpi,jpj) :: zfactor ! multiplier for diffusion 116 120 ! 117 121 REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v … … 129 133 IF( dyn_ldf_iso_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays') 130 134 ENDIF 135 #if defined key_bdy 136 zfactor(:,:) = sponge_factor(:,:) 137 #else 138 zfactor(:,:) = 1.0 139 #endif 140 #if defined key_bdy 141 zfactor(:,:) = sponge_factor(:,:) 142 #else 143 zfactor(:,:) = 1.0 144 #endif 131 145 132 146 ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum … … 184 198 DO jj = 2, jpjm1 185 199 DO ji = fs_2, jpi ! vector opt. 186 zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj)200 zabe1 = zfactor(ji,jj) *(fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj) 187 201 188 202 zmskt = 1./MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 189 203 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. ) 190 204 191 zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )205 zcof1 = - zfactor(ji,jj) * aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 192 206 193 207 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & … … 199 213 DO jj = 2, jpjm1 200 214 DO ji = fs_2, jpi ! vector opt. 201 zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)215 zabe1 = zfactor(ji,jj) * (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 202 216 203 217 zmskt = 1./MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 204 218 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. ) 205 219 206 zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )220 zcof1 = - zfactor(ji,jj) * aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 207 221 208 222 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & … … 216 230 DO jj = 1, jpjm1 217 231 DO ji = 1, fs_jpim1 ! vector opt. 218 zabe2 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)232 zabe2 = zfactor(ji,jj) * ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 219 233 220 234 zmskf = 1./MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & 221 235 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1. ) 222 236 223 zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )237 zcof2 = - zfactor(ji,jj) * aht0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 224 238 225 239 zjuf(ji,jj) = ( zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) ) & … … 237 251 DO jj = 2, jpjm1 238 252 DO ji = 1, fs_jpim1 ! vector opt. 239 zabe1 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)253 zabe1 = zfactor(ji,jj) * ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 240 254 241 255 zmskf = 1./MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 242 256 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. ) 243 257 244 zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )258 zcof1 = - zfactor(ji,jj) * aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 245 259 246 260 zivf(ji,jj) = ( zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) ) & … … 254 268 DO jj = 2, jpj 255 269 DO ji = 1, fs_jpim1 ! vector opt. 256 zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj)270 zabe2 = zfactor(ji,jj) * (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj) 257 271 258 272 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 259 273 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 260 274 261 zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )275 zcof2 = - zfactor(ji,jj) * aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 262 276 263 277 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & … … 269 283 DO jj = 2, jpj 270 284 DO ji = 1, fs_jpim1 ! vector opt. 271 zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)285 zabe2 = zfactor(ji,jj) * (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 272 286 273 287 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 274 288 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 275 289 276 zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )290 zcof2 = - zfactor(ji,jj) * aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 277 291 278 292 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & -
branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5876 r5878 32 32 USE wrk_nemo ! Memory Allocation 33 33 USE timing ! Timing 34 #if defined key_bdy 35 USE bdy_oce 36 #endif 34 37 35 38 IMPLICIT NONE … … 110 113 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 111 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw 115 REAL(wp), DIMENSION(jpi,jpj) :: zfactor ! multiplier for diffusion 112 116 !!---------------------------------------------------------------------- 113 117 ! … … 124 128 ENDIF 125 129 ! 130 #if defined key_bdy 131 zfactor(:,:) = sponge_factor(:,:) 132 #else 133 zfactor(:,:) = 1.0 134 #endif 126 135 ! ! =========== 127 136 DO jn = 1, kjpt ! tracer loop … … 200 209 DO jj = 1 , jpjm1 201 210 DO ji = 1, fs_jpim1 ! vector opt. 202 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)203 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)211 zabe1 = zfactor(ji,jj) * ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 212 zabe2 = zfactor(ji,jj) * ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 204 213 ! 205 214 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & -
branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5876 r5878 26 26 USE lib_mpp ! MPP library 27 27 USE timing ! Timing 28 #if defined key_bdy 29 USE bdy_oce 30 #endif 28 31 29 32 IMPLICIT NONE … … 77 80 INTEGER :: iku, ikv, ierr ! local integers 78 81 REAL(wp) :: zabe1, zabe2, zbtr ! local scalars 82 REAL(wp), DIMENSION(jpi,jpj) :: zfactor ! multiplier for diffusion 79 83 !!---------------------------------------------------------------------- 80 84 ! … … 86 90 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 87 91 ENDIF 92 #if defined key_bdy 93 zfactor(:,:) = sponge_factor(:,:) 94 #else 95 zfactor(:,:) = 1.0 96 #endif 88 97 89 98 ! ! =========== ! … … 96 105 DO jj = 1, jpjm1 97 106 DO ji = 1, fs_jpim1 ! vector opt. 98 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)99 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)107 zabe1 = zfactor(ji,jj) * fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 108 zabe2 = zfactor(ji,jj) * fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 100 109 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 101 110 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) … … 109 118 ikv = mbkv(ji,jj) 110 119 IF( iku == jk ) THEN 111 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)120 zabe1 = zfactor(ji,jj) * fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 112 121 ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 113 122 ENDIF 114 123 IF( ikv == jk ) THEN 115 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)124 zabe2 = zfactor(ji,jj) * fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 116 125 ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 117 126 ENDIF … … 128 137 ikv = mikv(ji,jj) 129 138 IF( iku == MAX(2,jk) ) THEN 130 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)139 zabe1 = zfactor(ji,jj) * fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 131 140 ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn) 132 141 ENDIF 133 142 IF( ikv == MAX(2,jk) ) THEN 134 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)143 zabe2 = zfactor(ji,jj) * fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 135 144 ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn) 136 145 END IF
Note: See TracChangeset
for help on using the changeset viewer.
