Changeset 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
- Timestamp:
- 2015-04-13T15:08:59+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
r3821 r5208 70 70 ! and ssh which is used to calculate gradients 71 71 72 uo_e(:,:) = 0._wp ; uo_e(1:jpi, 1:jpj) = ssu_m(:,:) 73 vo_e(:,:) = 0._wp ; vo_e(1:jpi, 1:jpj) = ssv_m(:,:) 74 ff_e(:,:) = 0._wp ; ff_e(1:jpi, 1:jpj) = ff (:,:) 75 ua_e(:,:) = 0._wp ; ua_e(1:jpi, 1:jpj) = utau (:,:) 76 va_e(:,:) = 0._wp ; va_e(1:jpi, 1:jpj) = vtau (:,:) 77 78 CALL lbc_lnk_e( uo_e, 'U', -1._wp, 1, 1 ) 79 CALL lbc_lnk_e( vo_e, 'V', -1._wp, 1, 1 ) 80 CALL lbc_lnk_e( ff_e, 'F', +1._wp, 1, 1 ) 81 CALL lbc_lnk_e( ua_e, 'U', -1._wp, 1, 1 ) 82 CALL lbc_lnk_e( va_e, 'V', -1._wp, 1, 1 ) 72 uo_e(:,:) = 0._wp ; uo_e(1:jpi, 1:jpj) = ssu_m(:,:) * umask(:,:,1) 73 vo_e(:,:) = 0._wp ; vo_e(1:jpi, 1:jpj) = ssv_m(:,:) * vmask(:,:,1) 74 ff_e(:,:) = 0._wp ; ff_e(1:jpi, 1:jpj) = ff (:,:) 75 tt_e(:,:) = 0._wp ; tt_e(1:jpi, 1:jpj) = sst_m(:,:) 76 fr_e(:,:) = 0._wp ; fr_e(1:jpi, 1:jpj) = fr_i (:,:) 77 ua_e(:,:) = 0._wp ; ua_e(1:jpi, 1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 78 va_e(:,:) = 0._wp ; va_e(1:jpi, 1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 79 80 CALL lbc_lnk_icb( uo_e, 'U', -1._wp, 1, 1 ) 81 CALL lbc_lnk_icb( vo_e, 'V', -1._wp, 1, 1 ) 82 CALL lbc_lnk_icb( ff_e, 'F', +1._wp, 1, 1 ) 83 CALL lbc_lnk_icb( ua_e, 'U', -1._wp, 1, 1 ) 84 CALL lbc_lnk_icb( va_e, 'V', -1._wp, 1, 1 ) 85 CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 ) 86 CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 ) 87 #if defined key_lim2 88 hicth(:,:) = 0._wp ; hicth(1:jpi,1:jpj) = hicif(:,:) 89 CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 ) 90 #endif 83 91 84 92 #if defined key_lim2 || defined key_lim3 … … 86 94 vi_e(:,:) = 0._wp ; vi_e(1:jpi, 1:jpj) = v_ice(:,:) 87 95 88 CALL lbc_lnk_ e( ui_e, 'U', -1._wp, 1, 1 )89 CALL lbc_lnk_ e( vi_e, 'V', -1._wp, 1, 1 )96 CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 ) 97 CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 ) 90 98 #endif 91 99 … … 93 101 !! so fudge some numbers all the way around the boundary 94 102 95 ssh_e(:,:) = 0._wp ; ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) 103 ssh_e(:,:) = 0._wp ; ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 96 104 ssh_e(0 , :) = ssh_e(1 , :) 97 105 ssh_e(jpi+1, :) = ssh_e(jpi, :) … … 102 110 ssh_e(0,jpj+1) = ssh_e(1,jpj) 103 111 ssh_e(jpi+1,jpj+1) = ssh_e(jpi,jpj) 104 CALL lbc_lnk_ e( ssh_e, 'T', +1._wp, 1, 1 )112 CALL lbc_lnk_icb( ssh_e, 'T', +1._wp, 1, 1 ) 105 113 ! 106 114 END SUBROUTINE icb_utl_copy … … 133 141 !!---------------------------------------------------------------------- 134 142 135 pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) 143 pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) ! scale factors 136 144 pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 137 145 ! 138 146 puo = icb_utl_bilin_h( uo_e, pi, pj, 'U' ) ! ocean velocities 139 147 pvo = icb_utl_bilin_h( vo_e, pi, pj, 'V' ) 140 psst = icb_utl_bilin ( sst_m, pi, pj, 'T' )! SST141 pcn = icb_utl_bilin ( fr_i , pi, pj, 'T' )! ice concentration148 psst = icb_utl_bilin_h( tt_e, pi, pj, 'T' ) ! SST 149 pcn = icb_utl_bilin_h( fr_e , pi, pj, 'T' ) ! ice concentration 142 150 pff = icb_utl_bilin_h( ff_e , pi, pj, 'F' ) ! Coriolis parameter 143 151 ! 144 152 pua = icb_utl_bilin_h( ua_e , pi, pj, 'U' ) ! 10m wind 145 153 pva = icb_utl_bilin_h( va_e , pi, pj, 'V' ) ! here (ua,va) are stress => rough conversion from stress to speed 146 zcd = 1.22_wp * 1.5e-3_wp 154 zcd = 1.22_wp * 1.5e-3_wp ! air density * drag coefficient 147 155 zmod = 1._wp / MAX( 1.e-20, SQRT( zcd * SQRT( pua*pua + pva*pva) ) ) 148 pua = pua * zmod 156 pua = pua * zmod ! note: stress module=0 necessarly implies ua=va=0 149 157 pva = pva * zmod 150 158 … … 155 163 phi = 0._wp ! LIM-3 case (to do) 156 164 # else 157 phi = icb_utl_bilin (hicif, pi, pj, 'T' )! ice thickness165 phi = icb_utl_bilin_h(hicth, pi, pj, 'T' ) ! ice thickness 158 166 # endif 159 167 #else … … 217 225 END SELECT 218 226 ! 219 ! find position in this processor 220 ii = mi1( ii ) 221 ij = mj1( ij ) 227 ! find position in this processor. Prevent near edge problems (see #1389) 228 229 if (ii.lt.mig(1)) then 230 ii = 1 231 else if (ii.gt.mig(jpi)) then 232 ii = jpi 233 else 234 ii = mi1( ii ) 235 end if 236 237 if (ij.lt.mjg(1)) then 238 ij = 1 239 else if (ij.gt.mjg(jpj)) then 240 ij = jpj 241 else 242 ij = mj1( ij ) 243 end if 244 245 if (ij.eq.jpj) ij=ij-1 246 if (ii.eq.jpi) ii=ii-1 247 222 248 ! 223 249 icb_utl_bilin_h = ( pfld(ii,ij ) * (1.-zi) + pfld(ii+1,ij ) * zi ) * (1.-zj) & … … 271 297 END SELECT 272 298 ! 273 ! find position in this processor 274 ii = mi1( ii ) 275 ij = mj1( ij ) 276 ! 299 ! find position in this processor. Prevent near edge problems (see #1389) 300 301 if (ii.lt.mig(1)) then 302 ii = 1 303 else if (ii.gt.mig(jpi)) then 304 ii = jpi 305 else 306 ii = mi1( ii ) 307 end if 308 309 if (ij.lt.mjg(1)) then 310 ij = 1 311 else if (ij.gt.mjg(jpj)) then 312 ij = jpj 313 else 314 ij = mj1( ij ) 315 end if 316 317 if (ij.eq.jpj) ij=ij-1 318 if (ii.eq.jpi) ii=ii-1 319 277 320 icb_utl_bilin = ( pfld(ii,ij ) * (1.-zi) + pfld(ii+1,ij ) * zi ) * (1.-zj) & 278 321 & + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) * zj … … 309 352 zj = pj - REAL(ij,wp) 310 353 ! 311 ! find position in this processor !!gm use here mig, mjg arrays 312 ii = mi1( ii ) 313 ij = mj1( ij ) 354 ! find position in this processor. Prevent near edge problems (see #1389) 355 356 if (ii.lt.mig(1)) then 357 ii = 1 358 else if (ii.gt.mig(jpi)) then 359 ii = jpi 360 else 361 ii = mi1( ii ) 362 end if 363 364 if (ij.lt.mjg(1)) then 365 ij = 1 366 else if (ij.gt.mjg(jpj)) then 367 ij = jpj 368 else 369 ij = mj1( ij ) 370 end if 371 372 if (ij.eq.jpj) ij=ij-1 373 if (ii.eq.jpi) ii=ii-1 374 314 375 z4(1) = pfld(ii ,ij ) 315 376 z4(2) = pfld(ii+1,ij ) … … 359 420 zj = pj - REAL(ij,wp) 360 421 361 ! find position in this processor 362 ii = mi1( ii ) 363 ij = mj1( ij ) 422 ! find position in this processor. Prevent near edge problems (see #1389) 423 424 if (ii.lt.mig(1)) then 425 ii = 1 426 else if (ii.gt.mig(jpi)) then 427 ii = jpi 428 else 429 ii = mi1( ii ) 430 end if 431 432 if (ij.lt.mjg(1)) then 433 ij = 1 434 else if (ij.gt.mjg(jpj)) then 435 ij = jpj 436 else 437 ij = mj1( ij ) 438 end if 439 440 if (ij.eq.jpj) ij=ij-1 441 if (ii.eq.jpi) ii=ii-1 364 442 365 443 IF( 0.0_wp <= zi .AND. zi < 0.5_wp ) THEN
Note: See TracChangeset
for help on using the changeset viewer.