- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/ICE/icectl.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/ICE/icectl.F90
r12178 r12928 51 51 52 52 !! * Substitutions 53 # include " vectopt_loop_substitute.h90"53 # include "do_loop_substitute.h90" 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 104 104 105 105 ! -- mass diag -- ! 106 zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_ rdtice &106 zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_Dt_ice & 107 107 & + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + & 108 108 & wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & … … 111 111 ! 112 112 ! -- salt diag -- ! 113 zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_ rdtice &113 zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_Dt_ice & 114 114 & + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 115 115 & sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & … … 118 118 ! -- heat diag -- ! 119 119 zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & 120 & ) * r1_ rdtice &120 & ) * r1_Dt_ice & 121 121 & + glob_sum( 'icectl', ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 122 122 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) & … … 141 141 ! check conservation issues 142 142 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 143 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * r dt_ice143 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rDt_ice 144 144 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 145 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * r dt_ice145 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rDt_ice 146 146 IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 147 & WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * r dt_ice147 & WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rDt_ice 148 148 ! check negative values 149 149 IF( zdiag_vmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_i < 0 = ',zdiag_vmin … … 160 160 ! it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now 161 161 !IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 162 ! & WRITE(numout,*) cd_routine,' : violation adv scheme [kg] = ',zvtrp * r dt_ice162 ! & WRITE(numout,*) cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice 163 163 ENDIF 164 164 ! … … 201 201 IF( lwp ) THEN 202 202 IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 203 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * r dt_ice203 & WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rDt_ice 204 204 IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 205 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * r dt_ice206 !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * r dt_ice205 & WRITE(numout,*) cd_routine,' : violation salt cons. [g] = ',zdiag_salt * rDt_ice 206 !!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,*) cd_routine,' : violation heat cons. [J] = ',zdiag_heat * rDt_ice 207 207 ENDIF 208 208 ! … … 250 250 251 251 ! -- mass diag -- ! 252 zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_ rdtice &252 zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_Dt_ice & 253 253 & + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 254 254 & wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) & … … 257 257 ! 258 258 ! -- salt diag -- ! 259 zdiag_salt = ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_ rdtice &259 zdiag_salt = ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_Dt_ice & 260 260 & + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) & 261 261 & - pdiag_fs … … 263 263 ! 264 264 ! -- heat diag -- ! 265 zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_ rdtice &265 zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_Dt_ice & 266 266 & + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 267 267 & - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) & … … 331 331 IF(lwp) WRITE(numout,*) 332 332 333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 334 334 335 335 CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain … … 368 368 cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert 369 369 DO jl = 1, jpl 370 DO jj = 1, jpj 371 DO ji = 1, jpi 372 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 373 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 374 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 375 ENDIF 376 END DO 377 END DO 370 DO_2D_11_11 371 IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN 372 WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration ' 373 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 374 ENDIF 375 END_2D 378 376 END DO 379 377 … … 382 380 cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 383 381 jl = jpl 384 DO jj = 1, jpj 385 DO ji = 1, jpi 386 IF( h_i(ji,jj,jl) > 50._wp ) THEN 387 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 388 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 389 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 390 ENDIF 391 END DO 392 END DO 382 DO_2D_11_11 383 IF( h_i(ji,jj,jl) > 50._wp ) THEN 384 WRITE(numout,*) ' ALERTE 3 : Very thick ice' 385 !CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' ) 386 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 387 ENDIF 388 END_2D 393 389 394 390 ! Alert if very fast ice 395 391 ialert_id = 4 ! reference number of this alert 396 392 cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 397 DO jj = 1, jpj 398 DO ji = 1, jpi 399 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 400 & at_i(ji,jj) > 0._wp ) THEN 401 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 402 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 403 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 404 ENDIF 405 END DO 406 END DO 393 DO_2D_11_11 394 IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. & 395 & at_i(ji,jj) > 0._wp ) THEN 396 WRITE(numout,*) ' ALERTE 4 : Very fast ice' 397 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' ) 398 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 399 ENDIF 400 END_2D 407 401 408 402 ! Alert on salt flux 409 403 ialert_id = 5 ! reference number of this alert 410 404 cl_alname(ialert_id) = ' High salt flux ' ! name of the alert 411 DO jj = 1, jpj 412 DO ji = 1, jpi 413 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 414 WRITE(numout,*) ' ALERTE 5 : High salt flux' 415 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 416 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 417 ENDIF 418 END DO 419 END DO 405 DO_2D_11_11 406 IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth 407 WRITE(numout,*) ' ALERTE 5 : High salt flux' 408 !CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' ) 409 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 410 ENDIF 411 END_2D 420 412 421 413 ! Alert if there is ice on continents 422 414 ialert_id = 6 ! reference number of this alert 423 415 cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 424 DO jj = 1, jpj 425 DO ji = 1, jpi 426 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 427 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 428 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 429 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 430 ENDIF 431 END DO 432 END DO 416 DO_2D_11_11 417 IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 418 WRITE(numout,*) ' ALERTE 6 : Ice on continents' 419 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' ) 420 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 421 ENDIF 422 END_2D 433 423 434 424 ! … … 437 427 cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert 438 428 DO jl = 1, jpl 439 DO jj = 1, jpj 440 DO ji = 1, jpi 441 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 442 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 429 DO_2D_11_11 430 IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN 431 WRITE(numout,*) ' ALERTE 7 : Very fresh ice' 443 432 ! CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' ) 444 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 445 ENDIF 446 END DO 447 END DO 433 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 434 ENDIF 435 END_2D 448 436 END DO 449 437 ! … … 451 439 ialert_id = 8 ! reference number of this alert 452 440 cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert 453 DO jj = 1, jpj 454 DO ji = 1, jpi 455 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 456 ! 457 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 458 !CALL ice_prt( kt, ji, jj, 2, ' ') 459 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 460 ! 461 ENDIF 462 END DO 463 END DO 441 DO_2D_11_11 442 IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN 443 ! 444 WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux' 445 !CALL ice_prt( kt, ji, jj, 2, ' ') 446 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 447 ! 448 ENDIF 449 END_2D 464 450 !+++++ 465 451 … … 468 454 cl_alname(ialert_id) = ' Very old ice ' ! name of the alert 469 455 DO jl = 1, jpl 470 DO jj = 1, jpj 471 DO ji = 1, jpi 472 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. & 473 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 474 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 475 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 476 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 477 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 478 ENDIF 479 END DO 480 END DO 456 DO_2D_11_11 457 IF ( ( ( ABS( o_i(ji,jj,jl) ) > rDt_ice ) .OR. & 458 ( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. & 459 ( a_i(ji,jj,jl) > 0._wp ) ) THEN 460 WRITE(numout,*) ' ALERTE 9 : Wrong ice age' 461 !CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ') 462 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 463 ENDIF 464 END_2D 481 465 END DO 482 466 … … 486 470 inb_alp(ialert_id) = 0 487 471 DO jl = 1, jpl 488 DO jk = 1, nlay_i 489 DO jj = 1, jpj 490 DO ji = 1, jpi 491 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 492 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 493 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 494 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 495 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 496 ENDIF 497 END DO 498 END DO 499 END DO 472 DO_3D_11_11( 1, nlay_i ) 473 ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0 474 IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 & 475 & .AND. a_i(ji,jj,jl) > 0._wp ) THEN 476 WRITE(numout,*) ' ALERTE 10 : Very warm ice' 477 inb_alp(ialert_id) = inb_alp(ialert_id) + 1 478 ENDIF 479 END_3D 500 480 END DO 501 481 … … 671 651 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 672 652 WRITE(numout,*) ' qsb_ice_bot : ', qsb_ice_bot(ji,jj) 673 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_ rdtice653 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_Dt_ice 674 654 WRITE(numout,*) 675 655 WRITE(numout,*) ' - Salt fluxes at bottom interface ***' … … 695 675 !! *** ROUTINE ice_prt3D *** 696 676 !! 697 !! ** Purpose : CTL prints of ice arrays in case ln_ctl is activated677 !! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated 698 678 !! 699 679 !!------------------------------------------------------------------- … … 745 725 746 726 CALL prt_ctl_info(' ') 747 CALL prt_ctl_info(' - Heat / FW fluxes : ')748 CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ')749 CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' sst : ', tab2d_2=sss_m , clinfo2= ' sss : ')750 CALL prt_ctl(tab2d_1=qsr , clinfo1= ' qsr : ', tab2d_2=qns , clinfo2= ' qns : ')751 CALL prt_ctl(tab2d_1=emp , clinfo1= ' emp : ', tab2d_2=sfx , clinfo2= ' sfx : ')752 753 CALL prt_ctl_info(' ')754 727 CALL prt_ctl_info(' - Stresses : ') 755 728 CALL prt_ctl_info(' ~~~~~~~~~~ ')
Note: See TracChangeset
for help on using the changeset viewer.
