Changeset 9890
- Timestamp:
- 2018-07-06T15:05:45+02:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/BDY/bdyice.F90
r9888 r9890 50 50 !! *** SUBROUTINE bdy_ice *** 51 51 !! 52 !! ** Purpose : - Apply open boundary conditions for ice (SI3)52 !! ** Purpose : Apply open boundary conditions for sea ice 53 53 !! 54 54 !!---------------------------------------------------------------------- 55 55 INTEGER, INTENT(in) :: kt ! Main time step counter 56 56 ! 57 INTEGER :: ib_bdy ! Loopindex57 INTEGER :: jbdy ! BDY set index 58 58 !!---------------------------------------------------------------------- 59 59 ! … … 62 62 CALL ice_var_glo2eqv 63 63 ! 64 DO ib_bdy = 1, nb_bdy65 ! 66 SELECT CASE( cn_ice( ib_bdy) )64 DO jbdy = 1, nb_bdy 65 ! 66 SELECT CASE( cn_ice(jbdy) ) 67 67 CASE('none') ; CYCLE 68 CASE('frs' ) ; CALL bdy_ice_frs( idx_bdy( ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )68 CASE('frs' ) ; CALL bdy_ice_frs( idx_bdy(jbdy), dta_bdy(jbdy), kt, jbdy ) 69 69 CASE DEFAULT 70 70 CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' ) … … 84 84 85 85 86 SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )86 SUBROUTINE bdy_ice_frs( idx, dta, kt, jbdy ) 87 87 !!------------------------------------------------------------------------------ 88 88 !! *** SUBROUTINE bdy_ice_frs *** 89 89 !! 90 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 91 !! of unstructured open boundaries. 90 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields 92 91 !! 93 92 !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three- … … 97 96 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 98 97 INTEGER, INTENT(in) :: kt ! main time-step counter 99 INTEGER, INTENT(in) :: ib_bdy! BDY set index98 INTEGER, INTENT(in) :: jbdy ! BDY set index 100 99 ! 101 100 INTEGER :: jpbound ! 0 = incoming ice 102 101 ! ! 1 = outgoing ice 103 INTEGER :: jb, jk, jgrd, jl! dummy loop indices104 INTEGER :: ji, jj, ii, ij ! local scalar102 INTEGER :: i_bdy, jgrd ! dummy loop indices 103 INTEGER :: ji, jj, jk, jl, ib, jb 105 104 REAL(wp) :: zwgt, zwgt1 ! local scalar 106 105 REAL(wp) :: ztmelts, zdh … … 110 109 ! 111 110 DO jl = 1, jpl 112 DO jb= 1, idx%nblenrim(jgrd)113 ji = idx%nbi( jb,jgrd)114 jj = idx%nbj( jb,jgrd)115 zwgt = idx%nbw( jb,jgrd)116 zwgt1 = 1.e0 - idx%nbw( jb,jgrd)117 a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Leads fraction118 h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Ice depth119 h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Snow depth111 DO i_bdy = 1, idx%nblenrim(jgrd) 112 ji = idx%nbi(i_bdy,jgrd) 113 jj = idx%nbj(i_bdy,jgrd) 114 zwgt = idx%nbw(i_bdy,jgrd) 115 zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 116 a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Leads fraction 117 h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice depth 118 h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Snow depth 120 119 121 120 ! ----------------- … … 135 134 136 135 ENDDO 137 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy )138 CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy )139 CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy )140 136 ENDDO 137 CALL lbc_bdy_lnk( a_i(:,:,:), 'T', 1., jbdy ) 138 CALL lbc_bdy_lnk( h_i(:,:,:), 'T', 1., jbdy ) 139 CALL lbc_bdy_lnk( h_s(:,:,:), 'T', 1., jbdy ) 141 140 142 141 DO jl = 1, jpl 143 DO jb= 1, idx%nblenrim(jgrd)144 ji = idx%nbi(jb,jgrd)145 jj = idx%nbj(jb,jgrd)142 DO i_bdy = 1, idx%nblenrim(jgrd) 143 ji = idx%nbi(i_bdy,jgrd) 144 jj = idx%nbj(i_bdy,jgrd) 146 145 147 146 ! condition on ice thickness depends on the ice velocity 148 147 ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 149 jpbound = 0 ; i i = ji ; ij= jj150 ! 151 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij= jj152 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij= jj153 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij= jj+1154 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij= jj-1155 ! 156 IF( nn_ice_dta( ib_bdy) == 0 ) jpbound = 0; ii = ji; ij= jj ! case ice boundaries = initial conditions157 ! ! do not make state variables dependent on velocity158 ! 159 IF( a_i(i i,ij,jl) > 0._wp ) THEN ! there is ice at the boundary160 ! 161 a_i(ji,jj,jl) = a_i(i i,ij,jl) ! concentration162 h_i(ji,jj,jl) = h_i(i i,ij,jl) ! thickness ice163 h_s(ji,jj,jl) = h_s(i i,ij,jl) ! thickness snw148 jpbound = 0 ; ib = ji ; jb = jj 149 ! 150 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1 ; ib = ji+1 ; jb = jj 151 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1 ; ib = ji-1 ; jb = jj 152 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1 ; ib = ji ; jb = jj+1 153 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1 ; ib = ji ; jb = jj-1 154 ! 155 IF( nn_ice_dta(jbdy) == 0 ) jpbound = 0 ; ib = ji ; jb = jj ! case ice boundaries = initial conditions 156 ! ! do not make state variables dependent on velocity 157 ! 158 IF( a_i(ib,jb,jl) > 0._wp ) THEN ! there is ice at the boundary 159 ! 160 a_i(ji,jj,jl) = a_i(ib,jb,jl) ! concentration 161 h_i(ji,jj,jl) = h_i(ib,jb,jl) ! thickness ice 162 h_s(ji,jj,jl) = h_s(ib,jb,jl) ! thickness snw 164 163 ! 165 164 SELECT CASE( jpbound ) … … 167 166 CASE( 0 ) ! velocity is inward 168 167 ! 169 oa_i(ji,jj, jl) = rn_ice_age( ib_bdy) * a_i(ji,jj,jl) ! age170 a_ip(ji,jj, jl) = 0._wp 171 v_ip(ji,jj, jl) = 0._wp 172 t_su(ji,jj, jl) = rn_ice_tem( ib_bdy) ! temperature surface173 t_s (ji,jj,:,jl) = rn_ice_tem( ib_bdy) ! temperature snw174 t_i (ji,jj,:,jl) = rn_ice_tem( ib_bdy) ! temperature ice175 s_i (ji,jj, jl) = rn_ice_sal( ib_bdy) ! salinity176 sz_i(ji,jj,:,jl) = rn_ice_sal( ib_bdy) ! salinity profile168 oa_i(ji,jj, jl) = rn_ice_age(jbdy) * a_i(ji,jj,jl) ! age 169 a_ip(ji,jj, jl) = 0._wp ! pond concentration 170 v_ip(ji,jj, jl) = 0._wp ! pond volume 171 t_su(ji,jj, jl) = rn_ice_tem(jbdy) ! temperature surface 172 t_s (ji,jj,:,jl) = rn_ice_tem(jbdy) ! temperature snw 173 t_i (ji,jj,:,jl) = rn_ice_tem(jbdy) ! temperature ice 174 s_i (ji,jj, jl) = rn_ice_sal(jbdy) ! salinity 175 sz_i(ji,jj,:,jl) = rn_ice_sal(jbdy) ! salinity profile 177 176 ! 178 177 CASE( 1 ) ! velocity is outward 179 178 ! 180 oa_i(ji,jj, jl) = oa_i(i i,ij, jl) ! age181 a_ip(ji,jj, jl) = a_ip(i i,ij, jl) ! pond concentration182 v_ip(ji,jj, jl) = v_ip(i i,ij, jl) ! pond volume183 t_su(ji,jj, jl) = t_su(i i,ij, jl) ! temperature surface184 t_s (ji,jj,:,jl) = t_s (i i,ij,:,jl) ! temperature snw185 t_i (ji,jj,:,jl) = t_i (i i,ij,:,jl) ! temperature ice186 s_i (ji,jj, jl) = s_i (i i,ij, jl) ! salinity187 sz_i(ji,jj,:,jl) = sz_i(i i,ij,:,jl) ! salinity profile179 oa_i(ji,jj, jl) = oa_i(ib,jb, jl) ! age 180 a_ip(ji,jj, jl) = a_ip(ib,jb, jl) ! pond concentration 181 v_ip(ji,jj, jl) = v_ip(ib,jb, jl) ! pond volume 182 t_su(ji,jj, jl) = t_su(ib,jb, jl) ! temperature surface 183 t_s (ji,jj,:,jl) = t_s (ib,jb,:,jl) ! temperature snw 184 t_i (ji,jj,:,jl) = t_i (ib,jb,:,jl) ! temperature ice 185 s_i (ji,jj, jl) = s_i (ib,jb, jl) ! salinity 186 sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) ! salinity profile 188 187 ! 189 188 END SELECT … … 243 242 END DO 244 243 ! 245 CALL lbc_bdy_lnk( a_i (:,:,jl), 'T', 1., ib_bdy )246 CALL lbc_bdy_lnk( h_i (:,:,jl), 'T', 1., ib_bdy )247 CALL lbc_bdy_lnk( h_s (:,:,jl), 'T', 1., ib_bdy )248 CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy )249 CALL lbc_bdy_lnk( a_ip(:,:,jl), 'T', 1., ib_bdy )250 CALL lbc_bdy_lnk( v_ip(:,:,jl), 'T', 1., ib_bdy )251 CALL lbc_bdy_lnk( s_i (:,:,jl), 'T', 1., ib_bdy )252 CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy )253 CALL lbc_bdy_lnk( v_i (:,:,jl), 'T', 1., ib_bdy )254 CALL lbc_bdy_lnk( v_s (:,:,jl), 'T', 1., ib_bdy )255 CALL lbc_bdy_lnk( sv_i(:,:,jl), 'T', 1., ib_bdy )256 DO jk = 1, nlay_s257 CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy )258 CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy )259 END DO260 DO jk = 1, nlay_i261 CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy )262 CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )263 END DO264 !265 244 END DO ! jl 245 246 CALL lbc_bdy_lnk( a_i (:,:,:) , 'T', 1., jbdy ) 247 CALL lbc_bdy_lnk( h_i (:,:,:) , 'T', 1., jbdy ) 248 CALL lbc_bdy_lnk( h_s (:,:,:) , 'T', 1., jbdy ) 249 CALL lbc_bdy_lnk( oa_i(:,:,:) , 'T', 1., jbdy ) 250 CALL lbc_bdy_lnk( a_ip(:,:,:) , 'T', 1., jbdy ) 251 CALL lbc_bdy_lnk( v_ip(:,:,:) , 'T', 1., jbdy ) 252 CALL lbc_bdy_lnk( s_i (:,:,:) , 'T', 1., jbdy ) 253 CALL lbc_bdy_lnk( t_su(:,:,:) , 'T', 1., jbdy ) 254 CALL lbc_bdy_lnk( v_i (:,:,:) , 'T', 1., jbdy ) 255 CALL lbc_bdy_lnk( v_s (:,:,:) , 'T', 1., jbdy ) 256 CALL lbc_bdy_lnk( sv_i(:,:,:) , 'T', 1., jbdy ) 257 CALL lbc_bdy_lnk( t_s (:,:,:,:), 'T', 1., jbdy ) 258 CALL lbc_bdy_lnk( e_s (:,:,:,:), 'T', 1., jbdy ) 259 CALL lbc_bdy_lnk( t_i (:,:,:,:), 'T', 1., jbdy ) 260 CALL lbc_bdy_lnk( e_i (:,:,:,:), 'T', 1., jbdy ) 266 261 ! 267 262 END SUBROUTINE bdy_ice_frs … … 272 267 !! *** SUBROUTINE bdy_ice_dyn *** 273 268 !! 274 !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries. 275 !! u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free 276 !! if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities 269 !! ** Purpose : Apply dynamics boundary conditions for sea-ice. 277 270 !! 278 !! 2013-06 : C. Rousset 271 !! ** Method : if this adjacent grid point is not ice free, then u_ice and v_ice take its value 272 !! if is ice free, then u_ice and v_ice are unchanged by BDY 273 !! they keep values calculated in rheology 274 !! 279 275 !!------------------------------------------------------------------------------ 280 276 CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points 281 277 ! 282 INTEGER :: jb, jgrd! dummy loop indices283 INTEGER :: ji, jj 284 INTEGER :: ib_bdy ! Loopindex278 INTEGER :: i_bdy, jgrd ! dummy loop indices 279 INTEGER :: ji, jj ! local scalar 280 INTEGER :: jbdy ! BDY set index 285 281 REAL(wp) :: zmsk1, zmsk2, zflag 286 282 !!------------------------------------------------------------------------------ 287 283 ! 288 DO ib_bdy=1, nb_bdy289 ! 290 SELECT CASE( cn_ice( ib_bdy) )284 DO jbdy=1, nb_bdy 285 ! 286 SELECT CASE( cn_ice(jbdy) ) 291 287 ! 292 288 CASE('none') … … 295 291 CASE('frs') 296 292 ! 297 IF( nn_ice_dta( ib_bdy) == 0 ) CYCLE ! case ice boundaries = initial conditions298 ! 293 IF( nn_ice_dta(jbdy) == 0 ) CYCLE ! case ice boundaries = initial conditions 294 ! ! do not change ice velocity (it is only computed by rheology) 299 295 SELECT CASE ( cd_type ) 300 296 ! 301 297 CASE ( 'U' ) 302 298 jgrd = 2 ! u velocity 303 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)304 ji = idx_bdy( ib_bdy)%nbi(jb,jgrd)305 jj = idx_bdy( ib_bdy)%nbj(jb,jgrd)306 zflag = idx_bdy( ib_bdy)%flagu(jb,jgrd)299 DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 300 ji = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 301 jj = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 302 zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 307 303 ! 308 304 IF ( ABS( zflag ) == 1. ) THEN ! eastern and western boundaries … … 320 316 ! 321 317 END DO 322 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )318 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., jbdy ) 323 319 ! 324 320 CASE ( 'V' ) 325 321 jgrd = 3 ! v velocity 326 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)327 ji = idx_bdy( ib_bdy)%nbi(jb,jgrd)328 jj = idx_bdy( ib_bdy)%nbj(jb,jgrd)329 zflag = idx_bdy( ib_bdy)%flagv(jb,jgrd)322 DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 323 ji = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 324 jj = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 325 zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 330 326 ! 331 327 IF ( ABS( zflag ) == 1. ) THEN ! northern and southern boundaries … … 343 339 ! 344 340 END DO 345 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )341 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., jbdy ) 346 342 ! 347 343 END SELECT -
NEMO/trunk/src/OCE/LBC/lbclnk.F90
r9799 r9890 38 38 ! 39 39 INTERFACE lbc_bdy_lnk 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 41 41 END INTERFACE 42 42 ! -
NEMO/trunk/src/OCE/LBC/lib_mpp.F90
r9667 r9890 88 88 PUBLIC mppsize 89 89 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 90 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 90 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 91 91 PUBLIC mpprank 92 92 … … 456 456 ! !== 4D array and array of 4D pointer ==! 457 457 ! 458 !!# define DIM_4d459 !!# define ROUTINE_BDY mpp_lnk_bdy_4d460 !!# include "mpp_bdy_generic.h90"461 !!# undef ROUTINE_BDY462 !!# undef DIM_4d458 # define DIM_4d 459 # define ROUTINE_BDY mpp_lnk_bdy_4d 460 # include "mpp_bdy_generic.h90" 461 # undef ROUTINE_BDY 462 # undef DIM_4d 463 463 464 464 !!---------------------------------------------------------------------- -
NEMO/trunk/src/OCE/timing.F90
r9598 r9890 211 211 WRITE(numtime,*) ' NEMO team' 212 212 WRITE(numtime,*) ' Ocean General Circulation Model' 213 WRITE(numtime,*) ' version 3.6 (2015) '213 WRITE(numtime,*) ' version 4.0 (2018) ' 214 214 WRITE(numtime,*) 215 215 WRITE(numtime,*) ' Timing Informations '
Note: See TracChangeset
for help on using the changeset viewer.