- Timestamp:
- 2012-11-21T14:19:18+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r3294 r3625 10 10 !! - ! 2008-04 (G. Madec) sltyle and lim_ctl routine 11 11 !! 3.3 ! 2010-11 (G. Madec) ice-ocean stress always computed at each ocean time-step 12 !! 4.0! 2011-01 (A Porter) dynamical allocation12 !! 3.4 ! 2011-01 (A Porter) dynamical allocation 13 13 !!---------------------------------------------------------------------- 14 14 #if defined key_lim3 … … 88 88 !! ** Action : - time evolution of the LIM sea-ice model 89 89 !! - update all sbc variables below sea-ice: 90 !! utau, vtau, taum, wndm, qns , qsr, emp , emps90 !! utau, vtau, taum, wndm, qns , qsr, emp , sfx 91 91 !!--------------------------------------------------------------------- 92 92 INTEGER, INTENT(in) :: kt ! ocean time step … … 170 170 171 171 ! ! intialisation to zero !!gm is it truly necessary ??? 172 d_a_i_thd (:,:,:) = 0. e0 ; d_a_i_trp (:,:,:) = 0.e0173 d_v_i_thd (:,:,:) = 0. e0 ; d_v_i_trp (:,:,:) = 0.e0174 d_e_i_thd (:,:,:,:) = 0. e0 ; d_e_i_trp (:,:,:,:) = 0.e0175 d_v_s_thd (:,:,:) = 0. e0 ; d_v_s_trp (:,:,:) = 0.e0176 d_e_s_thd (:,:,:,:) = 0. e0 ; d_e_s_trp (:,:,:,:) = 0.e0177 d_smv_i_thd(:,:,:) = 0. e0 ; d_smv_i_trp(:,:,:) = 0.e0178 d_oa_i_thd (:,:,:) = 0. e0 ; d_oa_i_trp (:,:,:) = 0.e0179 ! 180 fseqv (:,:) = 0.e0181 fsbri (:,:) = 0.e0 ; fsalt_res(:,:) = 0.e0182 f salt_rpo(:,:) = 0.e0183 fhmec (:,:) = 0.e0 ; fhbri (:,:) = 0.e0184 fmmec (:,:) = 0.e0 ; fheat_res(:,:) = 0.e0185 f heat_rpo(:,:) = 0.e0 ; focea2D (:,:) = 0.e0186 fsup2D (:,:) = 0.e0172 d_a_i_thd (:,:,:) = 0._wp ; d_a_i_trp (:,:,:) = 0._wp 173 d_v_i_thd (:,:,:) = 0._wp ; d_v_i_trp (:,:,:) = 0._wp 174 d_e_i_thd (:,:,:,:) = 0._wp ; d_e_i_trp (:,:,:,:) = 0._wp 175 d_v_s_thd (:,:,:) = 0._wp ; d_v_s_trp (:,:,:) = 0._wp 176 d_e_s_thd (:,:,:,:) = 0._wp ; d_e_s_trp (:,:,:,:) = 0._wp 177 d_smv_i_thd(:,:,:) = 0._wp ; d_smv_i_trp(:,:,:) = 0._wp 178 d_oa_i_thd (:,:,:) = 0._wp ; d_oa_i_trp (:,:,:) = 0._wp 179 ! 180 sfx (:,:) = 0._wp 181 sfx_bri(:,:) = 0._wp ; sfx_mec (:,:) = 0._wp ; sfx_res (:,:) = 0._wp 182 fhbri (:,:) = 0._wp ; fheat_mec(:,:) = 0._wp ; fheat_res(:,:) = 0._wp 183 fhmec (:,:) = 0._wp ; 184 fmmec (:,:) = 0._wp 185 focea2D(:,:) = 0._wp 186 fsup2D (:,:) = 0._wp 187 187 ! 188 diag_sni_gr(:,:) = 0. e0 ; diag_lat_gr(:,:) = 0.e0189 diag_bot_gr(:,:) = 0. e0 ; diag_dyn_gr(:,:) = 0.e0190 diag_bot_me(:,:) = 0. e0 ; diag_sur_me(:,:) = 0.e0188 diag_sni_gr(:,:) = 0._wp ; diag_lat_gr(:,:) = 0._wp 189 diag_bot_gr(:,:) = 0._wp ; diag_dyn_gr(:,:) = 0._wp 190 diag_bot_me(:,:) = 0._wp ; diag_sur_me(:,:) = 0._wp 191 191 ! dynamical invariants 192 delta_i(:,:) = 0. e0 ; divu_i(:,:) = 0.e0 ; shear_i(:,:) = 0.e0192 delta_i(:,:) = 0._wp ; divu_i(:,:) = 0._wp ; shear_i(:,:) = 0._wp 193 193 194 194 CALL lim_rst_opn( kt ) ! Open Ice restart file … … 196 196 IF( ln_nicep ) CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' ) ! control print 197 197 ! 198 IF( .NOT. lk_c1d ) THEN 199 ! Ice dynamics & transport (not in 1D case) 198 IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (except in 1D case) 200 199 CALL lim_dyn( kt ) ! Ice dynamics ( rheology/dynamics ) 201 200 CALL lim_trp( kt ) ! Ice transport ( Advection/diffusion ) … … 210 209 CALL lim_var_bv ! bulk brine volume (diag) 211 210 CALL lim_thd( kt ) ! Ice thermodynamics 212 zcoef = rdt_ice / 86400.e0! Ice natural aging211 zcoef = rdt_ice /rday ! Ice natural aging 213 212 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 214 213 CALL lim_var_glo2eqv ! this CALL is maybe not necessary (Martin) … … 268 267 269 268 inb_altests = 10 270 inb_alp(:) = 0269 inb_alp(:) = 0 271 270 272 271 ! Alert if incompatible volume and concentration … … 277 276 DO jj = 1, jpj 278 277 DO ji = 1, jpi 279 IF( v_i(ji,jj,jl) /= 0. e0 .AND. a_i(ji,jj,jl) == 0.e0) THEN278 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 280 279 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 281 280 WRITE(numout,*) ' at_i ', at_i(ji,jj) … … 297 296 DO jj = 1, jpj 298 297 DO ji = 1, jpi 299 IF( ht_i(ji,jj,jl) .GT. 50.0) THEN298 IF( ht_i(ji,jj,jl) > 50._wp ) THEN 300 299 CALL lim_prt_state( ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 301 300 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 309 308 DO jj = 1, jpj 310 309 DO ji = 1, jpi 311 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) .GT.0.5 .AND. &312 & at_i(ji,jj) .GT. 0.e0) THEN310 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 0.5 .AND. & 311 & at_i(ji,jj) > 0._wp ) THEN 313 312 CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 314 313 WRITE(numout,*) ' ice strength : ', strength(ji,jj) … … 332 331 DO jj = 1, jpj 333 332 DO ji = 1, jpi 334 IF( tms(ji,jj) .LE. 0.0 .AND. at_i(ji,jj) .GT. 0.e0) THEN333 IF( tms(ji,jj) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 335 334 CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 336 335 WRITE(numout,*) ' masks s, u, v : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) … … 356 355 DO ji = 1, jpi 357 356 !!gm test twice sm_i ... ???? bug? 358 IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR.&359 ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. &360 ( a_i(ji,jj,jl) .GT. 0.e0) ) THEN357 IF( ( ( ABS( sm_i(ji,jj,jl) ) < 0.5 ) .OR. & 358 ( ABS( sm_i(ji,jj,jl) ) < 0.5 ) ) .AND. & 359 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 361 360 ! CALL lim_prt_state(ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 362 361 ! WRITE(numout,*) ' sst : ', sst_m(ji,jj) … … 377 376 DO jj = 1, jpj 378 377 DO ji = 1, jpi 379 IF ( ( ( ABS( o_i(ji,jj,jl) ) .GT.rdt_ice ) .OR. &380 ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. &381 ( a_i(ji,jj,jl) .GT. 0.0) ) THEN378 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 379 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 380 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 382 381 CALL lim_prt_state( ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 383 382 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 … … 392 391 DO jj = 1, jpj 393 392 DO ji = 1, jpi 394 IF( ABS( emps(ji,jj) ) .GT. 1.0e-2 ) THEN393 IF( ABS( sfx (ji,jj) ) .GT. 1.0e-2 ) THEN 395 394 CALL lim_prt_state( ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 396 395 DO jl = 1, jpl … … 412 411 DO jj = 1, jpj 413 412 DO ji = 1, jpi 414 IF( ABS( qns(ji,jj) ) .GT. 1500.0 .AND. ( at_i(ji,jj) .GT. 0.0 )) THEN413 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 415 414 ! 416 415 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' … … 429 428 WRITE(numout,*) ' fdtcn : ', fdtcn(ji,jj) 430 429 WRITE(numout,*) ' fhmec : ', fhmec(ji,jj) 431 WRITE(numout,*) ' fheat_ rpo : ', fheat_rpo(ji,jj)430 WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj) 432 431 WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 433 432 WRITE(numout,*) ' fhbri : ', fhbri(ji,jj) … … 450 449 DO ji = 1, jpi 451 450 ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt 452 IF( t_i(ji,jj,jk,jl) .GE. ztmelts .AND. v_i(ji,jj,jl) .GT.1.e-6 &453 & .AND. a_i(ji,jj,jl) .GT. 0.e0) THEN451 IF( t_i(ji,jj,jk,jl) >= ztmelts .AND. v_i(ji,jj,jl) > 1.e-6 & 452 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 454 453 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 455 454 WRITE(numout,*) ' ji, jj, jk, jl : ', ji, jj, jk, jl … … 606 605 WRITE(numout,*) ' - Heat / FW fluxes ' 607 606 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ ' 608 ! WRITE(numout,*) ' fsbri : ', fsbri(ki,kj)609 ! WRITE(numout,*) ' fseqv : ', fseqv(ki,kj)607 ! WRITE(numout,*) ' sfx_bri : ', sfx_bri (ki,kj) 608 ! WRITE(numout,*) ' sfx : ', sfx (ki,kj) 610 609 ! WRITE(numout,*) ' fsalt_res : ', fsalt_res(ki,kj) 611 WRITE(numout,*) ' fmmec : ', fmmec (ki,kj)612 WRITE(numout,*) ' fhmec : ', fhmec (ki,kj)613 WRITE(numout,*) ' fhbri : ', fhbri (ki,kj)614 WRITE(numout,*) ' fheat_ rpo : ', fheat_rpo(ki,kj)610 WRITE(numout,*) ' fmmec : ', fmmec (ki,kj) 611 WRITE(numout,*) ' fhmec : ', fhmec (ki,kj) 612 WRITE(numout,*) ' fhbri : ', fhbri (ki,kj) 613 WRITE(numout,*) ' fheat_mec : ', fheat_mec(ki,kj) 615 614 WRITE(numout,*) 616 615 WRITE(numout,*) ' sst : ', sst_m(ki,kj) … … 621 620 WRITE(numout,*) ' utau_ice : ', utau_ice(ki,kj) 622 621 WRITE(numout,*) ' vtau_ice : ', vtau_ice(ki,kj) 623 WRITE(numout,*) ' utau : ', utau (ki,kj)624 WRITE(numout,*) ' vtau : ', vtau (ki,kj)625 WRITE(numout,*) ' oc. vel. u : ', u_oce (ki,kj)626 WRITE(numout,*) ' oc. vel. v : ', v_oce (ki,kj)622 WRITE(numout,*) ' utau : ', utau (ki,kj) 623 WRITE(numout,*) ' vtau : ', vtau (ki,kj) 624 WRITE(numout,*) ' oc. vel. u : ', u_oce (ki,kj) 625 WRITE(numout,*) ' oc. vel. v : ', v_oce (ki,kj) 627 626 ENDIF 628 627 … … 640 639 WRITE(numout,*) 641 640 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 642 WRITE(numout,*) ' qsr 643 WRITE(numout,*) ' qns 641 WRITE(numout,*) ' qsr : ', qsr(ki,kj) 642 WRITE(numout,*) ' qns : ', qns(ki,kj) 644 643 WRITE(numout,*) 645 644 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 646 WRITE(numout,*) ' emps : ', emps(ki,kj) 647 WRITE(numout,*) ' emp : ', emp(ki,kj) 648 WRITE(numout,*) ' fsbri : ', fsbri(ki,kj) 649 WRITE(numout,*) ' fseqv : ', fseqv(ki,kj) 650 WRITE(numout,*) ' fsalt_res : ', fsalt_res(ki,kj) 651 WRITE(numout,*) ' fsalt_rpo : ', fsalt_rpo(ki,kj) 645 WRITE(numout,*) ' emp : ', emp (ki,kj) 646 WRITE(numout,*) ' sfx_bri : ', sfx_bri(ki,kj) 647 WRITE(numout,*) ' sfx : ', sfx (ki,kj) 648 WRITE(numout,*) ' sfx_res : ', sfx_res(ki,kj) 649 WRITE(numout,*) ' sfx_mec : ', sfx_mec(ki,kj) 652 650 WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 653 WRITE(numout,*) ' fheat_res 651 WRITE(numout,*) ' fheat_res : ', fheat_res(ki,kj) 654 652 WRITE(numout,*) 655 653 WRITE(numout,*) ' - Momentum fluxes '
Note: See TracChangeset
for help on using the changeset viewer.