Changeset 13295 for NEMO/trunk/src/OCE/SBC
- Timestamp:
- 2020-07-10T20:24:21+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/SBC
- Files:
-
- 20 edited
-
cyclone.F90 (modified) (2 diffs)
-
fldread.F90 (modified) (7 diffs)
-
geo2ocean.F90 (modified) (2 diffs)
-
sbc_oce.F90 (modified) (1 diff)
-
sbcblk.F90 (modified) (14 diffs)
-
sbcblk_algo_coare3p0.F90 (modified) (3 diffs)
-
sbcblk_algo_coare3p6.F90 (modified) (2 diffs)
-
sbcblk_algo_ecmwf.F90 (modified) (2 diffs)
-
sbcblk_algo_ncar.F90 (modified) (3 diffs)
-
sbcblk_phy.F90 (modified) (8 diffs)
-
sbcblk_skin_coare.F90 (modified) (2 diffs)
-
sbcblk_skin_ecmwf.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (8 diffs)
-
sbcdcy.F90 (modified) (4 diffs)
-
sbcflx.F90 (modified) (2 diffs)
-
sbcice_cice.F90 (modified) (13 diffs)
-
sbcice_if.F90 (modified) (1 diff)
-
sbcrnf.F90 (modified) (7 diffs)
-
sbcssr.F90 (modified) (4 diffs)
-
sbcwave.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/SBC/cyclone.F90
r12377 r13295 147 147 zb = 2. 148 148 149 DO_2D _11_11149 DO_2D( 1, 1, 1, 1 ) 150 150 151 151 ! calc distance between TC center and any point following great circle … … 208 208 ENDIF 209 209 210 DO_2D _11_11210 DO_2D( 1, 1, 1, 1 ) 211 211 212 212 zzrglam = rad * glamt(ji,jj) - zrlon -
NEMO/trunk/src/OCE/SBC/fldread.F90
r13286 r13295 1169 1169 WRITE(clname,'(a3,i2.2)') 'src',jn 1170 1170 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1171 DO_2D _00_001171 DO_2D( 0, 0, 0, 0 ) 1172 1172 isrc = NINT(data_tmp(ji,jj)) - 1 1173 1173 ref_wgts(nxt_wgt)%data_jpi(ji,jj,jn) = 1 + MOD(isrc, ref_wgts(nxt_wgt)%ddims(1)) … … 1179 1179 WRITE(clname,'(a3,i2.2)') 'wgt',jn 1180 1180 CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' ) ! no call to lbc_lnk 1181 DO_2D _00_001181 DO_2D( 0, 0, 0, 0 ) 1182 1182 ref_wgts(nxt_wgt)%data_wgt(ji,jj,jn) = data_tmp(ji,jj) 1183 1183 END_2D … … 1442 1442 dta(:,:,:) = 0._wp 1443 1443 DO jn = 1,4 1444 DO_3D _00_00(1,ipk )1444 DO_3D( 0, 0, 0, 0, 1,ipk ) 1445 1445 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 1446 1446 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 … … 1486 1486 ! 1487 1487 !!$ DO jn = 1,4 1488 !!$ DO_3D _00_00(1,ipk )1488 !!$ DO_3D( 0, 0, 0, 0, 1,ipk ) 1489 1489 !!$ ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 1490 1490 !!$ nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 … … 1504 1504 ! 1505 1505 DO jn = 1,4 1506 DO_3D _00_00(1,ipk )1506 DO_3D( 0, 0, 0, 0, 1,ipk ) 1507 1507 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1508 1508 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) … … 1513 1513 END DO 1514 1514 DO jn = 1,4 1515 DO_3D _00_00(1,ipk )1515 DO_3D( 0, 0, 0, 0, 1,ipk ) 1516 1516 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1517 1517 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) … … 1522 1522 END DO 1523 1523 DO jn = 1,4 1524 DO_3D _00_00(1,ipk )1524 DO_3D( 0, 0, 0, 0, 1,ipk ) 1525 1525 ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 1526 1526 nj = ref_wgts(kw)%data_jpj(ji,jj,jn) -
NEMO/trunk/src/OCE/SBC/geo2ocean.F90
r13226 r13295 160 160 ! (computation done on the north stereographic polar plane) 161 161 ! 162 DO_2D _00_01162 DO_2D( 0, 0, 0, 1 ) 163 163 ! 164 164 zlam = plamt(ji,jj) ! north pole direction & modulous (at t-point) … … 249 249 ! =============== ! 250 250 251 DO_2D _00_01251 DO_2D( 0, 0, 0, 1 ) 252 252 IF( MOD( ABS( plamv(ji,jj) - plamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN 253 253 gsint(ji,jj) = 0. -
NEMO/trunk/src/OCE/SBC/sbc_oce.F90
r13226 r13295 217 217 !!--------------------------------------------------------------------- 218 218 zcoef = 0.5 / ( zrhoa * zcdrag ) 219 DO_2D _00_00219 DO_2D( 0, 0, 0, 0 ) 220 220 ztx = utau(ji-1,jj ) + utau(ji,jj) 221 221 zty = vtau(ji ,jj-1) + vtau(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcblk.F90
r13226 r13295 568 568 zwnd_j(:,:) = 0._wp 569 569 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add analytical tropical cyclone (Vincent et al. JGR 2012) 570 DO_2D _11_11570 DO_2D( 1, 1, 1, 1 ) 571 571 zwnd_i(ji,jj) = pwndi(ji,jj) + zwnd_i(ji,jj) 572 572 zwnd_j(ji,jj) = pwndj(ji,jj) + zwnd_j(ji,jj) … … 576 576 #else 577 577 ! ... scalar wind module at T-point (not masked) 578 DO_2D _11_11578 DO_2D( 1, 1, 1, 1 ) 579 579 wndm(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 580 580 END_2D … … 628 628 ! use scalar version of gamma_moist() ... 629 629 IF( ln_tpot ) THEN 630 DO_2D _11_11630 DO_2D( 1, 1, 1, 1 ) 631 631 ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 632 632 END_2D … … 690 690 691 691 IF( ln_abl ) THEN !== ABL formulation ==! multiplication by rho_air and turbulent fluxes computation done in ablstp 692 DO_2D _11_11692 DO_2D( 1, 1, 1, 1 ) 693 693 zztmp = zU_zu(ji,jj) 694 694 wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod … … 710 710 pevp(:,:) = pevp(:,:) * tmask(:,:,1) 711 711 712 DO_2D _11_11712 DO_2D( 1, 1, 1, 1 ) 713 713 IF( wndm(ji,jj) > 0._wp ) THEN 714 714 zztmp = taum(ji,jj) / wndm(ji,jj) … … 728 728 IF( ln_crt_fbk ) THEN ! aply eq. 10 and 11 of Renault et al. 2020 (doi: 10.1029/2019MS001715) 729 729 zstmax = MIN( rn_stau_a * 3._wp + rn_stau_b, 0._wp ) ! set the max value of Stau corresponding to a wind of 3 m/s (<0) 730 DO_2D _01_01! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop730 DO_2D( 0, 1, 0, 1 ) ! end at jpj and jpi, as ztau_j(ji,jj+1) ztau_i(ji+1,jj) used in the next loop 731 731 zstau = MIN( rn_stau_a * wndm(ji,jj) + rn_stau_b, zstmax ) ! stau (<0) must be smaller than zstmax 732 732 ztau_i(ji,jj) = ztau_i(ji,jj) + zstau * ( 0.5_wp * ( pu(ji-1,jj ) + pu(ji,jj) ) - puatm(ji,jj) ) … … 739 739 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 740 740 ! Note that coastal wind stress is not used in the code... so this extra care has no effect 741 DO_2D _00_00! start loop at 2, in case ln_crt_fbk = T741 DO_2D( 0, 0, 0, 0 ) ! start loop at 2, in case ln_crt_fbk = T 742 742 utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj ) ) & 743 743 & * MAX(tmask(ji,jj,1),tmask(ji+1,jj,1)) … … 828 828 829 829 ! use scalar version of L_vap() for AGRIF compatibility 830 DO_2D _11_11830 DO_2D( 1, 1, 1, 1 ) 831 831 zqla(ji,jj) = - L_vap( ztskk(ji,jj) ) * pevp(ji,jj) ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 832 832 END_2D … … 933 933 ! ------------------------------------------------------------ ! 934 934 ! C-grid ice dynamics : U & V-points (same as ocean) 935 DO_2D _11_11935 DO_2D( 1, 1, 1, 1 ) 936 936 wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 937 937 END_2D … … 959 959 ! ---------------------------------------------------- ! 960 960 ! supress moving ice in wind stress computation as we don't know how to do it properly... 961 DO_2D _01_01! at T point961 DO_2D( 0, 1, 0, 1 ) ! at T point 962 962 putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 963 963 pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 964 964 END_2D 965 965 ! 966 DO_2D _00_00! U & V-points (same as ocean).966 DO_2D( 0, 0, 0, 0 ) ! U & V-points (same as ocean). 967 967 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 968 968 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) … … 978 978 zztmp1 = 11637800.0_wp 979 979 zztmp2 = -5897.8_wp 980 DO_2D _11_11980 DO_2D( 1, 1, 1, 1 ) 981 981 pcd_dui(ji,jj) = zcd_dui (ji,jj) 982 982 pseni (ji,jj) = wndm_ice(ji,jj) * Ch_ice(ji,jj) … … 1233 1233 ! 1234 1234 DO jl = 1, jpl 1235 DO_2D _11_111235 DO_2D( 1, 1, 1, 1 ) 1236 1236 zhe = ( rn_cnd_s * phi(ji,jj,jl) + rcnd_i * phs(ji,jj,jl) ) * zfac ! Effective thickness 1237 1237 IF( zhe >= zfac2 ) zgfac(ji,jj,jl) = MIN( 2._wp, 0.5_wp * ( 1._wp + LOG( zhe * zfac3 ) ) ) ! Enhanced conduction factor … … 1248 1248 ! 1249 1249 DO jl = 1, jpl 1250 DO_2D _11_111250 DO_2D( 1, 1, 1, 1 ) 1251 1251 ! 1252 1252 zkeff_h = zfac * zgfac(ji,jj,jl) / & ! Effective conductivity of the snow-ice system divided by thickness … … 1396 1396 zqi_sat(:,:) = q_sat( ptm_su(:,:), pslp(:,:) ) ! saturation humidity over ice [kg/kg] 1397 1397 ! 1398 DO_2D _00_001398 DO_2D( 0, 0, 0, 0 ) 1399 1399 ! Virtual potential temperature [K] 1400 1400 zthetav_os = zst(ji,jj) * ( 1._wp + rctv0 * zqo_sat(ji,jj) ) ! over ocean -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_coare3p0.F90
r12615 r13295 394 394 !!------------------------------------------------------------------- 395 395 ! 396 DO_2D _11_11396 DO_2D( 1, 1, 1, 1 ) 397 397 ! 398 398 zw = pwnd(ji,jj) ! wind speed … … 430 430 !!---------------------------------------------------------------------------------- 431 431 ! 432 DO_2D _11_11432 DO_2D( 1, 1, 1, 1 ) 433 433 ! 434 434 zta = pzeta(ji,jj) … … 481 481 REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 482 482 ! 483 DO_2D _11_11483 DO_2D( 1, 1, 1, 1 ) 484 484 ! 485 485 zta = pzeta(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_coare3p6.F90
r12615 r13295 430 430 !!---------------------------------------------------------------------------------- 431 431 ! 432 DO_2D _11_11432 DO_2D( 1, 1, 1, 1 ) 433 433 ! 434 434 zta = pzeta(ji,jj) … … 481 481 REAL(wp) :: zta, zphi_h, zphi_c, zpsi_k, zpsi_c, zf, zc, zstab 482 482 ! 483 DO_2D _11_11483 DO_2D( 1, 1, 1, 1 ) 484 484 ! 485 485 zta = pzeta(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r12615 r13295 410 410 REAL(wp) :: zzeta, zx, ztmp, psi_unst, psi_stab, stab 411 411 !!---------------------------------------------------------------------------------- 412 DO_2D _11_11412 DO_2D( 1, 1, 1, 1 ) 413 413 ! 414 414 zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): … … 455 455 !!---------------------------------------------------------------------------------- 456 456 ! 457 DO_2D _11_11457 DO_2D( 1, 1, 1, 1 ) 458 458 ! 459 459 zzeta = MIN(pzeta(ji,jj) , 5._wp) ! Very stable conditions (L positif and big!): -
NEMO/trunk/src/OCE/SBC/sbcblk_algo_ncar.F90
r12615 r13295 241 241 !!---------------------------------------------------------------------------------- 242 242 ! 243 DO_2D _11_11243 DO_2D( 1, 1, 1, 1 ) 244 244 ! 245 245 zw = pw10(ji,jj) … … 277 277 REAL(wp) :: zx2, zx, zstab ! local scalars 278 278 !!---------------------------------------------------------------------------------- 279 DO_2D _11_11279 DO_2D( 1, 1, 1, 1 ) 280 280 zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 281 281 zx2 = MAX( zx2 , 1._wp ) … … 308 308 !!---------------------------------------------------------------------------------- 309 309 ! 310 DO_2D _11_11310 DO_2D( 1, 1, 1, 1 ) 311 311 zx2 = SQRT( ABS( 1._wp - 16._wp*pzeta(ji,jj) ) ) 312 312 zx2 = MAX( zx2 , 1._wp ) -
NEMO/trunk/src/OCE/SBC/sbcblk_phy.F90
r13165 r13295 181 181 !!---------------------------------------------------------------------------------- 182 182 ! 183 DO_2D _11_11183 DO_2D( 1, 1, 1, 1 ) 184 184 ztc = ptak(ji,jj) - rt0 ! air temp, in deg. C 185 185 ztc2 = ztc*ztc … … 270 270 INTEGER :: ji, jj ! dummy loop indices 271 271 !!---------------------------------------------------------------------------------- 272 DO_2D _11_11272 DO_2D( 1, 1, 1, 1 ) 273 273 gamma_moist_vctr(ji,jj) = gamma_moist_sclr( ptak(ji,jj), pqa(ji,jj) ) 274 274 END_2D … … 315 315 !!------------------------------------------------------------------- 316 316 ! 317 DO_2D _11_11317 DO_2D( 1, 1, 1, 1 ) 318 318 ! 319 319 zqa = (1._wp + rctv0*pqa(ji,jj)) … … 351 351 !!------------------------------------------------------------------- 352 352 ! 353 DO_2D _11_11353 DO_2D( 1, 1, 1, 1 ) 354 354 ! 355 355 zqa = 0.5_wp*(pqa(ji,jj)+pssq(ji,jj)) ! ~ mean q within the layer... … … 448 448 !!---------------------------------------------------------------------------------- 449 449 ! 450 DO_2D _11_11450 DO_2D( 1, 1, 1, 1 ) 451 451 ! 452 452 ze_sat = e_sat_sclr( ptak(ji,jj) ) … … 473 473 !!---------------------------------------------------------------------------------- 474 474 ! 475 DO_2D _11_11475 DO_2D( 1, 1, 1, 1 ) 476 476 ze = prha(ji,jj)*e_sat_sclr(ptak(ji,jj)) 477 477 q_air_rh(ji,jj) = ze*reps0/(pslp(ji,jj) - (1. - reps0)*ze) … … 511 511 INTEGER :: ji, jj ! dummy loop indices 512 512 !!---------------------------------------------------------------------------------- 513 DO_2D _11_11513 DO_2D( 1, 1, 1, 1 ) 514 514 515 515 zdt = pTa(ji,jj) - pTs(ji,jj) ; zdt = SIGN( MAX(ABS(zdt),1.E-6_wp), zdt ) … … 621 621 IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 622 622 623 DO_2D _11_11623 DO_2D( 1, 1, 1, 1 ) 624 624 625 625 CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & -
NEMO/trunk/src/OCE/SBC/sbcblk_skin_coare.F90
r12489 r13295 89 89 REAL(wp) :: zQabs, zdlt, zfr, zalfa, zqlat, zus 90 90 !!--------------------------------------------------------------------- 91 DO_2D _11_1191 DO_2D( 1, 1, 1, 1 ) 92 92 93 93 zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, … … 156 156 ztime = REAL(nsec_day,wp)/(24._wp*3600._wp) ! time of current time step since 00:00 for current day (UTC) -> ztime = 0 -> 00:00 / ztime = 0.5 -> 12:00 ... 157 157 158 DO_2D _11_11158 DO_2D( 1, 1, 1, 1 ) 159 159 160 160 l_exit = .FALSE. -
NEMO/trunk/src/OCE/SBC/sbcblk_skin_ecmwf.F90
r12489 r13295 95 95 REAL(wp) :: zQabs, zdlt, zfr, zalfa, zus 96 96 !!--------------------------------------------------------------------- 97 DO_2D _11_1197 DO_2D( 1, 1, 1, 1 ) 98 98 99 99 zQabs = pQnsol(ji,jj) ! first guess of heat flux absorbed within the viscous sublayer of thicknes delta, … … 173 173 IF( PRESENT(pustk) ) l_pustk_known = .TRUE. 174 174 175 DO_2D _11_11175 DO_2D( 1, 1, 1, 1 ) 176 176 177 177 zHwl = Hz_wl(ji,jj) ! first guess for warm-layer depth (and unique..., less advanced than COARE3p6 !) -
NEMO/trunk/src/OCE/SBC/sbccpl.F90
r13286 r13295 1170 1170 ! 1171 1171 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1172 DO_2D _00_001172 DO_2D( 0, 0, 0, 0 ) 1173 1173 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1174 1174 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) … … 1194 1194 ! => need to be done only when otx1 was changed 1195 1195 IF( llnewtx ) THEN 1196 DO_2D _00_001196 DO_2D( 0, 0, 0, 0 ) 1197 1197 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1198 1198 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) … … 1219 1219 IF( llnewtau ) THEN 1220 1220 zcoef = 1. / ( zrhoa * zcdrag ) 1221 DO_2D _11_111221 DO_2D( 1, 1, 1, 1 ) 1222 1222 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1223 1223 END_2D … … 1549 1549 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1550 1550 CASE( 'T' ) 1551 DO_2D _00_001551 DO_2D( 0, 0, 0, 0 ) 1552 1552 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1553 1553 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) … … 2365 2365 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2366 2366 CASE( 'oce only' ) ! C-grid ==> T 2367 DO_2D _00_002367 DO_2D( 0, 0, 0, 0 ) 2368 2368 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2369 2369 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2370 2370 END_2D 2371 2371 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2372 DO_2D _00_002372 DO_2D( 0, 0, 0, 0 ) 2373 2373 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2374 2374 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2378 2378 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2379 2379 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2380 DO_2D _00_002380 DO_2D( 0, 0, 0, 0 ) 2381 2381 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2382 2382 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) … … 2442 2442 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2443 2443 CASE( 'oce only' ) ! C-grid ==> T 2444 DO_2D _00_002444 DO_2D( 0, 0, 0, 0 ) 2445 2445 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2446 2446 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2447 2447 END_2D 2448 2448 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2449 DO_2D _00_002449 DO_2D( 0, 0, 0, 0 ) 2450 2450 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2451 2451 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2455 2455 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2456 2456 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2457 DO_2D _00_002457 DO_2D( 0, 0, 0, 0 ) 2458 2458 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2459 2459 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcdcy.F90
r12489 r13295 110 110 111 111 imask_night(:,:) = 0 112 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 113 113 ztmpm = 0._wp 114 114 IF( ABS(rab(ji,jj)) < 1. ) THEN ! day duration is less than 24h … … 193 193 194 194 zsin = SIN( zdecrad ) ; zcos = COS( zdecrad ) 195 DO_2D _11_11195 DO_2D( 1, 1, 1, 1 ) 196 196 ztmp = rad * gphit(ji,jj) 197 197 raa(ji,jj) = SIN( ztmp ) * zsin … … 202 202 ! rab to test if the day time is equal to 0, less than 24h of full day 203 203 rab(:,:) = -raa(:,:) / rbb(:,:) 204 DO_2D _11_11204 DO_2D( 1, 1, 1, 1 ) 205 205 IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 206 206 ! When is it night? … … 226 226 ! Avoid possible infinite scaling factor, associated with very short daylight 227 227 ! periods, by ignoring periods less than 1/1000th of a day (ticket #1040) 228 DO_2D _11_11228 DO_2D( 1, 1, 1, 1 ) 229 229 IF( ABS(rab(ji,jj)) < 1._wp ) THEN ! day duration is less than 24h 230 230 rscal(ji,jj) = 0.0_wp -
NEMO/trunk/src/OCE/SBC/sbcflx.F90
r13226 r13295 129 129 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 130 130 ENDIF 131 DO_2D _11_11131 DO_2D( 1, 1, 1, 1 ) 132 132 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 133 133 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) … … 143 143 ! ! module of wind stress and wind speed at T-point 144 144 zcoef = 1. / ( zrhoa * zcdrag ) 145 DO_2D _00_00145 DO_2D( 0, 0, 0, 0 ) 146 146 ztx = utau(ji-1,jj ) + utau(ji,jj) 147 147 zty = vtau(ji ,jj-1) + vtau(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcice_cice.F90
r13286 r13295 217 217 ! T point to U point 218 218 ! T point to V point 219 DO_2D _10_10219 DO_2D( 1, 0, 1, 0 ) 220 220 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 221 221 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) … … 312 312 ! x comp of wind stress (CI_1) 313 313 ! U point to F point 314 DO_2D _10_11314 DO_2D( 1, 0, 1, 1 ) 315 315 ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) & 316 316 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1) … … 320 320 ! y comp of wind stress (CI_2) 321 321 ! V point to F point 322 DO_2D _11_10322 DO_2D( 1, 1, 1, 0 ) 323 323 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 324 324 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) … … 335 335 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub 336 336 ! End of temporary code 337 DO_2D _11_11337 DO_2D( 1, 1, 1, 1 ) 338 338 IF(fr_i(ji,jj).eq.0.0) THEN 339 339 DO jl=1,ncat … … 437 437 ! x comp and y comp of surface ocean current 438 438 ! U point to F point 439 DO_2D _10_11439 DO_2D( 1, 0, 1, 1 ) 440 440 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 441 441 END_2D … … 443 443 444 444 ! V point to F point 445 DO_2D _11_10445 DO_2D( 1, 1, 1, 0 ) 446 446 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 447 447 END_2D … … 467 467 ! x comp and y comp of sea surface slope (on F points) 468 468 ! T point to F point 469 DO_2D _10_10469 DO_2D( 1, 0, 1, 0 ) 470 470 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 471 471 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) … … 474 474 475 475 ! T point to F point 476 DO_2D _10_10476 DO_2D( 1, 0, 1, 0 ) 477 477 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 478 478 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) … … 503 503 ss_iou(:,:)=0.0 504 504 ! F point to U point 505 DO_2D _00_00505 DO_2D( 0, 0, 0, 0 ) 506 506 ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1) 507 507 END_2D … … 513 513 ! F point to V point 514 514 515 DO_2D _10_00515 DO_2D( 1, 0, 0, 0 ) 516 516 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 517 517 END_2D … … 597 597 CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1.0_wp ) 598 598 599 DO_2D _11_11599 DO_2D( 1, 1, 1, 1 ) 600 600 nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 601 601 END_2D … … 621 621 ! T point to U point 622 622 ! T point to V point 623 DO_2D _10_10623 DO_2D( 1, 0, 1, 0 ) 624 624 fr_iu(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji+1,jj))*umask(ji,jj,1) 625 625 fr_iv(ji,jj)=0.5*(fr_i(ji,jj)+fr_i(ji,jj+1))*vmask(ji,jj,1) … … 981 981 982 982 pn(:,:)=0.0 983 DO_2D _10_10983 DO_2D( 1, 0, 1, 0 ) 984 984 pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1) 985 985 END_2D -
NEMO/trunk/src/OCE/SBC/sbcice_if.F90
r12377 r13295 109 109 110 110 ! Flux and ice fraction computation 111 DO_2D _11_11111 DO_2D( 1, 1, 1, 1 ) 112 112 ! 113 113 zt_fzp = fr_i(ji,jj) ! freezing point temperature -
NEMO/trunk/src/OCE/SBC/sbcrnf.F90
r13286 r13295 209 209 IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN !== runoff distributed over several levels ==! 210 210 IF( ln_linssh ) THEN !* constant volume case : just apply the runoff input flow 211 DO_2D _11_11211 DO_2D( 1, 1, 1, 1 ) 212 212 DO jk = 1, nk_rnf(ji,jj) 213 213 phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rho0 / h_rnf(ji,jj) … … 215 215 END_2D 216 216 ELSE !* variable volume case 217 DO_2D _11_11217 DO_2D( 1, 1, 1, 1 ) 218 218 h_rnf(ji,jj) = 0._wp 219 219 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres … … 361 361 ! 362 362 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 363 DO_2D _11_11363 DO_2D( 1, 1, 1, 1 ) 364 364 IF( h_rnf(ji,jj) > 0._wp ) THEN 365 365 jk = 2 … … 374 374 ENDIF 375 375 END_2D 376 DO_2D _11_11376 DO_2D( 1, 1, 1, 1 ) 377 377 h_rnf(ji,jj) = 0._wp 378 378 DO jk = 1, nk_rnf(ji,jj) … … 404 404 WHERE( zrnfcl(:,:,1) > 0._wp ) h_rnf(:,:) = zacoef * zrnfcl(:,:,1) ! compute depth for all runoffs 405 405 ! 406 DO_2D _11_11406 DO_2D( 1, 1, 1, 1 ) 407 407 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 408 408 jk = mbkt(ji,jj) … … 412 412 ! 413 413 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 414 DO_2D _11_11414 DO_2D( 1, 1, 1, 1 ) 415 415 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 416 416 jk = 2 … … 423 423 END_2D 424 424 ! 425 DO_2D _11_11425 DO_2D( 1, 1, 1, 1 ) 426 426 h_rnf(ji,jj) = 0._wp 427 427 DO jk = 1, nk_rnf(ji,jj) -
NEMO/trunk/src/OCE/SBC/sbcssr.F90
r13226 r13295 95 95 ! 96 96 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 97 DO_2D _11_1197 DO_2D( 1, 1, 1, 1 ) 98 98 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 99 99 qns(ji,jj) = qns(ji,jj) + zqrp … … 105 105 ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1 106 106 ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1 107 DO_2D _11_11107 DO_2D( 1, 1, 1, 1 ) 108 108 SELECT CASE ( nn_sssr_ice ) 109 109 CASE ( 0 ) ; coefice(ji,jj) = 1._wp - fr_i(ji,jj) ! no/reduced damping under ice … … 115 115 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx)) 116 116 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 117 DO_2D _11_11117 DO_2D( 1, 1, 1, 1 ) 118 118 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 119 119 & * coefice(ji,jj) & ! Optional control of damping under sea-ice … … 126 126 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 127 127 zerp_bnd = rn_sssr_bnd / rday ! - - 128 DO_2D _11_11128 DO_2D( 1, 1, 1, 1 ) 129 129 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 130 130 & * coefice(ji,jj) & ! Optional control of damping under sea-ice -
NEMO/trunk/src/OCE/SBC/sbcwave.F90
r13237 r13295 113 113 IF( ll_st_bv_li ) THEN ! (Eq. (19) in Breivik et al. (2014) ) 114 114 zfac = 2.0_wp * rpi / 16.0_wp 115 DO_2D _11_11115 DO_2D( 1, 1, 1, 1 ) 116 116 ! Stokes drift velocity estimated from Hs and Tmean 117 117 ztransp = zfac * hsw(ji,jj)*hsw(ji,jj) / MAX( wmp(ji,jj), 0.0000001_wp ) … … 121 121 zk_t(ji,jj) = ABS( tsd2d(ji,jj) ) / MAX( ABS( 5.97_wp*ztransp ), 0.0000001_wp ) 122 122 END_2D 123 DO_2D _10_10123 DO_2D( 1, 0, 1, 0 ) 124 124 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 125 125 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) … … 129 129 END_2D 130 130 ELSE IF( ll_st_peakfr ) THEN ! peak wave number calculated from the peak frequency received by the wave model 131 DO_2D _11_11131 DO_2D( 1, 1, 1, 1 ) 132 132 zk_t(ji,jj) = ( 2.0_wp * rpi * wfreq(ji,jj) ) * ( 2.0_wp * rpi * wfreq(ji,jj) ) / grav 133 133 END_2D 134 DO_2D _10_10134 DO_2D( 1, 0, 1, 0 ) 135 135 zk_u(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji+1,jj) ) 136 136 zk_v(ji,jj) = 0.5_wp * ( zk_t(ji,jj) + zk_t(ji,jj+1) ) … … 143 143 ! !== horizontal Stokes Drift 3D velocity ==! 144 144 IF( ll_st_bv2014 ) THEN 145 DO_3D _00_00(1, jpkm1 )145 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 146 146 zdep_u = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji+1,jj,jk,Kmm) ) 147 147 zdep_v = 0.5_wp * ( gdept(ji,jj,jk,Kmm) + gdept(ji,jj+1,jk,Kmm) ) … … 158 158 ELSE IF( ll_st_li2017 .OR. ll_st_peakfr ) THEN 159 159 ALLOCATE( zstokes_psi_u_top(jpi,jpj), zstokes_psi_v_top(jpi,jpj) ) 160 DO_2D _10_10160 DO_2D( 1, 0, 1, 0 ) 161 161 zstokes_psi_u_top(ji,jj) = 0._wp 162 162 zstokes_psi_v_top(ji,jj) = 0._wp … … 164 164 zsqrtpi = SQRT(rpi) 165 165 z_two_thirds = 2.0_wp / 3.0_wp 166 DO_3D _00_00(1, jpkm1 )166 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 167 167 zbot_u = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji+1,jj,jk+1,Kmm) ) ! 2 * bottom depth 168 168 zbot_v = ( gdepw(ji,jj,jk+1,Kmm) + gdepw(ji,jj+1,jk+1,Kmm) ) ! 2 * bottom depth … … 204 204 ! !== vertical Stokes Drift 3D velocity ==! 205 205 ! 206 DO_3D _01_01(1, jpkm1 )206 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) 207 207 ze3divh(ji,jj,jk) = ( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) * usd(ji ,jj,jk) & 208 208 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * usd(ji-1,jj,jk) & … … 263 263 ! 264 264 IF( ln_tauw ) THEN 265 DO_2D _10_10265 DO_2D( 1, 0, 1, 0 ) 266 266 ! Stress components at u- & v-points 267 267 utau(ji,jj) = 0.5_wp * ( tauw_x(ji,jj) + tauw_x(ji+1,jj) )
Note: See TracChangeset
for help on using the changeset viewer.
