Changeset 7567 for branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY
- Timestamp:
- 2017-01-16T20:11:00+01:00 (7 years ago)
- Location:
- branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY
- Files:
-
- 6 edited
-
bdy_oce.F90 (modified) (6 diffs)
-
bdydta.F90 (modified) (4 diffs)
-
bdydyn3d.F90 (modified) (4 diffs)
-
bdyini.F90 (modified) (7 diffs)
-
bdylib.F90 (modified) (3 diffs)
-
bdytides.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r7566 r7567 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 … … 83 90 LOGICAL :: ln_mask_file !: =T read bdymask from file 84 91 LOGICAL :: ln_vol !: =T volume correction 92 !JT 93 LOGICAL, DIMENSION(jp_bdy) :: ln_sponge !: =T use sponge layer 94 !JT 85 95 ! 86 96 INTEGER :: nb_bdy !: number of open boundary sets … … 101 111 LOGICAL, DIMENSION(jp_bdy) :: ln_tra_dmp !: =T Tracer damping 102 112 LOGICAL, DIMENSION(jp_bdy) :: ln_dyn3d_dmp !: =T Baroclinic velocity damping 113 114 ! !JT 115 LOGICAL, DIMENSION(jp_bdy) :: ln_ssh_bdy !: =T USE SSH BDY - name list switch 116 ! !JT 117 103 118 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp !: Damping time scale in days 104 119 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out !: Damping time scale in days at radiation outflow points 120 !JT 121 REAL(wp) :: rn_sponge !: multiplier of diffusion for sponge layer 122 !JT 105 123 106 124 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_ice_lim ! Choice of boundary condition for sea ice variables … … 118 136 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: bdyumask !: Mask defining computational domain at U-points 119 137 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: bdyvmask !: Mask defining computational domain at V-points 138 !JT 139 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sponge_factor !: Multiplier for diffusion for sponge layer 140 !JT 120 141 121 142 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary … … 147 168 !!---------------------------------------------------------------------- 148 169 ! 149 ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 170 !JT ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 171 ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),sponge_factor(jpi,jpj), & 150 172 & STAT=bdy_oce_alloc ) 151 173 ! … … 154 176 bdyumask(:,:) = 1._wp 155 177 bdyvmask(:,:) = 1._wp 178 !JT 179 sponge_factor(:,:) = 1._wp 180 !JT 156 181 ! 157 182 IF( lk_mpp ) CALL mpp_sum ( bdy_oce_alloc ) -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r7566 r7567 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 … … 394 398 #endif 395 399 ! end jchanut tschanges 400 401 402 !JT use sshn (ssh now) if ln_ssh_bdy set to false in the name list 403 DO ib_bdy = 1, nb_bdy 404 nblen => idx_bdy(ib_bdy)%nblen 405 dta => dta_bdy(ib_bdy) 406 407 ilen1(:) = nblen(:) 408 !JT IF( .NOT. dta%ll_ssh ) THEN 409 IF( .NOT. ln_ssh_bdy(ib_bdy) ) THEN 410 igrd = 1 ! t Grid 411 DO ib = 1, ilen1(igrd) 412 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 413 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 414 dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 415 END DO 416 END IF 417 END DO 418 !JT 396 419 397 420 IF ( ln_apr_obc ) THEN … … 782 805 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 783 806 ENDIF 784 IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 785 IF( dta%ll_ssh ) THEN 786 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 787 jfld = jfld + 1 788 dta%ssh => bf(jfld)%fnow(:,1,1) 789 ENDIF 807 IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 808 !JT IF( dta%ll_ssh ) THEN 809 !JT if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 810 !JT jfld = jfld + 1 811 !JT dta%ssh => bf(jfld)%fnow(:,1,1) 812 !JT ENDIF 813 814 !JT 815 !JT allocate ssh if dta%ll_ssh set too false, as may still use it 816 IF (dta%ll_ssh) THEN 817 IF( dta%ll_ssh ) THEN 818 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 819 jfld = jfld + 1 820 dta%ssh => bf(jfld)%fnow(:,1,1) 821 ENDIF 822 ELSE 823 if(lwp) write(numout,*) '++++++ dta%ssh allocated space' 824 !ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) ) 825 ALLOCATE( dta%ssh(nblen(1)) ) 826 ENDIF 827 !JT if 828 790 829 IF ( dta%ll_u2d ) THEN 791 830 IF ( ln_full_vel_array(ib_bdy) ) THEN … … 814 853 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 815 854 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 816 ENDIF 855 ENDIF 817 856 IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 818 857 & ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r7566 r7567 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 !! $Id$ 35 !! $Id$ 36 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 37 !!---------------------------------------------------------------------- … … 59 59 CASE('specified') 60 60 CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 61 CASE('zerograd') 62 CALL bdy_dyn3d_zgrad( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 61 63 CASE('zero') 62 64 CALL bdy_dyn3d_zro( 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 305 392 #else 306 393 !!---------------------------------------------------------------------- -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r7566 r7567 49 49 !!---------------------------------------------------------------------- 50 50 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 51 !! $Id$ 51 !! $Id$ 52 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 53 !!---------------------------------------------------------------------- … … 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_rimwidth104 & ln_vol, nn_volctl, ln_sponge, rn_sponge, nn_rimwidth 105 105 !! 106 106 NAMELIST/nambdy_index/ ctypebdy, nbdyind, nbdybeg, nbdyend 107 108 109 ! ! JT 110 NAMELIST/nambdy_ssh/ ln_ssh_bdy 111 ! ! JT 107 112 INTEGER :: ios ! Local integer output status for namelist read 108 113 !!---------------------------------------------------------------------- … … 132 137 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp ) 133 138 IF(lwm) WRITE ( numond, nambdy ) 139 140 141 142 143 144 145 146 147 148 !JT Read nambdy_ssh namelist 149 REWIND( numnam_ref ) ! Namelist nambdy in reference namelist :Unstructured open boundaries 150 READ ( numnam_ref, nambdy_ssh, IOSTAT = ios, ERR = 905) 151 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_ssh in reference namelist', lwp ) 152 153 REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist :Unstructured open boundaries 154 READ ( numnam_cfg, nambdy_ssh, IOSTAT = ios, ERR = 906) 155 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_ssh in configuration namelist', lwp ) 156 IF(lwm) WRITE ( numond, nambdy_ssh ) 157 158 IF(lwp) WRITE(numout,*) 159 IF(lwp) WRITE(numout,*) 'nambdy_ssh : use of ssh boundaries' 160 IF(lwp) WRITE(numout,*) '~~~~~~~~' 161 IF(lwp) WRITE(numout,*) ' ln_ssh_bdy: ' 162 DO ib_bdy = 1,nb_bdy 163 IF(lwp) WRITE(numout,*) ' ln_ssh_bdy(',ib_bdy,'): ',ln_ssh_bdy(ib_bdy) 164 ENDDO 165 IF(lwp) WRITE(numout,*) '~~~~~~~~' 166 IF(lwp) WRITE(numout,*) 167 !JT 168 169 170 171 172 173 134 174 135 175 ! ----------------------------------------- … … 185 225 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_dyn2d' ) 186 226 END SELECT 227 228 !JT override dta_bdy(ib_bdy)%ll_ssh with namelist value (ln_ssh_bdy) 229 IF(lwp) WRITE(numout,*) 'nambdy_ssh : use of ssh boundaries' 230 IF(lwp) WRITE(numout,*) '~~~~~~~~' 231 IF(lwp) WRITE(numout,*) ' ib_bdy: ',ib_bdy 232 IF(lwp) WRITE(numout,*) ' Prior to Implementation of nambdy_ssh' 233 IF(lwp) WRITE(numout,*) ' dta_bdy(ib_bdy)%ll_ssh: ',dta_bdy(ib_bdy)%ll_ssh 234 235 dta_bdy(ib_bdy)%ll_ssh = ln_ssh_bdy(ib_bdy) 236 237 IF(lwp) WRITE(numout,*) ' After to Implementation of nambdy_ssh' 238 IF(lwp) WRITE(numout,*) ' dta_bdy(ib_bdy)%ll_ssh: ',dta_bdy(ib_bdy)%ll_ssh 239 IF(lwp) WRITE(numout,*) '~~~~~~~~' 240 241 !JT 242 187 243 IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 188 244 SELECT CASE( nn_dyn2d_dta(ib_bdy) ) ! … … 213 269 dta_bdy(ib_bdy)%ll_u3d = .true. 214 270 dta_bdy(ib_bdy)%ll_v3d = .true. 271 CASE('neumann') 272 IF(lwp) WRITE(numout,*) ' Neumann conditions' 273 dta_bdy(ib_bdy)%ll_u3d = .false. 274 dta_bdy(ib_bdy)%ll_v3d = .false. 275 CASE('zerograd') 276 IF(lwp) WRITE(numout,*) ' Zero gradient for baroclinic velocities' 277 dta_bdy(ib_bdy)%ll_u3d = .false. 278 dta_bdy(ib_bdy)%ll_v3d = .false. 215 279 CASE('zero') 216 280 IF(lwp) WRITE(numout,*) ' Zero baroclinic velocities (runoff case)' … … 365 429 IF(lwp) WRITE(numout,*) ' Width of relaxation zone = ', nn_rimwidth(ib_bdy) 366 430 IF(lwp) WRITE(numout,*) 431 432 IF( ln_sponge(ib_bdy) ) THEN ! check sponge layer choice 433 IF(lwp) WRITE(numout,*) ' Sponge layer applied at open boundaries' 434 IF(lwp) WRITE(numout,*) ' Multiplier for diffusion in sponge layer : ', rn_sponge 435 IF(lwp) WRITE(numout,*) 436 ELSE 437 IF(lwp) WRITE(numout,*) ' No Sponge layer applied at open boundaries' 438 IF(lwp) WRITE(numout,*) 439 ENDIF 440 441 442 367 443 368 444 ENDDO … … 1092 1168 END DO 1093 1169 END DO 1170 1171 1172 !JT 1173 ! Compute multiplier for diffusion for sponge layer 1174 ! ------------------------------------------------- 1175 IF( ln_sponge(ib_bdy) ) THEN 1176 igrd=1 1177 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 1178 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1179 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1180 nbr => idx_bdy(ib_bdy)%nbr(ib,igrd) 1181 sponge_factor(nbi,nbj) = 1.0 + (rn_sponge-1.0) * ( 1.- TANH( FLOAT( nbr - 1 ) *0.5 ) ) 1182 END DO 1183 ENDIF 1184 !JT 1185 1094 1186 1095 1187 ! Compute damping coefficients -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
r7566 r7567 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 !!---------------------------------------------------------------------- 30 31 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 31 !! $Id$ 32 !! $Id$ 32 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 34 !!---------------------------------------------------------------------- … … 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) * pmask(ii,ij,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 356 429 357 430 #else … … 366 439 WRITE(*,*) 'bdy_orlanski_3d: You should not have seen this print! error?', kt 367 440 END SUBROUTINE bdy_orlanski_3d 441 SUBROUTINE bdy_nmn( idx, igrd, phia ) ! Empty routine 442 WRITE(*,*) 'bdy_nmn: You should not have seen this print! error?', kt 443 END SUBROUTINE bdy_nmn 368 444 #endif 369 445 -
branches/UKMO/CO6_shelfclimate/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r7566 r7567 102 102 103 103 REWIND(numnam_cfg) 104 REWIND(numnam_ref) ! slwa 104 105 105 106 DO ib_bdy = 1, nb_bdy
Note: See TracChangeset
for help on using the changeset viewer.
