- Timestamp:
- 2015-11-20T09:39:06+01:00 (8 years ago)
- Location:
- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY
- Files:
-
- 4 edited
-
bdy_oce.F90 (modified) (5 diffs)
-
bdyice_lim.F90 (modified) (15 diffs)
-
bdyini.F90 (modified) (9 diffs)
-
bdyvol.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r5620 r5901 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 LOGICAL :: ll_fvl52 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(:,:) 58 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 LOGICAL :: ll_fvl 52 REAL(wp), POINTER, DIMENSION(:) :: ssh 53 REAL(wp), POINTER, DIMENSION(:) :: u2d 54 REAL(wp), POINTER, DIMENSION(:) :: v2d 55 REAL(wp), POINTER, DIMENSION(:,:) :: u3d 56 REAL(wp), POINTER, DIMENSION(:,:) :: v3d 57 REAL(wp), POINTER, DIMENSION(:,:) :: tem 58 REAL(wp), POINTER, DIMENSION(:,:) :: sal 59 59 #if defined key_lim2 60 LOGICAL ::ll_frld61 LOGICAL ::ll_hicif62 LOGICAL ::ll_hsnif63 REAL(wp), POINTER, DIMENSION(:) ::frld64 REAL(wp), POINTER, DIMENSION(:) ::hicif65 REAL(wp), POINTER, DIMENSION(:) ::hsnif60 LOGICAL :: ll_frld 61 LOGICAL :: ll_hicif 62 LOGICAL :: ll_hsnif 63 REAL(wp), POINTER, DIMENSION(:) :: frld 64 REAL(wp), POINTER, DIMENSION(:) :: hicif 65 REAL(wp), POINTER, DIMENSION(:) :: hsnif 66 66 #elif defined key_lim3 67 LOGICAL ::ll_a_i68 LOGICAL ::ll_ht_i69 LOGICAL ::ll_ht_s70 REAL , POINTER, DIMENSION(:,:) :: a_i!: now ice leads fraction climatology71 REAL , POINTER, DIMENSION(:,:) :: ht_i!: Now ice thickness climatology72 REAL , POINTER, DIMENSION(:,:) :: ht_s!: now snow thickness67 LOGICAL :: ll_a_i 68 LOGICAL :: ll_ht_i 69 LOGICAL :: ll_ht_s 70 REAL(wp), POINTER, DIMENSION(:,:) :: a_i !: now ice leads fraction climatology 71 REAL(wp), POINTER, DIMENSION(:,:) :: ht_i !: Now ice thickness climatology 72 REAL(wp), POINTER, DIMENSION(:,:) :: ht_s !: now snow thickness 73 73 #endif 74 74 END TYPE OBC_DATA … … 86 86 ! 87 87 INTEGER :: nb_bdy !: number of open boundary sets 88 INTEGER :: nb_jpk_bdy ! Number of levels in the bdy data (set < 0 if consistent with planned run)88 INTEGER, :: nb_jpk_bdy !: number of levels in the bdy data (set < 0 if consistent with planned run) 89 89 INTEGER, DIMENSION(jp_bdy) :: nn_rimwidth !: boundary rim width for Flow Relaxation Scheme 90 90 INTEGER :: nn_volctl !: = 0 the total volume will have the variability of the surface Flux E-P … … 101 101 INTEGER, DIMENSION(jp_bdy) :: nn_tra_dta !: = 0 use the initial state as bdy dta ; 102 102 !: = 1 read it in a NetCDF file 103 LOGICAL , DIMENSION(jp_bdy) :: ln_tra_dmp!: =T Tracer damping104 LOGICAL , DIMENSION(jp_bdy) :: ln_dyn3d_dmp!: =T Baroclinic velocity damping105 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp!: Damping time scale in days106 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out!: Damping time scale in days at radiation outflow points103 LOGICAL , DIMENSION(jp_bdy) :: ln_tra_dmp !: =T Tracer damping 104 LOGICAL , DIMENSION(jp_bdy) :: ln_dyn3d_dmp !: =T Baroclinic velocity damping 105 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp !: Damping time scale in days 106 REAL(wp), DIMENSION(jp_bdy) :: rn_time_dmp_out !: Damping time scale in days at radiation outflow points 107 107 108 108 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_ice_lim ! Choice of boundary condition for sea ice variables 109 INTEGER , DIMENSION(jp_bdy):: nn_ice_lim_dta !: = 0 use the initial state as bdy dta ;109 INTEGER , DIMENSION(jp_bdy) :: nn_ice_lim_dta !: = 0 use the initial state as bdy dta ; 110 110 !: = 1 read it in a NetCDF file 111 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_tem!: choice of the temperature of incoming sea ice112 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_sal!: choice of the salinity of incoming sea ice113 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_age!: choice of the age of incoming sea ice111 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_tem !: choice of the temperature of incoming sea ice 112 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_sal !: choice of the salinity of incoming sea ice 113 REAL(wp), DIMENSION(jp_bdy) :: rn_ice_age !: choice of the age of incoming sea ice 114 114 ! 115 115 -
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r5620 r5901 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/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r5626 r5901 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 ! - - … … 801 801 ! is = mjg(1) + 1 ! if monotasking and no zoom, is=2 802 802 ! in = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1 803 iw = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2804 ie = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1805 is = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2806 in = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1803 iwe = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2 804 ies = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1 805 iso = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2 806 ino = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1 807 807 808 808 ALLOCATE( nbondi_bdy(nb_bdy)) … … 877 877 ENDIF 878 878 ! check if point is in local domain 879 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &880 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in) THEN879 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 880 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino ) THEN 881 881 ! 882 882 icount = icount + 1 … … 914 914 com_south_b = 0 915 915 com_north_b = 0 916 916 917 DO igrd = 1, jpbgrd 917 918 icount = 0 … … 920 921 DO ib = 1, nblendta(igrd,ib_bdy) 921 922 ! check if point is in local domain and equals ir 922 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &923 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in.AND. &923 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 924 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND. & 924 925 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 925 926 ! … … 1618 1619 ELSE 1619 1620 ! This is a corner 1620 WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)1621 IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 1621 1622 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1)) 1622 1623 itest=itest+1 … … 1632 1633 ELSE 1633 1634 ! This is a corner 1634 WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)1635 IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 1635 1636 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2)) 1636 1637 itest=itest+1 … … 1662 1663 ELSE 1663 1664 ! This is a corner 1664 WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)1665 IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 1665 1666 CALL bdy_ctl_corn(npckge(ib), icorne(ib,1)) 1666 1667 itest=itest+1 … … 1676 1677 ELSE 1677 1678 ! This is a corner 1678 WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)1679 IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 1679 1680 CALL bdy_ctl_corn(npckge(ib), icorne(ib,2)) 1680 1681 itest=itest+1 -
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r5038 r5901 15 15 !! 'key_dynspg_flt' filtered free surface 16 16 !!---------------------------------------------------------------------- 17 USE timing ! Timing18 17 USE oce ! ocean dynamics and tracers 19 USE sbcisf ! ice shelf 18 USE bdy_oce ! ocean open boundary conditions 19 USE sbc_oce ! ocean surface boundary conditions 20 20 USE dom_oce ! ocean space and time domain 21 21 USE phycst ! physical constants 22 USE bdy_oce ! ocean open boundary conditions 22 USE sbcisf ! ice shelf 23 ! 24 USE in_out_manager ! I/O manager 23 25 USE lib_mpp ! for mppsum 24 USE in_out_manager ! I/O manager25 USE sbc_oce ! ocean surface boundary conditions26 USE timing ! Timing 27 USE lib_fortran ! Fortran routines library 26 28 27 29 IMPLICIT NONE … … 33 35 # include "domzgr_substitute.h90" 34 36 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)37 !! NEMO/OPA 3.6 , NEMO Consortium (2014) 36 38 !! $Id$ 37 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 78 80 TYPE(OBC_INDEX), POINTER :: idx 79 81 !!----------------------------------------------------------------------------- 80 81 IF( nn_timing == 1 ) CALL timing_start('bdy_vol')82 82 ! 83 IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 84 ! 83 85 IF( ln_vol ) THEN 84 86 ! 85 87 IF( kt == nit000 ) THEN 86 88 IF(lwp) WRITE(numout,*) … … 91 93 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 92 94 ! ----------------------------------------------------------------------- 93 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 95 !!gm replace these lines : 96 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 94 97 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 98 !!gm by : 99 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 100 !!gm 95 101 96 102 ! Transport through the unstructured open boundary 97 103 ! ------------------------------------------------ 98 zubtpecor = 0. e0104 zubtpecor = 0._wp 99 105 DO ib_bdy = 1, nb_bdy 100 106 idx => idx_bdy(ib_bdy) 101 107 ! 102 108 jgrd = 2 ! cumulate u component contribution first 103 109 DO jb = 1, idx%nblenrim(jgrd) … … 116 122 END DO 117 123 END DO 118 124 ! 119 125 END DO 120 126 IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain … … 123 129 ! ------------------------------ 124 130 IF( nn_volctl==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 125 ELSE ; zubtpecor = zubtpecor / bdysurftot131 ELSE ; zubtpecor = zubtpecor / bdysurftot 126 132 END IF 127 133 128 134 ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation 129 135 ! ------------------------------------------------------------- 130 ztranst = 0. e0136 ztranst = 0._wp 131 137 DO ib_bdy = 1, nb_bdy 132 138 idx => idx_bdy(ib_bdy) 133 139 ! 134 140 jgrd = 2 ! correct u component 135 141 DO jb = 1, idx%nblenrim(jgrd) … … 150 156 END DO 151 157 END DO 152 158 ! 153 159 END DO 154 160 IF( lk_mpp ) CALL mpp_sum( ztranst ) ! sum over the global domain … … 169 175 ! 170 176 END IF ! ln_vol 171 177 ! 172 178 END SUBROUTINE bdy_vol 173 179
Note: See TracChangeset
for help on using the changeset viewer.
