- Timestamp:
- 2015-12-08T12:39:53+01:00 (8 years ago)
- Location:
- branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r6019 r6020 8 8 !! 3.3 ! 2010-09 (D. Storkey) add ice boundary conditions 9 9 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 10 !! 3.6 ! 201 2-01 (C. Rousset) add ice boundary conditions for lim310 !! 3.6 ! 2014-01 (C. Rousset) add ice boundary conditions for lim3 11 11 !!---------------------------------------------------------------------- 12 12 #if defined key_bdy … … 22 22 23 23 TYPE, PUBLIC :: OBC_INDEX !: Indices and weights which define the open boundary 24 INTEGER , DIMENSION(jpbgrd) :: nblen25 INTEGER , DIMENSION(jpbgrd) :: nblenrim26 INTEGER , POINTER, DIMENSION(:,:):: nbi27 INTEGER , POINTER, DIMENSION(:,:):: nbj28 INTEGER , POINTER, DIMENSION(:,:):: nbr29 INTEGER , POINTER, DIMENSION(:,:):: nbmap30 REAL(wp) , POINTER, DIMENSION(:,:):: nbw31 REAL(wp) , POINTER, DIMENSION(:,:):: nbd32 REAL(wp) , POINTER, DIMENSION(:,:):: nbdout33 REAL(wp) , POINTER, DIMENSION(:,:):: flagu34 REAL(wp) , POINTER, DIMENSION(:,:):: flagv24 INTEGER , DIMENSION(jpbgrd) :: nblen 25 INTEGER , DIMENSION(jpbgrd) :: nblenrim 26 INTEGER , POINTER, DIMENSION(:,:) :: nbi 27 INTEGER , POINTER, DIMENSION(:,:) :: nbj 28 INTEGER , POINTER, DIMENSION(:,:) :: nbr 29 INTEGER , POINTER, DIMENSION(:,:) :: nbmap 30 REAL(wp), POINTER, DIMENSION(:,:) :: nbw 31 REAL(wp), POINTER, DIMENSION(:,:) :: nbd 32 REAL(wp), POINTER, DIMENSION(:,:) :: nbdout 33 REAL(wp), POINTER, DIMENSION(:,:) :: flagu 34 REAL(wp), POINTER, DIMENSION(:,:) :: flagv 35 35 END TYPE OBC_INDEX 36 36 … … 41 41 42 42 TYPE, PUBLIC :: OBC_DATA !: Storage for external data 43 INTEGER , DIMENSION(2):: nread44 LOGICAL :: ll_ssh45 LOGICAL :: ll_u2d46 LOGICAL :: ll_v2d47 LOGICAL :: ll_u3d48 LOGICAL :: ll_v3d49 LOGICAL :: ll_tem50 LOGICAL :: ll_sal51 REAL(wp), POINTER, DIMENSION(:) 52 REAL(wp), POINTER, DIMENSION(:) 53 REAL(wp), POINTER, DIMENSION(:) 54 REAL(wp), POINTER, DIMENSION(:,:) 55 REAL(wp), POINTER, DIMENSION(:,:) 56 REAL(wp), POINTER, DIMENSION(:,:) 57 REAL(wp), POINTER, DIMENSION(:,:) 43 INTEGER , DIMENSION(2) :: nread 44 LOGICAL :: ll_ssh 45 LOGICAL :: ll_u2d 46 LOGICAL :: ll_v2d 47 LOGICAL :: ll_u3d 48 LOGICAL :: ll_v3d 49 LOGICAL :: ll_tem 50 LOGICAL :: ll_sal 51 REAL(wp), POINTER, DIMENSION(:) :: ssh 52 REAL(wp), POINTER, DIMENSION(:) :: u2d 53 REAL(wp), POINTER, DIMENSION(:) :: v2d 54 REAL(wp), POINTER, DIMENSION(:,:) :: u3d 55 REAL(wp), POINTER, DIMENSION(:,:) :: v3d 56 REAL(wp), POINTER, DIMENSION(:,:) :: tem 57 REAL(wp), POINTER, DIMENSION(:,:) :: sal 58 58 #if defined key_lim2 59 LOGICAL ::ll_frld60 LOGICAL ::ll_hicif61 LOGICAL ::ll_hsnif62 REAL(wp), POINTER, DIMENSION(:) ::frld63 REAL(wp), POINTER, DIMENSION(:) ::hicif64 REAL(wp), POINTER, DIMENSION(:) ::hsnif59 LOGICAL :: ll_frld 60 LOGICAL :: ll_hicif 61 LOGICAL :: ll_hsnif 62 REAL(wp), POINTER, DIMENSION(:) :: frld 63 REAL(wp), POINTER, DIMENSION(:) :: hicif 64 REAL(wp), POINTER, DIMENSION(:) :: hsnif 65 65 #elif defined key_lim3 66 LOGICAL ::ll_a_i67 LOGICAL ::ll_ht_i68 LOGICAL ::ll_ht_s69 REAL , POINTER, DIMENSION(:,:) :: a_i!: now ice leads fraction climatology70 REAL , POINTER, DIMENSION(:,:) :: ht_i!: Now ice thickness climatology71 REAL , POINTER, DIMENSION(:,:) :: ht_s!: now snow thickness66 LOGICAL :: ll_a_i 67 LOGICAL :: ll_ht_i 68 LOGICAL :: ll_ht_s 69 REAL(wp), POINTER, DIMENSION(:,:) :: a_i !: now ice leads fraction climatology 70 REAL(wp), POINTER, DIMENSION(:,:) :: ht_i !: Now ice thickness climatology 71 REAL(wp), POINTER, DIMENSION(:,:) :: ht_s !: now snow thickness 72 72 #endif 73 73 END TYPE OBC_DATA … … 99 99 INTEGER, DIMENSION(jp_bdy) :: nn_tra_dta !: = 0 use the initial state as bdy dta ; 100 100 !: = 1 read it in a NetCDF file 101 LOGICAL , DIMENSION(jp_bdy) :: ln_tra_dmp!: =T Tracer damping102 LOGICAL , DIMENSION(jp_bdy) :: ln_dyn3d_dmp!: =T Baroclinic velocity damping103 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp!: Damping time scale in days104 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out!: Damping time scale in days at radiation outflow points101 LOGICAL , DIMENSION(jp_bdy) :: ln_tra_dmp !: =T Tracer damping 102 LOGICAL , DIMENSION(jp_bdy) :: ln_dyn3d_dmp !: =T Baroclinic velocity damping 103 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp !: Damping time scale in days 104 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out !: Damping time scale in days at radiation outflow points 105 105 106 106 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_ice_lim ! Choice of boundary condition for sea ice variables 107 INTEGER , DIMENSION(jp_bdy):: nn_ice_lim_dta !: = 0 use the initial state as bdy dta ;107 INTEGER , DIMENSION(jp_bdy) :: nn_ice_lim_dta !: = 0 use the initial state as bdy dta ; 108 108 !: = 1 read it in a NetCDF file 109 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_tem!: choice of the temperature of incoming sea ice110 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_sal!: choice of the salinity of incoming sea ice111 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_age!: choice of the age of incoming sea ice109 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_tem !: choice of the temperature of incoming sea ice 110 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_sal !: choice of the salinity of incoming sea ice 111 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_age !: choice of the age of incoming sea ice 112 112 ! 113 113 -
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r6019 r6020 29 29 USE iom ! IOM library 30 30 USE in_out_manager ! I/O logical units 31 USE dynspg_oce, ONLY: lk_dynspg_ts ! Split-explicit free surface flag32 31 #if defined key_lim2 33 32 USE ice_2 … … 388 387 END DO ! ib_bdy 389 388 390 ! bg jchanut tschanges391 389 #if defined key_tide 392 ! Add tides if not split-explicit free surface else this is done in ts loop 393 IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 394 #endif 395 ! end jchanut tschanges 390 IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data 391 DO ib_bdy = 1, nb_bdy ! Tidal component added in ts loop 392 IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 393 nblen => idx_bdy(ib_bdy)%nblen 394 nblenrim => idx_bdy(ib_bdy)%nblenrim 395 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 396 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1)) 397 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2)) 398 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3)) 399 ENDIF 400 END DO 401 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 402 ! 403 CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 404 ENDIF 405 #endif 396 406 397 407 IF ( ln_apr_obc ) THEN … … 423 433 !! 424 434 !!---------------------------------------------------------------------- 425 USE dynspg_oce, ONLY: lk_dynspg_ts426 435 !! 427 436 INTEGER :: ib_bdy, jfld, jstart, jend, ierror ! local indices … … 430 439 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files 431 440 CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files 441 CHARACTER(len = 256):: clname ! temporary file name 432 442 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 433 443 ! =F => baroclinic velocities in 3D boundary data … … 669 679 ! sea ice 670 680 IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 671 672 681 ! Test for types of ice input (lim2 or lim3) 673 CALL iom_open ( bn_a_i%clname, inum ) 674 id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 682 ! Build file name to find dimensions 683 clname=TRIM(bn_a_i%clname) 684 IF( .NOT. bn_a_i%ln_clim ) THEN 685 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( bn_a_i%clname ), nyear ! add year 686 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month 687 ELSE 688 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( bn_a_i%clname ), nmonth ! add month 689 ENDIF 690 IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 691 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday ! add day 692 ! 693 CALL iom_open ( clname, inum ) 694 id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 675 695 CALL iom_close ( inum ) 676 !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 677 !CALL iom_open ( bn_a_i%clname, inum ) 678 !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 696 679 697 IF ( zndims == 4 ) THEN 680 698 ll_bdylim3 = .TRUE. ! lim3 input -
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r6019 r6020 24 24 USE oce ! ocean dynamics and tracers 25 25 USE dom_oce ! ocean space and time domain 26 USE dynspg_oce27 26 USE bdy_oce ! ocean open boundary conditions 28 27 USE bdydyn2d ! open boundary conditions for barotropic solution … … 35 34 PRIVATE 36 35 37 PUBLIC bdy_dyn ! routine called in dynspg_flt (if lk_dynspg_flt) or 38 ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 36 PUBLIC bdy_dyn ! routine called in dyn_nxt 39 37 40 38 # include "domzgr_substitute.h90" -
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
r6019 r6020 23 23 USE bdy_oce ! ocean open boundary conditions 24 24 USE bdylib ! BDY library routines 25 USE dynspg_oce ! for barotropic variables26 25 USE phycst ! physical constants 27 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) -
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r6019 r6020 59 59 !! 60 60 !!---------------------------------------------------------------------- 61 INTEGER, INTENT( in ) :: kt ! Main time step counter 62 INTEGER :: ib_bdy ! Loop index 63 61 INTEGER, INTENT( in ) :: kt ! Main time step counter 62 ! 63 INTEGER :: ib_bdy ! Loop index 64 !!---------------------------------------------------------------------- 65 ! 64 66 #if defined key_lim3 65 67 CALL lim_var_glo2eqv 66 68 #endif 67 69 ! 68 70 DO ib_bdy=1, nb_bdy 69 71 ! 70 72 SELECT CASE( cn_ice_lim(ib_bdy) ) 71 73 CASE('none') … … 76 78 CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 77 79 END SELECT 78 80 ! 79 81 END DO 80 82 ! 81 83 #if defined key_lim3 82 84 CALL lim_var_zapsmall 83 85 CALL lim_var_agg(1) 84 86 #endif 85 87 ! 86 88 END SUBROUTINE bdy_ice_lim 89 87 90 88 91 SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy ) … … 96 99 !! dimensional baroclinic ocean model with realistic topography. Tellus, 365-382. 97 100 !!------------------------------------------------------------------------------ 98 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices99 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data100 INTEGER, INTENT(in) :: kt ! main time-step counter101 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 102 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 103 INTEGER, INTENT(in) :: kt ! main time-step counter 101 104 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 102 105 ! 103 106 INTEGER :: jpbound ! 0 = incoming ice 104 107 ! ! 1 = outgoing ice 105 108 INTEGER :: jb, jk, jgrd, jl ! dummy loop indices 106 109 INTEGER :: ji, jj, ii, ij ! local scalar 107 110 REAL(wp) :: zwgt, zwgt1 ! local scalar 108 111 REAL(wp) :: ztmelts, zdh 109 110 !!------------------------------------------------------------------------------ 111 ! 112 IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs') 112 #if defined key_lim2 && ! defined key_lim2_vp && defined key_agrif 113 USE ice_2, vt_s => hsnm 114 USE ice_2, vt_i => hicm 115 #endif 116 !!------------------------------------------------------------------------------ 117 ! 118 IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs') 113 119 ! 114 120 jgrd = 1 ! Everything is at T-points here … … 177 183 ! condition on ice thickness depends on the ice velocity 178 184 ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 179 jpbound = 0 ; ii = ji; ij = jj;180 185 jpbound = 0 ; ii = ji ; ij = jj 186 ! 181 187 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 182 188 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 183 189 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj+1 184 190 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj-1 185 191 ! 186 192 IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj ! case ice boundaries = initial conditions 187 ! do not make state variables dependent on velocity 188 189 193 ! ! do not make state variables dependent on velocity 194 ! 190 195 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 191 196 ! 192 197 ! concentration and thickness 193 198 a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch 194 199 ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch 195 200 ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch 196 201 ! 197 202 ! Ice and snow volumes 198 203 v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 199 204 v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl) 200 205 ! 201 206 SELECT CASE( jpbound ) 202 203 CASE( 0 ) ! velocity is inward204 207 ! 208 CASE( 0 ) ! velocity is inward 209 ! 205 210 ! Ice salinity, age, temperature 206 211 sm_i(ji,jj,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin … … 214 219 s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 215 220 END DO 216 217 CASE( 1 ) ! velocity is outward218 221 ! 222 CASE( 1 ) ! velocity is outward 223 ! 219 224 ! Ice salinity, age, temperature 220 225 sm_i(ji,jj,jl) = rswitch * sm_i(ii,ij,jl) + ( 1.0 - rswitch ) * rn_simin … … 228 233 s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 229 234 END DO 230 235 ! 231 236 END SELECT 232 233 ! if salinity is constant, then overwrite rn_ice_sal 234 IF( nn_icesal == 1 ) THEN 235 sm_i(ji,jj,jl) = rn_icesal 237 ! 238 IF( nn_icesal == 1 ) THEN ! constant salinity : overwrite rn_ice_sal 239 sm_i(ji,jj ,jl) = rn_icesal 236 240 s_i (ji,jj,:,jl) = rn_icesal 237 241 ENDIF 238 242 ! 239 243 ! contents 240 244 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) … … 255 259 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 256 260 END DO 257 261 ! 258 262 END DO 259 263 ! 260 264 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 261 265 CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy ) … … 263 267 CALL lbc_bdy_lnk( v_i(:,:,jl), 'T', 1., ib_bdy ) 264 268 CALL lbc_bdy_lnk( v_s(:,:,jl), 'T', 1., ib_bdy ) 265 269 ! 266 270 CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy ) 267 271 CALL lbc_bdy_lnk( sm_i(:,:,jl), 'T', 1., ib_bdy ) … … 276 280 CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy ) 277 281 END DO 278 282 ! 279 283 END DO !jl 280 284 ! 281 285 #endif 282 286 ! 283 IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs')287 IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs') 284 288 ! 285 289 END SUBROUTINE bdy_ice_frs … … 296 300 !! 2013-06 : C. Rousset 297 301 !!------------------------------------------------------------------------------ 298 !!299 302 CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points 303 ! 300 304 INTEGER :: jb, jgrd ! dummy loop indices 301 305 INTEGER :: ji, jj ! local scalar 302 306 INTEGER :: ib_bdy ! Loop index 303 307 REAL(wp) :: zmsk1, zmsk2, zflag 304 !!------------------------------------------------------------------------------308 !!------------------------------------------------------------------------------ 305 309 ! 306 310 IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn') … … 309 313 ! 310 314 SELECT CASE( cn_ice_lim(ib_bdy) ) 311 315 ! 312 316 CASE('none') 313 314 317 CYCLE 315 318 ! 316 319 CASE('frs') 317 320 ! 318 321 IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE ! case ice boundaries = initial conditions 319 ! do not change ice velocity (it is only computed by rheology) 320 322 ! ! do not change ice velocity (it is only computed by rheology) 321 323 SELECT CASE ( cd_type ) 322 323 CASE ( 'U' ) 324 324 ! 325 CASE ( 'U' ) 325 326 jgrd = 2 ! u velocity 326 327 DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) … … 328 329 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) 329 330 zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 330 331 ! 331 332 IF ( ABS( zflag ) == 1. ) THEN ! eastern and western boundaries 332 333 ! one of the two zmsk is always 0 (because of zflag) 333 334 zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 334 335 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice 335 336 ! 336 337 ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 337 338 u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & … … 345 346 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 346 347 u_ice(ji,jj) = rswitch * u_ice(ji,jj) 347 348 ENDDO 349 348 ! 349 END DO 350 350 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 351 351 ! 352 352 CASE ( 'V' ) 353 354 353 jgrd = 3 ! v velocity 355 354 DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) … … 357 356 jj = idx_bdy(ib_bdy)%nbj(jb,jgrd) 358 357 zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 359 358 ! 360 359 IF ( ABS( zflag ) == 1. ) THEN ! northern and southern boundaries 361 360 ! one of the two zmsk is always 0 (because of zflag) 362 361 zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 363 362 zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice 364 363 ! 365 364 ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 366 365 v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & … … 374 373 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 375 374 v_ice(ji,jj) = rswitch * v_ice(ji,jj) 376 377 ENDDO 378 375 ! 376 END DO 379 377 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 380 378 ! 381 379 END SELECT 382 380 ! 383 381 CASE DEFAULT 384 382 CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' ) 385 383 END SELECT 386 387 END DO388 384 ! 385 END DO 386 ! 389 387 IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn') 390 388 ! 391 389 END SUBROUTINE bdy_ice_lim_dyn 392 390 -
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r6019 r6020 76 76 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 77 77 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers 78 INTEGER :: iw , ie, is, in, inum, id_dummy! - -78 INTEGER :: iwe, ies, iso, ino, inum, id_dummy ! - - 79 79 INTEGER :: igrd_start, igrd_end, jpbdta ! - - 80 80 INTEGER :: jpbdtau, jpbdtas ! - - … … 777 777 ! is = mjg(1) + 1 ! if monotasking and no zoom, is=2 778 778 ! in = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1 779 iw = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2780 ie = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1781 is = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2782 in = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1779 iwe = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2 780 ies = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1 781 iso = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2 782 ino = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1 783 783 784 784 ALLOCATE( nbondi_bdy(nb_bdy)) … … 853 853 ENDIF 854 854 ! check if point is in local domain 855 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &856 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in) THEN855 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 856 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino ) THEN 857 857 ! 858 858 icount = icount + 1 … … 890 890 com_south_b = 0 891 891 com_north_b = 0 892 892 893 DO igrd = 1, jpbgrd 893 894 icount = 0 … … 896 897 DO ib = 1, nblendta(igrd,ib_bdy) 897 898 ! check if point is in local domain and equals ir 898 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &899 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in.AND. &899 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 900 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND. & 900 901 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 901 902 ! … … 1594 1595 ELSE 1595 1596 ! This is a corner 1596 WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)1597 IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 1597 1598 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1)) 1598 1599 itest=itest+1 … … 1608 1609 ELSE 1609 1610 ! This is a corner 1610 WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)1611 IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 1611 1612 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2)) 1612 1613 itest=itest+1 … … 1638 1639 ELSE 1639 1640 ! This is a corner 1640 WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)1641 IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 1641 1642 CALL bdy_ctl_corn(npckge(ib), icorne(ib,1)) 1642 1643 itest=itest+1 … … 1652 1653 ELSE 1653 1654 ! This is a corner 1654 WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)1655 IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 1655 1656 CALL bdy_ctl_corn(npckge(ib), icorne(ib,2)) 1656 1657 itest=itest+1 -
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r6019 r6020 33 33 ! USE tide_mod ! Useless ?? 34 34 USE fldread 35 USE dynspg_oce, ONLY: lk_dynspg_ts36 35 37 36 IMPLICIT NONE … … 54 53 TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides !: External tidal harmonics data 55 54 !$AGRIF_END_DO_NOT_TREAT 56 TYPE(OBC_DATA) , P RIVATE, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component)55 TYPE(OBC_DATA) , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component) 57 56 58 57 !!---------------------------------------------------------------------- … … 270 269 ENDIF 271 270 ! 272 IF ( lk_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during 273 ! time splitting integration 274 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 275 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 276 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 277 dta_bdy_s(ib_bdy)%ssh(:) = 0.e0 278 dta_bdy_s(ib_bdy)%u2d(:) = 0.e0 279 dta_bdy_s(ib_bdy)%v2d(:) = 0.e0 280 ENDIF 271 ! Allocate slow varying data in the case of time splitting: 272 ! Do it anyway because at this stage knowledge of free surface scheme is unknown 273 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 274 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 275 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 276 dta_bdy_s(ib_bdy)%ssh(:) = 0.e0 277 dta_bdy_s(ib_bdy)%u2d(:) = 0.e0 278 dta_bdy_s(ib_bdy)%v2d(:) = 0.e0 281 279 ! 282 280 ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 … … 397 395 !! 398 396 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 399 INTEGER, 397 INTEGER, DIMENSION(jpbgrd) :: ilen0 400 398 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts 401 399 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices … … 416 414 ! Absolute time from model initialization: 417 415 IF( PRESENT(kit) ) THEN 418 z_arg = ( kt + (kit+ 0.5_wp*(time_add-1)) / REAL(nn_baro,wp) ) * rdt416 z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 419 417 ELSE 420 418 z_arg = ( kt + time_add ) * rdt … … 456 454 zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time 457 455 ! 458 ! If time splitting, save data at first barotropic iteration 459 IF ( PRESENT(kit) ) THEN 460 IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data: 461 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 462 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 463 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 464 465 ELSE ! Initialize arrays from slow varying open boundary data: 466 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 467 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 468 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 469 ENDIF 456 ! If time splitting, initialize arrays from slow varying open boundary data: 457 IF ( PRESENT(kit) ) THEN 458 IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 459 IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 460 IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 470 461 ENDIF 471 462 ! -
branches/UKMO/icebergs_restart_single_file/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r6019 r6020 10 10 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 11 11 !!---------------------------------------------------------------------- 12 #if defined key_bdy && defined key_dynspg_flt12 #if defined key_bdy 13 13 !!---------------------------------------------------------------------- 14 !! 'key_bdy' AND unstructured open boundary conditions 15 !! 'key_dynspg_flt' filtered free surface 14 !! 'key_bdy' unstructured open boundary conditions 16 15 !!---------------------------------------------------------------------- 17 USE timing ! Timing18 16 USE oce ! ocean dynamics and tracers 19 USE sbcisf ! ice shelf 17 USE bdy_oce ! ocean open boundary conditions 18 USE sbc_oce ! ocean surface boundary conditions 20 19 USE dom_oce ! ocean space and time domain 21 20 USE phycst ! physical constants 22 USE bdy_oce ! ocean open boundary conditions 21 USE sbcisf ! ice shelf 22 ! 23 USE in_out_manager ! I/O manager 23 24 USE lib_mpp ! for mppsum 24 USE in_out_manager ! I/O manager25 USE sbc_oce ! ocean surface boundary conditions25 USE timing ! Timing 26 USE lib_fortran ! Fortran routines library 26 27 27 28 IMPLICIT NONE 28 29 PRIVATE 29 30 30 PUBLIC bdy_vol ! routine called by dynspg_flt.h9031 PUBLIC bdy_vol 31 32 32 33 !! * Substitutions 33 34 # include "domzgr_substitute.h90" 34 35 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)36 !! NEMO/OPA 3.6 , NEMO Consortium (2014) 36 37 !! $Id$ 37 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 44 !! *** ROUTINE bdyvol *** 44 45 !! 45 !! ** Purpose : This routine is called in dynspg_flt to control46 !! the volume of the system.A correction velocity is calculated46 !! ** Purpose : This routine controls the volume of the system. 47 !! A correction velocity is calculated 47 48 !! to correct the total transport through the unstructured OBC. 48 49 !! The total depth used is constant (H0) to be consistent with the … … 78 79 TYPE(OBC_INDEX), POINTER :: idx 79 80 !!----------------------------------------------------------------------------- 80 81 IF( nn_timing == 1 ) CALL timing_start('bdy_vol')82 81 ! 82 IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 83 ! 83 84 IF( ln_vol ) THEN 84 85 ! 85 86 IF( kt == nit000 ) THEN 86 87 IF(lwp) WRITE(numout,*) … … 91 92 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 92 93 ! ----------------------------------------------------------------------- 93 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 94 !!gm replace these lines : 95 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 94 96 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 97 !!gm by : 98 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 99 !!gm 95 100 96 101 ! Transport through the unstructured open boundary 97 102 ! ------------------------------------------------ 98 zubtpecor = 0. e0103 zubtpecor = 0._wp 99 104 DO ib_bdy = 1, nb_bdy 100 105 idx => idx_bdy(ib_bdy) 101 106 ! 102 107 jgrd = 2 ! cumulate u component contribution first 103 108 DO jb = 1, idx%nblenrim(jgrd) … … 116 121 END DO 117 122 END DO 118 123 ! 119 124 END DO 120 125 IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain … … 123 128 ! ------------------------------ 124 129 IF( nn_volctl==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 125 ELSE ; zubtpecor = zubtpecor / bdysurftot130 ELSE ; zubtpecor = zubtpecor / bdysurftot 126 131 END IF 127 132 128 133 ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation 129 134 ! ------------------------------------------------------------- 130 ztranst = 0. e0135 ztranst = 0._wp 131 136 DO ib_bdy = 1, nb_bdy 132 137 idx => idx_bdy(ib_bdy) 133 138 ! 134 139 jgrd = 2 ! correct u component 135 140 DO jb = 1, idx%nblenrim(jgrd) … … 150 155 END DO 151 156 END DO 152 157 ! 153 158 END DO 154 159 IF( lk_mpp ) CALL mpp_sum( ztranst ) ! sum over the global domain … … 169 174 ! 170 175 END IF ! ln_vol 171 176 ! 172 177 END SUBROUTINE bdy_vol 173 178
Note: See TracChangeset
for help on using the changeset viewer.