Changeset 886 for branches/dev_001_SBC/NEMO/LIM_SRC_3
- Timestamp:
- 2008-04-11T11:24:17+02:00 (16 years ago)
- Location:
- branches/dev_001_SBC/NEMO/LIM_SRC_3
- Files:
-
- 1 added
- 3 deleted
- 17 edited
-
ice.F90 (modified) (1 diff)
-
iceini.F90 (modified) (4 diffs)
-
icestp.F90 (deleted)
-
limdia.F90 (modified) (6 diffs)
-
limdyn.F90 (modified) (6 diffs)
-
limflx.F90 (deleted)
-
limistate.F90 (modified) (6 diffs)
-
limitd_me.F90 (modified) (7 diffs)
-
limrhg.F90 (modified) (3 diffs)
-
limrst.F90 (modified) (12 diffs)
-
limrst_dimg.h90 (deleted)
-
limsbc.F90 (added)
-
limthd.F90 (modified) (13 diffs)
-
limthd_dh.F90 (modified) (11 diffs)
-
limthd_lac.F90 (modified) (11 diffs)
-
limthd_sal.F90 (modified) (5 diffs)
-
limtrp.F90 (modified) (2 diffs)
-
limupdate.F90 (modified) (28 diffs)
-
limvar.F90 (modified) (4 diffs)
-
limwri.F90 (modified) (9 diffs)
-
limwri_dimg.h90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_SBC/NEMO/LIM_SRC_3/ice.F90
r884 r886 493 493 diag_bot_me, & ! vertical bottom melt 494 494 diag_sur_me ! vertical surface melt 495 INTEGER , PUBLIC :: & !: indexes of the debugging 496 jiindex, & ! point 497 jjindex 495 INTEGER , PUBLIC :: jiindx, jjindx !: indexes of the debugging point 498 496 499 497 #else -
branches/dev_001_SBC/NEMO/LIM_SRC_3/iceini.F90
r884 r886 13 13 USE in_out_manager 14 14 USE ice_oce ! ice variables 15 USE flx_oce 15 USE sbc_oce ! Surface boundary condition: ocean fields 16 USE sbc_ice ! Surface boundary condition: ice fields 16 17 USE phycst ! Define parameters for the routines 17 18 USE ocfzpt … … 74 75 ! Louvain la Neuve Ice model 75 76 IF( nacc == 1 ) THEN 76 dtsd2 = n fice* rdtmin * 0.577 rdt_ice = n fice* rdtmin77 dtsd2 = nn_fsbc * rdtmin * 0.5 78 rdt_ice = nn_fsbc * rdtmin 78 79 ELSE 79 dtsd2 = n fice* rdt * 0.580 rdt_ice = n fice* rdt80 dtsd2 = nn_fsbc * rdt * 0.5 81 rdt_ice = nn_fsbc * rdt 81 82 ENDIF 82 83 … … 104 105 freeze(:,:) = at_i(:,:) ! initialisation of sea/ice cover 105 106 # if defined key_coupled 106 alb_ice(:,:) = albege(:,:) ! sea-ice albedo 107 Must be adpated to LIM3 108 alb_ice(:,:,:) = albege(:,:) ! sea-ice albedo 107 109 # endif 108 110 109 nstart = numit + n fice111 nstart = numit + nn_fsbc 110 112 nitrun = nitend - nit000 + 1 111 113 nlast = numit + nitrun … … 188 190 189 191 WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution ' 190 WRITE(numout,*) '~~~~~~~~~~~~ ~~~'192 WRITE(numout,*) '~~~~~~~~~~~~' 191 193 192 194 !!-- End of declarations -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limdia.F90
r884 r886 26 26 USE limistate 27 27 USE dom_oce 28 USE sbc_oce ! Surface boundary condition: ocean fields 28 29 29 30 IMPLICIT NONE … … 107 108 !--------------------------------------- 108 109 zday_min = 273.0 ! zday_min = date of minimum extent, here September 30th 109 zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(n fice) )110 zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nn_fsbc) ) 110 111 IF (zday.GT.zday_min) THEN 111 112 zshift_date = zday - zday_min … … 142 143 vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 143 144 v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 144 vinfor(53) = vinfor(53) + fsalt(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux145 vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux 145 146 vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) / 1.0e12 !brine drainage flux 146 147 vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) / 1.0e12 !equivalent salt flux 147 vinfor(59) = vinfor(59) + sst_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SST148 vinfor(61) = vinfor(61) + sss_ io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SSS148 vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SST 149 vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SSS 149 150 vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! snow temperature 150 151 vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! ice heat content … … 155 156 vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 156 157 vinfor(79) = 0.0 157 vinfor(81) = vinfor(81) + fmass(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux158 vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 158 159 ENDIF 159 160 END DO … … 293 294 vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 294 295 v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel 295 vinfor(54) = vinfor(54) + at_i(ji,jj)* fsalt(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux296 vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux 296 297 vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) / 1.0e12 ! Brine drainage salt flux 297 298 vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) / 1.0e12 ! Equivalent salt flux 298 vinfor(60) = vinfor(60) + sst_io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SST299 vinfor(62) = vinfor(62) + sss_ io(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SSS299 vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SST 300 vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12 !SSS 300 301 vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! snow temperature 301 302 vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! ice enthalpy … … 306 307 vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume 307 308 vinfor(80) = 0.0 308 vinfor(82) = vinfor(82) + fmass(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux309 vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux 309 310 ENDIF 310 311 END DO -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limdyn.F90
r884 r886 16 16 USE dom_ice 17 17 USE dom_oce ! ocean space and time domain 18 USE taumod19 18 USE ice 20 19 USE par_ice 20 USE sbc_ice ! Surface boundary condition: ice fields 21 21 USE ice_oce 22 22 USE iceini … … 90 90 IF ( ln_limdyn ) THEN 91 91 92 ! ocean velocity93 u_oce(:,:) = u_io(:,:) * tmu(:,:)94 v_oce(:,:) = v_io(:,:) * tmv(:,:)95 96 92 old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 97 93 old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) … … 162 158 ENDIF 163 159 164 ! Ice-Ocean stress165 ! ================166 DO jj = 2, jpjm1167 zsang = SIGN(1.e0, gphif(1,jj-1) ) * sangvg168 169 DO ji = fs_2, fs_jpim1170 ! computation of wind stress over ocean in X and Y direction171 #if defined key_coupled && defined key_lim_cp1172 ! ztairx = ( 1.0 - at_i(ji-1,jj) ) * gtaux(ji-1,jj) + &173 ! ( 1.0 - at_i(ji,jj) ) * gtaux(ji,jj ) + &174 ! ( 1.0 - at_i(ji-1,jj-1) ) * gtaux(ji-1,jj-1) + &175 ! ( 1.0 - at_i(ji,jj-1) ) * gtaux(ji,jj-1)176 177 ! ztairy = ( 1.0 - at_i(ji-1,jj) ) * gtauy(ji-1,jj ) + &178 ! ( 1.0 - at_i(ji,jj ) ) * gtauy(ji,jj ) + &179 ! ( 1.0 - at_i(ji-1,jj-1) ) * gtauy(ji-1,jj-1) + &180 ! ( 1.0 - at_i(ji,jj-1) ) * gtauy(ji,jj-1)181 #else182 ztairx = ( 2.0 - at_i(ji,jj) - at_i(ji+1,jj) ) * gtaux(ji,jj) / cai * cao183 ztairy = ( 2.0 - at_i(ji,jj) - at_i(ji,jj+1) ) * gtauy(ji,jj) / cai * cao184 185 zsfrldmx2 = at_i(ji,jj) + at_i(ji+1,jj)186 zsfrldmy2 = at_i(ji,jj) + at_i(ji,jj+1)187 188 #endif189 zu_ice = u_ice(ji,jj) - u_oce(ji,jj)190 zv_ice = v_ice(ji,jj) - v_oce(ji,jj)191 zmod = SQRT( zu_ice * zu_ice + zv_ice * zv_ice )192 193 ! quadratic drag formulation194 ztglx = zsfrldmx2 * rhoco * zmod * ( cangvg * zu_ice - zsang * zv_ice )195 ztgly = zsfrldmy2 * rhoco * zmod * ( cangvg * zv_ice + zsang * zu_ice )196 !197 ! ! IMPORTANT198 ! ! these lignes are bound to prevent numerical oscillations199 ! ! in the ice-ocean stress200 ! ! They are physically ill-based. There is a cleaner solution201 ! ! to try (remember discussion in Paris Gurvan)202 !203 ztglx = ztglx * exp( - zmod / 0.5 )204 ztgly = ztglx * exp( - zmod / 0.5 )205 206 tio_u(ji,jj) = - ( ztairx + 1.0 * ztglx ) / ( 2. * rau0 )207 tio_v(ji,jj) = - ( ztairy + 1.0 * ztgly ) / ( 2. * rau0 )208 END DO209 END DO210 211 160 ! computation of friction velocity 212 161 DO jj = 2, jpjm1 213 162 DO ji = fs_2, fs_jpim1 214 163 215 zu_ice = u_ice(ji,jj) - u_ io(ji,jj)164 zu_ice = u_ice(ji,jj) - u_oce(ji,jj) 216 165 zt11 = rhoco * zu_ice * zu_ice 217 166 218 zu_ice = u_ice(ji-1,jj) - u_ io(ji-1,jj)167 zu_ice = u_ice(ji-1,jj) - u_oce(ji-1,jj) 219 168 zt12 = rhoco * zu_ice * zu_ice 220 169 221 zv_ice = v_ice(ji,jj) - v_ io(ji,jj)170 zv_ice = v_ice(ji,jj) - v_oce(ji,jj) 222 171 zt21 = rhoco * zv_ice * zv_ice 223 172 224 zv_ice = v_ice(ji,jj-1) - v_ io(ji,jj-1)173 zv_ice = v_ice(ji,jj-1) - v_oce(ji,jj-1) 225 174 zt22 = rhoco * zv_ice * zv_ice 226 ztair2 = ( ( gtaux(ji,jj) + gtaux(ji-1,jj) ) / 2. )**2 + &227 ( ( gtauy(ji,jj) + gtauy(ji,jj-1) ) / 2. )**2175 ztair2 = ( ( utaui_ice(ji,jj) + utaui_ice(ji-1,jj) ) / 2. )**2 + & 176 ( ( vtaui_ice(ji,jj) + vtaui_ice(ji,jj-1) ) / 2. )**2 228 177 229 178 ! should not be weighted … … 241 190 DO jj = 2, jpjm1 242 191 DO ji = fs_2, fs_jpim1 243 #if defined key_coupled && defined key_lim_cp1 244 tio_u(ji,jj) = - ( gtaux(ji ,jj ) + gtaux(ji-1,jj ) & 245 & + gtaux(ji-1,jj-1) + gtaux(ji ,jj-1) ) / ( 4 * rau0 ) 246 247 tio_v(ji,jj) = - ( gtauy(ji ,jj ) + gtauy(ji-1,jj ) & 248 & + gtauy(ji-1,jj-1) + gtauy(ji ,jj-1) ) / ( 4 * rau0 ) 249 #else 250 tio_u(ji,jj) = - gtaux(ji,jj) / cai * cao / rau0 251 tio_v(ji,jj) = - gtauy(ji,jj) / cai * cao / rau0 252 #endif 253 ztair2 = ( ( gtaux(ji,jj) + gtaux(ji-1,jj) ) / 2. )**2 + & 254 ( ( gtauy(ji,jj) + gtauy(ji,jj-1) ) / 2. )**2 192 ztair2 = ( ( utaui_ice(ji,jj) + utaui_ice(ji-1,jj) ) / 2. )**2 + & 193 ( ( vtaui_ice(ji,jj) + vtaui_ice(ji,jj-1) ) / 2. )**2 255 194 zustm = SQRT( ztair2 ) 256 195 … … 262 201 263 202 CALL lbc_lnk( ust2s, 'T', 1. ) ! T-point 264 CALL lbc_lnk( tio_u, 'U', -1. ) ! I-point (i.e. ice U-V point)265 CALL lbc_lnk( tio_v, 'V', -1. ) ! I-point (i.e. ice U-V point)266 203 267 204 IF(ln_ctl) THEN ! Control print … … 269 206 CALL prt_ctl_info(' - Cell values : ') 270 207 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 271 CALL prt_ctl(tab2d_1=tio_u , clinfo1=' lim_dyn : tio_u :', tab2d_2=tio_v , clinfo2=' tio_v :')272 208 CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 273 209 CALL prt_ctl(tab2d_1=divu_i , clinfo1=' lim_dyn : divu_i :') -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limistate.F90
r884 r886 16 16 USE oce ! dynamics and tracers variables 17 17 USE dom_oce 18 USE sbc_oce ! Surface boundary condition: ocean fields 18 19 USE par_ice ! ice parameters 19 20 USE ice_oce ! ice variables … … 93 94 CALL lim_istate_init ! reading the initials parameters of the ice 94 95 95 !-- Initialisation of sst,sss,u,v do i=1,jpi96 u_io(:,:) = 0.e0 ! ice velocity in x direction97 v_io(:,:) = 0.e0 ! ice velocity in y direction98 99 96 ! Initialisation at tn or -2 if ice 100 97 DO jj = 1, jpj … … 104 101 END DO 105 102 END DO 106 107 u_io (:,:) = 0.108 v_io (:,:) = 0.109 sst_io(:,:) = ( nfice - 1 ) * ( tn(:,:,1) + rt0 ) ! use the ocean initial values110 sss_io(:,:) = ( nfice - 1 ) * sn(:,:,1) ! tricky trick *(nfice-1) !111 103 112 104 !-------------------------------------------------------------------- … … 280 272 !--------------- 281 273 sm_i(ji,jj,jl) = zidto * sinn + ( 1.0 - zidto ) * 0.1 282 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_ io(ji,jj) ) * v_i(ji,jj,jl)274 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 283 275 284 276 !---------- … … 405 397 406 398 sm_i(ji,jj,jl) = zidto * sins + ( 1.0 - zidto ) * 0.1 407 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_ io(ji,jj) ) * v_i(ji,jj,jl)399 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 408 400 409 401 !---------- … … 538 530 539 531 CALL lbc_lnk( fsbbq , 'T', 1. ) 540 CALL lbc_lnk( sss_io , 'T', 1. )541 532 542 533 END SUBROUTINE lim_istate -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limitd_me.F90
r884 r886 20 20 USE phycst ! physical constants (ocean directory) 21 21 USE ice_oce ! ice variables 22 USE sbc_oce ! Surface boundary condition: ocean fields 22 23 USE thd_ice 23 24 USE limistate … … 743 744 ! Temporal smoothing 744 745 !-------------------- 745 IF ( numit .EQ. nit000 + n fice- 1 ) THEN746 IF ( numit .EQ. nit000 + nn_fsbc - 1 ) THEN 746 747 strp1(:,:) = 0.0 747 748 strp2(:,:) = 0.0 … … 1194 1195 IF ( con_i ) THEN 1195 1196 CALL lim_column_sum (jpl, v_i, vice_init ) 1196 WRITE(numout,*) ' vice_init : ', vice_init(jiind ex,jjindex)1197 WRITE(numout,*) ' vice_init : ', vice_init(jiindx,jjindx) 1197 1198 CALL lim_column_sum_energy (jpl, nlay_i, e_i, eice_init ) 1198 WRITE(numout,*) ' eice_init : ', eice_init(jiind ex,jjindex)1199 WRITE(numout,*) ' eice_init : ', eice_init(jiindx,jjindx) 1199 1200 ENDIF 1200 1201 … … 1363 1364 ! Salinity 1364 1365 !------------- 1365 smsw(ji,jj) = sss_ io(ji,jj) * vsw(ji,jj) * ridge_por1366 smsw(ji,jj) = sss_m(ji,jj) * vsw(ji,jj) * ridge_por 1366 1367 1367 1368 ! salinity of new ridge … … 1447 1448 - eirft(ji,jj,jk) 1448 1449 ! sea water heat content 1449 ztmelts = - tmut * sss_ io(ji,jj) + rtt1450 ztmelts = - tmut * sss_m(ji,jj) + rtt 1450 1451 ! heat content per unit volume 1451 zdummy0 = - rcp * ( sst_ io(ji,jj)- rtt ) * vsw(ji,jj)1452 zdummy0 = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj) 1452 1453 1453 1454 ! corrected sea water salinity … … 1616 1617 fieldid = ' v_i : limitd_me ' 1617 1618 CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid) 1618 WRITE(numout,*) ' vice_init : ', vice_init(jiind ex,jjindex)1619 WRITE(numout,*) ' vice_final : ', vice_final(jiind ex,jjindex)1619 WRITE(numout,*) ' vice_init : ', vice_init(jiindx,jjindx) 1620 WRITE(numout,*) ' vice_final : ', vice_final(jiindx,jjindx) 1620 1621 1621 1622 CALL lim_column_sum_energy (jpl, nlay_i, e_i, eice_final ) 1622 1623 fieldid = ' e_i : limitd_me ' 1623 1624 CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid) 1624 WRITE(numout,*) ' eice_init : ', eice_init(jiind ex,jjindex)1625 WRITE(numout,*) ' eice_final : ', eice_final(jiind ex,jjindex)1625 WRITE(numout,*) ' eice_init : ', eice_init(jiindx,jjindx) 1626 WRITE(numout,*) ' eice_final : ', eice_final(jiindx,jjindx) 1626 1627 ENDIF 1627 1628 … … 1839 1840 ! fresh_hist(i,j) = fresh_hist(i,j) + xtmp 1840 1841 1841 ! fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_ io(ji,jj) ) * &1842 ! fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_m(ji,jj) ) * & 1842 1843 ! rhosn * v_s(ji,jj,jl) / rdt_ice 1843 1844 1844 ! fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_ io(ji,jj) - sm_i(ji,jj,jl) ) * &1845 ! fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * & 1845 1846 ! rhoic * v_i(ji,jj,jl) / rdt_ice 1846 1847 1847 ! fsalt(i,j) = fsalt(i,j) + xtmp1848 ! emps(i,j) = emps(i,j) + xtmp 1848 1849 ! fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp 1849 1850 -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limrhg.F90
r884 r886 16 16 USE dom_oce 17 17 USE dom_ice 18 USE sbc_ice ! Surface boundary condition: ice fields 18 19 USE ice 19 20 USE iceini … … 268 269 / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 269 270 ! 270 u_oce1(ji,jj) = u_ io(ji,jj)271 v_oce2(ji,jj) = v_ io(ji,jj)271 u_oce1(ji,jj) = u_oce(ji,jj) 272 v_oce2(ji,jj) = v_oce(ji,jj) 272 273 273 274 ! Ocean has no slip boundary condition 274 v_oce1(ji,jj) = 0.5*( (v_ io(ji,jj)+v_io(ji,jj-1))*e1t(ji,jj) &275 & +(v_ io(ji+1,jj)+v_io(ji+1,jj-1))*e1t(ji+1,jj)) &275 v_oce1(ji,jj) = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj) & 276 & +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) & 276 277 & /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 277 278 278 u_oce2(ji,jj) = 0.5*((u_ io(ji,jj)+u_io(ji-1,jj))*e2t(ji,jj) &279 & +(u_ io(ji,jj+1)+u_io(ji-1,jj+1))*e2t(ji,jj+1)) &279 u_oce2(ji,jj) = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj) & 280 & +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) & 280 281 & / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj) 281 282 282 283 ! Wind stress. 283 ztagnx = ( 1. - zfrld1(ji,jj) ) * gtaux(ji,jj)284 ztagny = ( 1. - zfrld2(ji,jj) ) * gtauy(ji,jj)284 ztagnx = ( 1. - zfrld1(ji,jj) ) * utaui_ice(ji,jj) 285 ztagny = ( 1. - zfrld2(ji,jj) ) * vtaui_ice(ji,jj) 285 286 286 287 ! Computation of the velocity field taking into account the ice internal interaction. … … 621 622 zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 622 623 IF ( zdummy .LE. 5.0e-2 ) THEN 623 u_ice(ji,jj) = u_ io(ji,jj)624 v_ice(ji,jj) = v_ io(ji,jj)624 u_ice(ji,jj) = u_oce(ji,jj) 625 v_ice(ji,jj) = v_oce(ji,jj) 625 626 ENDIF ! zdummy 626 627 END DO -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limrst.F90
r884 r886 18 18 USE dom_oce 19 19 USE ice_oce ! ice variables 20 USE sbc_oce ! Surface boundary condition: ocean fields 21 USE sbc_ice ! Surface boundary condition: ice fields 20 22 USE daymod 21 23 USE iom … … 55 57 56 58 ! to get better performances with NetCDF format: 57 ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*n fice+ 1)58 ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*n fice+ 159 IF( kt == nitrst - 2*n fice + 1 .OR. nstock == nfice .OR. ( kt == nitend - nfice+ 1 .AND. .NOT. lrst_ice ) ) THEN59 ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1) 60 ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 61 IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 60 62 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 61 63 IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst … … 70 72 CASE DEFAULT ; WRITE(numout,*) ' open ice restart NetCDF file: '//clname 71 73 END SELECT 72 IF( kt == nitrst - 2*n fice+ 1 ) THEN73 WRITE(numout,*) ' kt = nitrst - 2*n fice+ 1 = ', kt,' date= ', ndastp74 ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp74 IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN 75 WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 76 ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp 75 77 ENDIF 76 78 ENDIF … … 100 102 !!---------------------------------------------------------------------- 101 103 102 iter = kt + n fice - 1 ! ice restarts are written at kt == nitrst - nfice+ 1104 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 103 105 104 106 IF( iter == nitrst ) THEN … … 111 113 ! ------------------ 112 114 ! ! calendar control 113 CALL iom_rstput( iter, nitrst, numriw, 'n fice' , REAL( nfice, wp) ) ! time-step114 CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp) )! date115 CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp) ) ! time-step 116 CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp) ) ! date 115 117 116 118 ! Prognostic variables … … 158 160 CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice ) 159 161 CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice ) 160 CALL iom_rstput( iter, nitrst, numriw, ' gtaux' , gtaux)161 CALL iom_rstput( iter, nitrst, numriw, ' gtauy' , gtauy)162 CALL iom_rstput( iter, nitrst, numriw, 'utaui_ice' , utaui_ice ) 163 CALL iom_rstput( iter, nitrst, numriw, 'vtaui_ice' , vtaui_ice ) 162 164 CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq ) 163 165 CALL iom_rstput( iter, nitrst, numriw, 'stress1_i' , stress1_i ) … … 299 301 WRITE(numout,*) ' ~~~ Arctic' 300 302 301 ji = jiind ex302 jj = jjind ex303 ji = jiindx 304 jj = jjindx 303 305 304 306 WRITE(numout,*) ' ji, jj ', ji, jj … … 387 389 !!---------------------------------------------------------------------- 388 390 ! Local variables 389 INTEGER :: ji, jj, jk, jl, ind ex391 INTEGER :: ji, jj, jk, jl, indx 390 392 REAL(wp) :: zfice, ziter 391 393 REAL(wp) :: & !parameters for the salinity profile … … 405 407 CALL iom_open ( 'restart_ice_in', numrir, kiolib = jprstlib ) 406 408 407 CALL iom_get( numrir, 'n fice', zfice )408 CALL iom_get( numrir, 'kt_ice' , ziter )409 CALL iom_get( numrir, 'nn_fsbc', zfice ) 410 CALL iom_get( numrir, 'kt_ice' , ziter ) 409 411 IF(lwp) WRITE(numout,*) ' read ice restart file at time step : ', ziter 410 412 IF(lwp) WRITE(numout,*) ' in any case we force it to nit000 - 1 : ', nit000 - 1 … … 416 418 & ' verify the file or rerun with the value 0 for the', & 417 419 & ' control of time parameter nrstdt' ) 418 IF( INT(zfice) /= n fice.AND. ABS( nrstdt ) == 1 ) &419 & CALL ctl_stop( 'lim_rst_read ===>>>> : problem with n ficein ice restart', &420 & ' verify the file or rerun with the value 0 for the', &420 IF( INT(zfice) /= nn_fsbc .AND. ABS( nrstdt ) == 1 ) & 421 & CALL ctl_stop( 'lim_rst_read ===>>>> : problem with nn_fsbc in ice restart', & 422 & ' verify the file or rerun with the value 0 for the', & 421 423 & ' control of time parameter nrstdt' ) 422 424 … … 512 514 CALL iom_get( numrir, jpdom_autoglo, 'u_ice' , u_ice ) 513 515 CALL iom_get( numrir, jpdom_autoglo, 'v_ice' , v_ice ) 514 CALL iom_get( numrir, jpdom_autoglo, ' gtaux' , gtaux)515 CALL iom_get( numrir, jpdom_autoglo, ' gtauy' , gtauy)516 CALL iom_get( numrir, jpdom_autoglo, 'utaui_ice' , utaui_ice ) 517 CALL iom_get( numrir, jpdom_autoglo, 'vtaui_ice' , vtaui_ice ) 516 518 CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq ) 517 519 CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i ) … … 650 652 WRITE(numout,*) ' ~~~ Arctic' 651 653 652 ind ex = 1654 indx = 1 653 655 ji = 24 654 656 jj = 24 -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd.F90
r884 r886 18 18 USE ice ! LIM sea-ice variables 19 19 USE ice_oce ! sea-ice/ocean variables 20 USE flx_oce ! sea-ice/ocean forcings variables 20 USE sbc_oce ! Surface boundary condition: ocean fields 21 USE sbc_ice ! Surface boundary condition: ice fields 21 22 USE thd_ice ! LIM thermodynamic sea-ice variables 22 23 USE dom_ice ! LIM sea-ice domain … … 84 85 !!--------------------------------------------------------------------- 85 86 !! * Local variables 86 INTEGER :: ji, jj, jk, jl, & 87 zji , zjj, & ! dummy loop indices 88 nbpb , & ! nb of icy pts for thermo. cal. 89 index 87 INTEGER :: ji, jj, jk, jl, nbpb ! nb of icy pts for thermo. cal. 90 88 91 89 REAL(wp) :: & … … 211 209 212 210 ! here the drag will depend on ice thickness and type (0.006) 213 fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( sst_io(ji,jj) - t_bo(ji,jj) )211 fdtcn(ji,jj) = zindb * rau0 * rcp * 0.006 * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) ) 214 212 ! also category dependent 215 213 ! !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead … … 220 218 ! !-- Lead heat budget (part 1, next one is in limthd_dh 221 219 ! !-- qldif -- (or qldif_1d in 1d routines) 222 zfontn = sprecip(ji,jj) * lfus ! 223 zfnsol = qns r_oce(ji,jj) !total non solar flux224 qldif(ji,jj) = tms(ji,jj) * ( qsr _oce(ji,jj)&220 zfontn = sprecip(ji,jj) * lfus ! energy of melting 221 zfnsol = qns(ji,jj) ! total non solar flux 222 qldif(ji,jj) = tms(ji,jj) * ( qsr(ji,jj) & 225 223 & + zfnsol + fdtcn(ji,jj) - zfontn & 226 224 & + ( 1.0 - zindb ) * fsbbq(ji,jj) ) & … … 242 240 ! Energy needed to bring ocean surface layer until its freezing 243 241 ! qcmif, limflx 244 qcmif (ji,jj) = rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - sst_io(ji,jj) ) * ( 1. - zinda )242 qcmif (ji,jj) = rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) * ( 1. - zinda ) 245 243 246 244 ! calculate oceanic heat flux (limthd_dh) … … 271 269 ENDIF 272 270 ! debug point to follow 273 IF ( (ji.eq.jiind ex).AND.(jj.eq.jjindex) ) THEN271 IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 274 272 jiindex_1d = nbpb 275 273 ENDIF … … 310 308 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb) , fr1_i0 , jpi, jpj, npb(1:nbpb) ) 311 309 CALL tab_2d_1d( nbpb, fr2_i0_1d (1:nbpb) , fr2_i0 , jpi, jpj, npb(1:nbpb) ) 312 CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb) , qns r_ice(:,:,jl), jpi, jpj, npb(1:nbpb) )310 CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb) , qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 313 311 314 312 #if ! defined key_coupled … … 360 358 361 359 !---------------------------------! 362 CALL lim_thd_sal(1,nbpb ,jl)! Ice salinity computation !360 CALL lim_thd_sal(1,nbpb) ! Ice salinity computation ! 363 361 !---------------------------------! 364 362 … … 415 413 CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new (1:nbpb) , jpi, jpj ) 416 414 CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0 (1:nbpb) , jpi, jpj ) 417 CALL tab_1d_2d( nbpb, qns r_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj)415 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj) 418 416 !+++++ 419 417 … … 543 541 544 542 INTEGER :: & 545 ji,j j,jk! loop indices543 ji,jk ! loop indices 546 544 547 545 !!----------------------------------------------------------------------- … … 598 596 ! is violated 599 597 INTEGER :: & 600 ji,j j,jk,& !: loop indices598 ji,jk, & !: loop indices 601 599 zji, zjj 602 600 !!--------------------------------------------------------------------- … … 726 724 WRITE(numout,*) ' foc : ', fbif_1d(ji) 727 725 WRITE(numout,*) ' fstroc : ', fstroc (zji,zjj,jl) 728 WRITE(numout,*) ' i0 : ', i0(ji)729 WRITE(numout,*) ' fsolar: ', (1.0-i0(ji))*qsr_ice_1d(ji)730 WRITE(numout,*) ' fnsolar: ', qnsr_ice_1d(ji)726 WRITE(numout,*) ' i0 : ', i0(ji) 727 WRITE(numout,*) ' qsr_ice : ', (1.0-i0(ji))*qsr_ice_1d(ji) 728 WRITE(numout,*) ' qns_ice : ', qnsr_ice_1d(ji) 731 729 WRITE(numout,*) ' Conduction fluxes : ' 732 730 WRITE(numout,*) ' fc_s : ', fc_s(ji,0:nlay_s) … … 778 776 numce !: number of points for which conservation 779 777 ! is violated 780 INTEGER :: & 781 ji,jj,jk, & !: loop indices 782 zji, zjj 783 778 INTEGER :: ji, zji, zjj ! loop indices 784 779 !!--------------------------------------------------------------------- 785 780 -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd_dh.F90
r884 r886 16 16 USE phycst ! physical constants (OCE directory) 17 17 USE ice_oce ! ice variables 18 USE sbc_oce ! Surface boundary condition: ocean fields 18 19 USE thd_ice 19 20 USE iceini … … 338 339 zjj = ( npb(ji) - 1 ) / jpi + 1 339 340 zfsalt_melt(ji) = zfsalt_melt(ji) + & 340 ( sss_ io(zji,zjj) - sm_i_b(ji) ) *&341 ( sss_m(zji,zjj) - sm_i_b(ji) ) * & 341 342 a_i_b(ji) * & 342 343 MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice … … 368 369 WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 369 370 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 370 WRITE(numout,*) ' sss_ io : ', sss_io(zji,zjj)371 WRITE(numout,*) ' sss_m : ', sss_m(zji,zjj) 371 372 ENDIF 372 373 … … 494 495 zswi2 * 0.26 / & 495 496 ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) 496 zds = zfracs*sss_ io(zji,zjj) - s_i_new(ji)497 s_i_new(ji) = zfracs * sss_ io(zji,zjj)497 zds = zfracs*sss_m(zji,zjj) - s_i_new(ji) 498 s_i_new(ji) = zfracs * sss_m(zji,zjj) 498 499 ENDIF ! fc_bo_i 499 500 END DO ! ji … … 567 568 zjj = ( npb(ji) - 1 ) / jpi + 1 568 569 zfsalt_melt(ji) = zfsalt_melt(ji) + & 569 ( sss_ io(zji,zjj) - sm_i_b(ji) ) *&570 ( sss_m(zji,zjj) - sm_i_b(ji) ) * & 570 571 a_i_b(ji) * & 571 572 MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice … … 596 597 WRITE(numout,*) ' qlbbq_1d: ', qlbbq_1d(ji) 597 598 WRITE(numout,*) ' s_i_new : ', s_i_new(ji) 598 WRITE(numout,*) ' sss_ io : ', sss_io(zji,zjj)599 WRITE(numout,*) ' sss_m : ', sss_m(zji,zjj) 599 600 WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji) 600 601 WRITE(numout,*) ' innermelt : ', innermelt(ji) … … 701 702 fseqv_1d(ji) = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) + & 702 703 (1.0 - zihgnew) * rdmicif_1d(ji) * & 703 ( sss_ io(zji,zjj) - sm_i_b(ji) ) / rdt_ice704 ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice 704 705 ! new lines 705 706 IF ( num_sal .EQ. 4 ) & 706 707 fseqv_1d(ji) = fseqv_1d(ji) + zihgnew * zfsalt_melt(ji) + & 707 708 (1.0 - zihgnew) * rdmicif_1d(ji) * & 708 ( sss_ io(zji,zjj) - bulk_sal ) / rdt_ice709 ( sss_m(zji,zjj) - bulk_sal ) / rdt_ice 709 710 ! Heat flux 710 711 ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1 … … 775 776 776 777 zsm_snowice = ( rhoic - rhosn ) / rhoic * & 777 sss_ io(zji,zjj)778 sss_m(zji,zjj) 778 779 779 780 IF ( num_sal .NE. 2 ) zsm_snowice = sm_i_b(ji) … … 781 782 IF ( num_sal .NE. 4 ) & 782 783 fseqv_1d(ji) = fseqv_1d(ji) + & 783 ( sss_ io(zji,zjj) - zsm_snowice ) * &784 ( sss_m(zji,zjj) - zsm_snowice ) * & 784 785 a_i_b(ji) * & 785 786 ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice … … 787 788 IF ( num_sal .EQ. 4 ) & 788 789 fseqv_1d(ji) = fseqv_1d(ji) + & 789 ( sss_ io(zji,zjj) - bulk_sal ) * &790 ( sss_m(zji,zjj) - bulk_sal ) * & 790 791 a_i_b(ji) * & 791 792 ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice … … 804 805 rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) & 805 806 * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic & 806 + ( zhnnew - ht_s_b(ji) ) * rhosn )807 + ( zhnnew - ht_s_b(ji) ) * rhosn 807 808 #endif 808 809 ! Actualize new snow and ice thickness. -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd_lac.F90
r884 r886 17 17 USE phycst 18 18 USE ice_oce ! ice variables 19 USE sbc_oce ! Surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: ice fields 19 21 USE thd_ice 20 22 USE dom_ice … … 23 25 USE iceini 24 26 USE limtab 25 USE taumod26 USE blk_oce27 27 USE limcons 28 28 … … 181 181 vt_s_init, vt_s_final, & ! snow volume summed over categories 182 182 et_i_init, et_i_final, & ! ice energy summed over categories 183 et_s_init , et_s_final! snow energy summed over categories183 et_s_init ! snow energy summed over categories 184 184 185 185 REAL(wp) :: & … … 267 267 !------------- 268 268 ! C-grid wind stress components 269 ztaux = ( gtaux(ji-1,jj ) * tmu(ji-1,jj ) &270 + gtaux(ji ,jj ) * tmu(ji ,jj ) ) / 2.0271 ztauy = ( gtauy(ji ,jj-1) * tmv(ji ,jj-1) &272 + gtauy(ji ,jj ) * tmv(ji ,jj ) ) / 2.0269 ztaux = ( utaui_ice(ji-1,jj ) * tmu(ji-1,jj ) & 270 + utaui_ice(ji ,jj ) * tmu(ji ,jj ) ) / 2.0 271 ztauy = ( vtaui_ice(ji ,jj-1) * tmv(ji ,jj-1) & 272 + vtaui_ice(ji ,jj ) * tmv(ji ,jj ) ) / 2.0 273 273 ! Square root of wind stress 274 274 ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) … … 343 343 nbpac = nbpac + 1 344 344 npac( nbpac ) = (jj - 1) * jpi + ji 345 IF ( (ji.eq.jiind ex).AND.(jj.eq.jjindex) ) THEN345 IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN 346 346 jiindex_1d = nbpac 347 347 ENDIF … … 418 418 zji = MOD( npac(ji) - 1, jpi ) + 1 419 419 zjj = ( npac(ji) - 1 ) / jpi + 1 420 zs_newice(ji) = MIN( 0.5*sss_ io(zji,zjj) , zs_newice(ji) )420 zs_newice(ji) = MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) ) 421 421 END DO ! jl 422 422 … … 476 476 zjj = ( npac(ji) - 1 ) / jpi + 1 477 477 fseqv_1d(ji) = fseqv_1d(ji) + & 478 ( sss_ io(zji,zjj) - bulk_sal ) * rhoic *&478 ( sss_m(zji,zjj) - bulk_sal ) * rhoic * & 479 479 zv_newice(ji) / rdt_ice 480 480 END DO … … 484 484 zjj = ( npac(ji) - 1 ) / jpi + 1 485 485 fseqv_1d(ji) = fseqv_1d(ji) + & 486 ( sss_ io(zji,zjj) - zs_newice(ji) ) * rhoic *&486 ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic * & 487 487 zv_newice(ji) / rdt_ice 488 488 END DO ! ji … … 617 617 END DO 618 618 619 WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiind ex, 1:jpl)619 WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 620 620 DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) 621 621 DO ji = 1, nbpac … … 626 626 END DO ! ji 627 627 END DO ! jl 628 WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiind ex, 1:jpl)628 WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl) 629 629 630 630 !--------------------------------- … … 796 796 ! CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid) 797 797 798 WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiind ex,jjindex)799 WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiind ex,jjindex)800 WRITE(numout,*) ' et_i_init : ', et_i_init(jiind ex,jjindex)801 WRITE(numout,*) ' et_i_final: ', et_i_final(jiind ex,jjindex)798 WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindx,jjindx) 799 WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindx,jjindx) 800 WRITE(numout,*) ' et_i_init : ', et_i_init(jiindx,jjindx) 801 WRITE(numout,*) ' et_i_final: ', et_i_final(jiindx,jjindx) 802 802 803 803 ENDIF -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limthd_sal.F90
r884 r886 16 16 USE phycst ! physical constants (ocean directory) 17 17 USE ice_oce ! ice variables 18 USE sbc_oce ! Surface boundary condition: ocean fields 18 19 USE thd_ice 19 20 USE iceini … … 40 41 CONTAINS 41 42 42 SUBROUTINE lim_thd_sal(kideb,kiut ,jl)43 SUBROUTINE lim_thd_sal(kideb,kiut) 43 44 !!------------------------------------------------------------------- 44 45 !! *** ROUTINE lim_thd_sal *** … … 76 77 !! * Local variables 77 78 INTEGER, INTENT(in) :: & 78 kideb, kiut , jl!: thickness category index79 kideb, kiut !: thickness category index 79 80 80 81 INTEGER :: & … … 318 319 zjj = ( npb(ji) - 1 ) / jpi + 1 319 320 fseqv_1d(ji) = fseqv_1d(ji) + & 320 ( sss_ io(zji,zjj) - bulk_sal ) * &321 ( sss_m(zji,zjj) - bulk_sal ) * & 321 322 rhoic * a_i_b(ji) * & 322 323 MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice … … 327 328 zjj = ( npb(ji) - 1 ) / jpi + 1 328 329 fseqv_1d(ji) = fseqv_1d(ji) + & 329 ( sss_ io(zji,zjj) - s_i_new(ji) ) * &330 ( sss_m(zji,zjj) - s_i_new(ji) ) * & 330 331 rhoic * a_i_b(ji) * & 331 332 MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limtrp.F90
r884 r886 17 17 USE in_out_manager ! I/O manager 18 18 USE ice_oce ! ice variables 19 USE sbc_oce ! Surface boundary condition: ocean fields 19 20 USE dom_ice 20 21 USE ice … … 519 520 520 521 ! Ice salinity and age 521 zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_ io(ji,jj) , &522 zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj) , & 522 523 zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * & 523 524 v_i(ji,jj,jl) -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limupdate.F90
r884 r886 25 25 USE in_out_manager 26 26 USE ice_oce ! ice variables 27 USE flx_oce ! forcings variables 27 USE sbc_oce ! Surface boundary condition: ocean fields 28 USE sbc_ice ! Surface boundary condition: ice fields 28 29 USE dom_ice 29 30 USE daymod 30 31 USE phycst ! Define parameters for the routines 31 USE taumod32 32 USE ice 33 33 USE iceini 34 USE ocesbc35 34 USE lbclnk 36 35 USE limdyn 37 36 USE limtrp 38 37 USE limthd 39 USE lim flx38 USE limsbc 40 39 USE limdia 41 40 USE limwri … … 126 125 !+++++ [ 127 126 WRITE(numout,*) ' O) Initial values ' 128 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)129 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)130 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)131 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)132 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)133 DO jk = 1, nlay_i 134 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)127 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 128 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 129 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 130 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 131 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 132 DO jk = 1, nlay_i 133 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 135 134 END DO 136 135 !+++++ ] … … 238 237 239 238 !residual salt flux if ice is over-molten 240 fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_ io(ji,jj) - sm_i(ji,jj,jl) ) * &239 fsalt_res(ji,jj) = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * & 241 240 ( rhoic * zdvres / rdt_ice ) 242 241 ! fheat_res(ji,jj) = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice … … 254 253 255 254 !residual salt flux if snow is over-molten 256 fsalt_res(ji,jj) = fsalt_res(ji,jj) + sss_ io(ji,jj) * &255 fsalt_res(ji,jj) = fsalt_res(ji,jj) + sss_m(ji,jj) * & 257 256 ( rhosn * zdvres / rdt_ice ) 258 257 !this flux will be positive if snow was over-molten … … 276 275 277 276 WRITE(numout,*) ' 1. Before update of Global variables ' 278 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)279 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)280 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)281 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)282 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)283 DO jk = 1, nlay_i 284 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)277 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 278 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 279 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 280 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 281 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 282 DO jk = 1, nlay_i 283 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 285 284 END DO 286 285 !+++++ ] … … 294 293 CALL lim_var_glo2eqv ! useless, just for debug 295 294 DO jk = 1, nlay_i 296 WRITE(numout,*) ' t_i : ', t_i(jiind ex, jjindex, jk, 1:jpl)295 WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 297 296 END DO 298 297 e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_trp(:,:,:,:) … … 300 299 WRITE(numout,*) ' After transport update ' 301 300 DO jk = 1, nlay_i 302 WRITE(numout,*) ' t_i : ', t_i(jiind ex, jjindex, jk, 1:jpl)301 WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 303 302 END DO 304 303 e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_thd(:,:,:,:) … … 306 305 WRITE(numout,*) ' After thermodyn update ' 307 306 DO jk = 1, nlay_i 308 WRITE(numout,*) ' t_i : ', t_i(jiind ex, jjindex, jk, 1:jpl)307 WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 309 308 END DO 310 309 … … 316 315 !+++++ [ 317 316 WRITE(numout,*) ' 1. After update of Global variables (2) ' 318 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)319 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)320 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)321 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)322 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)323 WRITE(numout,*) ' oa_i : ', oa_i(jiind ex, jjindex, 1:jpl)324 WRITE(numout,*) ' e_s : ', e_s(jiind ex, jjindex, 1, 1:jpl)325 DO jk = 1, nlay_i 326 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)317 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 318 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 319 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 320 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 321 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 322 WRITE(numout,*) ' oa_i : ', oa_i(jiindx, jjindx, 1:jpl) 323 WRITE(numout,*) ' e_s : ', e_s(jiindx, jjindx, 1, 1:jpl) 324 DO jk = 1, nlay_i 325 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 327 326 END DO 328 327 !+++++ ] … … 348 347 !+++++ 349 348 WRITE(numout,*) ' Before everything ' 350 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)351 WRITE(numout,*) ' oa_i: ', oa_i(jiind ex, jjindex, 1:jpl)352 DO jk = 1, nlay_i 353 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)354 END DO 355 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)349 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 350 WRITE(numout,*) ' oa_i: ', oa_i(jiindx, jjindx, 1:jpl) 351 DO jk = 1, nlay_i 352 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 353 END DO 354 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 356 355 !+++++ 357 356 … … 362 361 !+++++ 363 362 WRITE(numout,*) ' After advection ' 364 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)365 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)363 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 364 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 366 365 !+++++ 367 366 … … 401 400 !+++++ [ 402 401 WRITE(numout,*) ' 2.1 ' 403 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)404 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)405 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)406 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)407 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)408 DO jk = 1, nlay_i 409 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)402 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 403 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 404 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 405 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 406 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 407 DO jk = 1, nlay_i 408 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 410 409 END DO 411 410 !+++++ ] … … 444 443 !+++++ [ 445 444 WRITE(numout,*) ' 2.1 initial ' 446 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)447 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)448 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)449 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)450 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)451 DO jk = 1, nlay_i 452 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)445 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 446 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 447 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 448 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 449 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 450 DO jk = 1, nlay_i 451 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 453 452 END DO 454 453 !+++++ ] … … 464 463 !+++++ [ 465 464 WRITE(numout,*) ' 2.1 before rebinning ' 466 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)467 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)468 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)469 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)470 DO jk = 1, nlay_i 471 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)472 END DO 473 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)465 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 466 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 467 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 468 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 469 DO jk = 1, nlay_i 470 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 471 END DO 472 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 474 473 !+++++ ] 475 474 … … 483 482 !+++++ [ 484 483 WRITE(numout,*) ' 2.1 after rebinning' 485 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)486 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)487 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)488 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)489 DO jk = 1, nlay_i 490 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)491 WRITE(numout,*) ' t_i : ', t_i(jiind ex, jjindex, jk, 1:jpl)492 END DO 493 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)484 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 485 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 486 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 487 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 488 DO jk = 1, nlay_i 489 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 490 WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 491 END DO 492 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 494 493 !+++++ ] 495 494 … … 611 610 !+++++ [ 612 611 WRITE(numout,*) ' 2.3 after melt of an internal ice layer ' 613 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)614 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)615 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)616 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)617 DO jk = 1, nlay_i 618 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)619 WRITE(numout,*) ' t_i : ', t_i(jiind ex, jjindex, jk, 1:jpl)620 END DO 621 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)612 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 613 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 614 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 615 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 616 DO jk = 1, nlay_i 617 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 618 WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl) 619 END DO 620 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 622 621 !+++++ ] 623 622 … … 638 637 639 638 !++++++ 640 IF ( (ji.eq.jiind ex) .AND. (jj.eq.jjindex) ) THEN639 IF ( (ji.eq.jiindx) .AND. (jj.eq.jjindx) ) THEN 641 640 WRITE(numout,*) ' jl : ', jl 642 641 WRITE(numout,*) ' ze_s : ', ze_s … … 737 736 !+++++ [ 738 737 WRITE(numout,*) ' 2.8 ' 739 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)740 WRITE(numout,*) ' at_i: ', at_i(jiind ex,jjindex)741 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)742 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)743 DO jk = 1, nlay_i 744 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)745 END DO 746 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)738 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 739 WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx) 740 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 741 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 742 DO jk = 1, nlay_i 743 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 744 END DO 745 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 747 746 !+++++ ] 748 747 … … 767 766 WRITE(numout,*) ' 2.9 ' 768 767 DO jk = 1, nlay_i 769 WRITE(numout,*) ' e_i : ', e_i(jiind ex, jjindex, jk, 1:jpl)770 END DO 771 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)772 773 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)768 WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl) 769 END DO 770 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 771 772 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 774 773 775 774 !--------------------- … … 784 783 DO ji = 1, jpi 785 784 ! salinity stays in bounds 786 smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_ io(ji,jj),smv_i(ji,jj,jl)), &785 smv_i(ji,jj,jl) = MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), & 787 786 0.1 * v_i(ji,jj,jl) ) 788 787 i_ice_switch = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) … … 798 797 !+++++ [ 799 798 WRITE(numout,*) ' 2.11 ' 800 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)801 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)802 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)803 WRITE(numout,*) ' at_i ', at_i(jiind ex,jjindex)804 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)799 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 800 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 801 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 802 WRITE(numout,*) ' at_i ', at_i(jiindx,jjindx) 803 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 805 804 !+++++ ] 806 805 … … 826 825 !+++++ [ 827 826 WRITE(numout,*) ' 2.12 ' 828 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)829 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)830 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)831 WRITE(numout,*) ' at_i ', at_i(jiind ex,jjindex)832 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)827 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 828 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 829 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 830 WRITE(numout,*) ' at_i ', at_i(jiindx,jjindx) 831 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 833 832 !+++++ ] 834 833 … … 873 872 !+++++ [ 874 873 WRITE(numout,*) ' 2.13 ' 875 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)876 WRITE(numout,*) ' at_i ', at_i(jiind ex,jjindex)877 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)878 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)879 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)874 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 875 WRITE(numout,*) ' at_i ', at_i(jiindx,jjindx) 876 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 877 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 878 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 880 879 !+++++ ] 881 880 … … 907 906 !+++++ [ 908 907 WRITE(numout,*) ' rebinning before' 909 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)910 WRITE(numout,*) ' at_i ', at_i(jiind ex,jjindex)911 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)912 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)913 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)908 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 909 WRITE(numout,*) ' at_i ', at_i(jiindx,jjindx) 910 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 911 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 912 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 914 913 !+++++ ] 915 914 !old version … … 925 924 !+++++ [ 926 925 WRITE(numout,*) ' rebinning final' 927 WRITE(numout,*) ' a_i : ', a_i(jiind ex, jjindex, 1:jpl)928 WRITE(numout,*) ' at_i ', at_i(jiind ex,jjindex)929 WRITE(numout,*) ' v_i : ', v_i(jiind ex, jjindex, 1:jpl)930 WRITE(numout,*) ' v_s : ', v_s(jiind ex, jjindex, 1:jpl)931 WRITE(numout,*) ' smv_i: ', smv_i(jiind ex, jjindex, 1:jpl)926 WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl) 927 WRITE(numout,*) ' at_i ', at_i(jiindx,jjindx) 928 WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl) 929 WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl) 930 WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl) 932 931 !+++++ ] 933 932 … … 1014 1013 END DO !ji 1015 1014 1016 WRITE(numout,*) ' TESTOSC1 ', tio_u(jiind ex,jjindex), tio_v(jiindex,jjindex)1017 WRITE(numout,*) ' TESTOSC2 ', u_ice(jiind ex,jjindex), v_ice(jiindex,jjindex)1018 WRITE(numout,*) ' TESTOSC3 ', u_oce(jiind ex,jjindex), v_oce(jiindex,jjindex)1019 WRITE(numout,*) ' TESTOSC4 ', tauxw(jiindex,jjindex), tauxw(jiindex,jjindex)1015 WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindx,jjindx), tio_v(jiindx,jjindx) 1016 WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindx,jjindx), v_ice(jiindx,jjindx) 1017 WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindx,jjindx), v_oce(jiindx,jjindx) 1018 WRITE(numout,*) ' TESTOSC4 ', utau (jiindx,jjindx), vtau (jiindx,jjindx) 1020 1019 1021 1020 … … 1087 1086 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ') 1088 1087 CALL prt_ctl(tab2d_1=fmmec , clinfo1= ' lim_update : fmmec : ', tab2d_2=fhmec , clinfo2= ' fhmec : ') 1089 CALL prt_ctl(tab2d_1=sst_ io , clinfo1= ' lim_update : sst : ', tab2d_2=sss_io, clinfo2= ' sss : ')1088 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ') 1090 1089 CALL prt_ctl(tab2d_1=fhbri , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_rpo , clinfo2= ' fheat_rpo : ') 1091 1090 … … 1093 1092 CALL prt_ctl_info(' - Stresses : ') 1094 1093 CALL prt_ctl_info(' ~~~~~~~~~~ ') 1095 CALL prt_ctl(tab2d_1=tauxw , clinfo1= ' lim_update : tauxw : ', tab2d_2=tauyw , clinfo2= ' tauyw : ') 1096 CALL prt_ctl(tab2d_1=taux , clinfo1= ' lim_update : taux : ', tab2d_2=tauy , clinfo2= ' tauy : ') 1097 CALL prt_ctl(tab2d_1=ftaux , clinfo1= ' lim_update : ftaux : ', tab2d_2=ftauy , clinfo2= ' ftauy : ') 1098 CALL prt_ctl(tab2d_1=gtaux , clinfo1= ' lim_update : gtaux : ', tab2d_2=gtauy , clinfo2= ' gtauy : ') 1099 CALL prt_ctl(tab2d_1=u_io , clinfo1= ' lim_update : u_io : ', tab2d_2=v_io , clinfo2= ' v_io : ') 1094 CALL prt_ctl(tab2d_1=utau , clinfo1= ' lim_update : utau : ', tab2d_2=vtau , clinfo2= ' vtau : ') 1095 CALL prt_ctl(tab2d_1=utaui_ice , clinfo1= ' lim_update : utaui_ice : ', tab2d_2=vtaui_ice , clinfo2= ' vtaui_ice : ') 1096 CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' lim_update : u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ') 1100 1097 ENDIF 1101 1098 -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limvar.F90
r884 r886 40 40 USE phycst ! physical constants (ocean directory) 41 41 USE ice_oce ! ice variables 42 USE sbc_oce ! Surface boundary condition: ocean fields 42 43 USE thd_ice 43 44 USE in_out_manager … … 428 429 zind0 , & !: switch, = 1 if sm_i lt s_i_0 429 430 zind01 , & !: switch, = 1 if sm_i between s_i_0 and s_i_1 430 zindbal , & !: switch, = 1, if 2*sm_i gt sss_ io431 zindbal , & !: switch, = 1, if 2*sm_i gt sss_m 431 432 zargtemp !: dummy factor 432 433 … … 491 492 zind01 = ( 1.0 - zind0 ) * & 492 493 MAX( 0.0 , SIGN( 1.0 , s_i_1 - sm_i(ji,jj,jl) ) ) 493 ! If 2.sm_i GE sss_ iothen zindbal = 1494 ! If 2.sm_i GE sss_m then zindbal = 1 494 495 zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) - & 495 sss_ io(ji,jj) ) )496 sss_m(ji,jj) ) ) 496 497 zalpha(ji,jj,jl) = zind0 * 1.0 & 497 498 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + & … … 692 693 zind01 = ( 1.0 - zind0 ) * & 693 694 MAX( 0.0 , SIGN( 1.0 , s_i_1 - sm_i_b(ji) ) ) 694 ! if 2.sm_i GE sss_ iothen zindbal = 1695 ! if 2.sm_i GE sss_m then zindbal = 1 695 696 zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i_b(ji) - & 696 sss_ io(zji,zjj) ) )697 sss_m(zji,zjj) ) ) 697 698 698 699 zalpha = zind0 * 1.0 & -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limwri.F90
r884 r886 18 18 !! * Modules used 19 19 USE ioipsl 20 USE dianam ! build name of file (routine)20 USE dianam ! build name of file (routine) 21 21 USE phycst 22 22 USE dom_oce … … 24 24 USE in_out_manager 25 25 USE ice_oce ! ice variables 26 USE flx_oce 26 USE sbc_oce ! Surface boundary condition: ocean fields 27 USE sbc_ice ! Surface boundary condition: ice fields 27 28 USE dom_ice 28 29 USE ice … … 137 138 zsto = rdt_ice 138 139 clop = "ave(x)" 139 zout = nwrite * rdt_ice / n fice140 zout = nwrite * rdt_ice / nn_fsbc 140 141 zsec = 0. 141 142 niter = 0 … … 165 166 zsto = rdt_ice 166 167 clop = "ave(x)" 167 zout = nwrite * rdt_ice / n fice168 zout = nwrite * rdt_ice / nn_fsbc 168 169 zsec = 0. 169 170 nitera = 0 … … 221 222 zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 222 223 zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 223 zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns r_ice(ji,jj,jl)224 zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 224 225 zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)*zinda 225 226 END DO … … 253 254 & / 2.0 254 255 zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) & 255 & + v_ice(ji,jj-1) * tmv(ji,jj-1) )&256 & + v_ice(ji,jj-1) * tmv(ji,jj-1) ) & 256 257 & / 2.0 257 zcmo(ji,jj,9) = sst_ io(ji,jj)258 zcmo(ji,jj,10) = sss_ io(ji,jj)259 260 zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)261 zcmo(ji,jj,12) = fsolar(ji,jj)262 zcmo(ji,jj,13) = fnsolar(ji,jj)258 zcmo(ji,jj,9) = sst_m(ji,jj) 259 zcmo(ji,jj,10) = sss_m(ji,jj) 260 261 zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 262 zcmo(ji,jj,12) = qsr(ji,jj) 263 zcmo(ji,jj,13) = qns(ji,jj) 263 264 zcmo(ji,jj,14) = fhbri(ji,jj) 264 zcmo(ji,jj,15) = gtaux(ji,jj)265 zcmo(ji,jj,16) = gtauy(ji,jj)266 zcmo(ji,jj,17) = zcmo(ji,jj,17) + (1.0-at_i(ji,jj))*qsr _oce(ji,jj)267 zcmo(ji,jj,18) = zcmo(ji,jj,18) + (1.0-at_i(ji,jj))*qns r_oce(ji,jj)265 zcmo(ji,jj,15) = utaui_ice(ji,jj) 266 zcmo(ji,jj,16) = vtaui_ice(ji,jj) 267 zcmo(ji,jj,17) = zcmo(ji,jj,17) + (1.0-at_i(ji,jj))*qsr(ji,jj) 268 zcmo(ji,jj,18) = zcmo(ji,jj,18) + (1.0-at_i(ji,jj))*qns(ji,jj) 268 269 zcmo(ji,jj,19) = sprecip(ji,jj) 269 270 zcmo(ji,jj,20) = smt_i(ji,jj) … … 299 300 END DO 300 301 301 IF ( jf == 7 .OR. jf == 8 .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR. & 302 jf == 16 ) THEN 302 IF ( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 303 303 CALL lbc_lnk( zfield, 'T', -1. ) 304 304 ELSE … … 315 315 END DO 316 316 317 IF ( ( n fice* niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN317 IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 318 318 WRITE(numout,*) ' Closing the icemod file ' 319 319 CALL histclo( nice ) … … 374 374 ! not yet implemented 375 375 376 IF ( ( n fice* niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN376 IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 377 377 WRITE(numout,*) ' Closing the icemod file ' 378 378 CALL histclo( nicea ) -
branches/dev_001_SBC/NEMO/LIM_SRC_3/limwri_dimg.h90
r884 r886 80 80 81 81 zsto = rdt_ice 82 zout = nwrite * rdt_ice / n fice82 zout = nwrite * rdt_ice / nn_fsbc 83 83 zsec = 0. 84 84 niter = 0 … … 111 111 + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 112 112 / ztmu 113 zcmo(ji,jj,9) = sst_ io(ji,jj)114 zcmo(ji,jj,10) = sss_ io(ji,jj)115 116 zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)117 zcmo(ji,jj,12) = fsolar(ji,jj)118 zcmo(ji,jj,13) = fnsolar(ji,jj)113 zcmo(ji,jj,9) = sst_m(ji,jj) 114 zcmo(ji,jj,10) = sss_m(ji,jj) 115 116 zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 117 zcmo(ji,jj,12) = qsr(ji,jj) 118 zcmo(ji,jj,13) = qns(ji,jj) 119 119 ! See thersf for the coefficient 120 zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce121 zcmo(ji,jj,15) = gtaux(ji,jj)122 zcmo(ji,jj,16) = gtauy(ji,jj)123 zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce(ji,jj)124 zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj)120 zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 121 zcmo(ji,jj,15) = utaui_ice(ji,jj) 122 zcmo(ji,jj,16) = vtaui_ice(ji,jj) 123 zcmo(ji,jj,17) = qsr (ji,jj) 124 zcmo(ji,jj,18) = qns(ji,jj) 125 125 zcmo(ji,jj,19) = sprecip(ji,jj) 126 126 END DO … … 154 154 + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) & 155 155 / ztmu 156 rcmoy(ji,jj,9) = sst_ io(ji,jj)157 rcmoy(ji,jj,10) = sss_ io(ji,jj)158 159 rcmoy(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)160 rcmoy(ji,jj,12) = fsolar(ji,jj)161 rcmoy(ji,jj,13) = fnsolar(ji,jj)156 rcmoy(ji,jj,9) = sst_m(ji,jj) 157 rcmoy(ji,jj,10) = sss_m(ji,jj) 158 159 rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj) 160 rcmoy(ji,jj,12) = qsr(ji,jj) 161 rcmoy(ji,jj,13) = qns(ji,jj) 162 162 ! See thersf for the coefficient 163 rcmoy(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce164 rcmoy(ji,jj,15) = gtaux(ji,jj)165 rcmoy(ji,jj,16) = gtauy(ji,jj)166 rcmoy(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce(ji,jj)167 rcmoy(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj)163 rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce 164 rcmoy(ji,jj,15) = utaui_ice(ji,jj) 165 rcmoy(ji,jj,16) = vtaui_ice(ji,jj) 166 rcmoy(ji,jj,17) = qsr(ji,jj) 167 rcmoy(ji,jj,18) = qns(ji,jj) 168 168 rcmoy(ji,jj,19) = sprecip(ji,jj) 169 169 END DO … … 176 176 zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1) 177 177 178 IF ( jf == 7 .OR. jf == 8 .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR. & 179 jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN 178 IF ( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN 180 179 CALL lbc_lnk( zfield, 'T', -1. ) 181 180 ELSE
Note: See TracChangeset
for help on using the changeset viewer.
