- Timestamp:
- 2016-12-19T16:20:16+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r6994 r7510 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE ice ! LIM:sea-ice variables24 USE ice ! sea-ice variables 25 25 USE sbc_oce ! Surface boundary condition: ocean fields 26 26 USE sbc_ice ! Surface boundary condition: ice fields 27 USE thd_ice ! LIMthermodynamic sea-ice variables28 USE limthd_dif ! LIM: thermodynamics,vertical diffusion29 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation30 USE limthd_da ! LIM: thermodynamics,lateral melting31 USE limthd_sal ! LIM: thermodynamics,ice salinity32 USE limthd_ent ! LIM: thermodynamics,ice enthalpy redistribution33 USE limthd_lac ! LIM-3lateral accretion27 USE thd_ice ! thermodynamic sea-ice variables 28 USE limthd_dif ! vertical diffusion 29 USE limthd_dh ! ice-snow growth and melt 30 USE limthd_da ! lateral melting 31 USE limthd_sal ! ice salinity 32 USE limthd_ent ! ice enthalpy redistribution 33 USE limthd_lac ! lateral accretion 34 34 USE limitd_th ! remapping thickness distribution 35 USE limtab ! LIM: 1D <==> 2D transformation 36 USE limvar ! LIM: sea-ice variables 35 USE limtab ! 1D <==> 2D transformation 36 USE limvar ! 37 USE limcons ! conservation tests 38 USE limctl ! control print 39 ! 40 USE in_out_manager ! I/O manager 37 41 USE lbclnk ! lateral boundary condition - MPP links 38 42 USE lib_mpp ! MPP library 39 43 USE wrk_nemo ! work arrays 40 USE in_out_manager ! I/O manager41 44 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 42 45 USE timing ! Timing 43 USE limcons ! conservation tests44 USE limctl45 46 46 47 IMPLICIT NONE … … 80 81 !!--------------------------------------------------------------------- 81 82 INTEGER, INTENT(in) :: kt ! number of iteration 82 ! !83 ! 83 84 INTEGER :: ji, jj, jk, jl ! dummy loop indices 84 85 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 85 INTEGER :: ii, ij ! temporary dummy loop index86 86 REAL(wp) :: zfric_u, zqld, zqfr 87 87 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b … … 92 92 !!------------------------------------------------------------------- 93 93 94 IF( nn_timing == 1 ) CALL timing_start('limthd')94 IF( nn_timing == 1 ) CALL timing_start('limthd') 95 95 96 96 CALL wrk_alloc( jpi,jpj, zu_io, zv_io, zfric ) … … 224 224 END DO 225 225 END DO 226 226 227 227 !------------------------------------------------------------------------------! 228 228 ! Thermodynamic computation (only on grid points covered by ice) 229 229 !------------------------------------------------------------------------------! 230 230 231 DO jl = 1, jpl !loop over ice categories 231 232 … … 358 359 !!------------------------------------------------------------------- 359 360 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 360 ! !361 ! 361 362 INTEGER :: ji, jk ! dummy loop indices 362 363 REAL(wp) :: ztmelts, zaaa, zbbb, zccc, zdiscrim ! local scalar … … 378 379 END DO 379 380 END DO 380 381 ! 381 382 END SUBROUTINE lim_thd_temp 383 382 384 383 385 SUBROUTINE lim_thd_lam( kideb, kiut ) … … 389 391 !!----------------------------------------------------------------------- 390 392 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 391 INTEGER :: ji ! dummy loop indices 392 REAL(wp) :: zhi_bef ! ice thickness before thermo 393 REAL(wp) :: zdh_mel, zda_mel ! net melting 394 REAL(wp) :: zvi, zvs ! ice/snow volumes 395 393 ! 394 INTEGER :: ji ! dummy loop indices 395 REAL(wp) :: zhi_bef ! ice thickness before thermo 396 REAL(wp) :: zdh_mel, zda_mel ! net melting 397 REAL(wp) :: zvi, zvs ! ice/snow volumes 398 !!----------------------------------------------------------------------- 399 ! 396 400 DO ji = kideb, kiut 397 401 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) ) … … 411 415 END IF 412 416 END DO 413 417 ! 414 418 END SUBROUTINE lim_thd_lam 419 415 420 416 421 SUBROUTINE lim_thd_1d2d( nbpb, jl, kn ) … … 420 425 !! ** Purpose : move arrays from 1d to 2d and the reverse 421 426 !!----------------------------------------------------------------------- 422 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D 423 ! 2= from 1D to 2D 427 INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D 424 428 INTEGER, INTENT(in) :: nbpb ! size of 1D arrays 425 429 INTEGER, INTENT(in) :: jl ! ice cat 430 ! 426 431 INTEGER :: jk ! dummy loop indices 427 432 !!----------------------------------------------------------------------- 433 ! 428 434 SELECT CASE( kn ) 429 430 CASE( 1 ) 431 435 ! 436 CASE( 1 ) ! from 2D to 1D 437 ! 432 438 CALL tab_2d_1d( nbpb, at_i_1d (1:nbpb), at_i , jpi, jpj, npb(1:nbpb) ) 433 439 CALL tab_2d_1d( nbpb, a_i_1d (1:nbpb), a_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 434 440 CALL tab_2d_1d( nbpb, ht_i_1d (1:nbpb), ht_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 435 441 CALL tab_2d_1d( nbpb, ht_s_1d (1:nbpb), ht_s(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 436 442 ! 437 443 CALL tab_2d_1d( nbpb, t_su_1d (1:nbpb), t_su(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 438 444 CALL tab_2d_1d( nbpb, sm_i_1d (1:nbpb), sm_i(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 446 452 CALL tab_2d_1d( nbpb, s_i_1d(1:nbpb,jk), s_i(:,:,jk,jl) , jpi, jpj, npb(1:nbpb) ) 447 453 END DO 448 454 ! 449 455 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 450 456 CALL tab_2d_1d( nbpb, qevap_ice_1d(1:nbpb), qevap_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) … … 461 467 CALL tab_2d_1d( nbpb, qlead_1d (1:nbpb), qlead , jpi, jpj, npb(1:nbpb) ) 462 468 CALL tab_2d_1d( nbpb, fhld_1d (1:nbpb), fhld , jpi, jpj, npb(1:nbpb) ) 463 469 ! 464 470 CALL tab_2d_1d( nbpb, wfx_snw_1d (1:nbpb), wfx_snw , jpi, jpj, npb(1:nbpb) ) 465 471 CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub , jpi, jpj, npb(1:nbpb) ) 466 472 ! 467 473 CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog , jpi, jpj, npb(1:nbpb) ) 468 474 CALL tab_2d_1d( nbpb, wfx_bom_1d (1:nbpb), wfx_bom , jpi, jpj, npb(1:nbpb) ) … … 471 477 CALL tab_2d_1d( nbpb, wfx_res_1d (1:nbpb), wfx_res , jpi, jpj, npb(1:nbpb) ) 472 478 CALL tab_2d_1d( nbpb, wfx_spr_1d (1:nbpb), wfx_spr , jpi, jpj, npb(1:nbpb) ) 473 479 ! 474 480 CALL tab_2d_1d( nbpb, sfx_bog_1d (1:nbpb), sfx_bog , jpi, jpj, npb(1:nbpb) ) 475 481 CALL tab_2d_1d( nbpb, sfx_bom_1d (1:nbpb), sfx_bom , jpi, jpj, npb(1:nbpb) ) … … 479 485 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 480 486 CALL tab_2d_1d( nbpb, sfx_sub_1d (1:nbpb), sfx_sub , jpi, jpj,npb(1:nbpb) ) 481 487 ! 482 488 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) 483 489 CALL tab_2d_1d( nbpb, hfx_spr_1d (1:nbpb), hfx_spr , jpi, jpj, npb(1:nbpb) ) … … 493 499 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 494 500 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 495 496 CASE( 2 ) 497 501 ! 502 CASE( 2 ) ! from 1D to 2D 503 ! 498 504 CALL tab_1d_2d( nbpb, at_i , npb, at_i_1d (1:nbpb) , jpi, jpj ) 499 505 CALL tab_1d_2d( nbpb, ht_i(:,:,jl) , npb, ht_i_1d (1:nbpb) , jpi, jpj ) … … 512 518 END DO 513 519 CALL tab_1d_2d( nbpb, qlead , npb, qlead_1d (1:nbpb) , jpi, jpj ) 514 520 ! 515 521 CALL tab_1d_2d( nbpb, wfx_snw , npb, wfx_snw_1d(1:nbpb) , jpi, jpj ) 516 522 CALL tab_1d_2d( nbpb, wfx_sub , npb, wfx_sub_1d(1:nbpb) , jpi, jpj ) 517 523 ! 518 524 CALL tab_1d_2d( nbpb, wfx_bog , npb, wfx_bog_1d(1:nbpb) , jpi, jpj ) 519 525 CALL tab_1d_2d( nbpb, wfx_bom , npb, wfx_bom_1d(1:nbpb) , jpi, jpj ) … … 522 528 CALL tab_1d_2d( nbpb, wfx_res , npb, wfx_res_1d(1:nbpb) , jpi, jpj ) 523 529 CALL tab_1d_2d( nbpb, wfx_spr , npb, wfx_spr_1d(1:nbpb) , jpi, jpj ) 524 530 ! 525 531 CALL tab_1d_2d( nbpb, sfx_bog , npb, sfx_bog_1d(1:nbpb) , jpi, jpj ) 526 532 CALL tab_1d_2d( nbpb, sfx_bom , npb, sfx_bom_1d(1:nbpb) , jpi, jpj ) … … 530 536 CALL tab_1d_2d( nbpb, sfx_bri , npb, sfx_bri_1d(1:nbpb) , jpi, jpj ) 531 537 CALL tab_1d_2d( nbpb, sfx_sub , npb, sfx_sub_1d(1:nbpb) , jpi, jpj ) 532 538 ! 533 539 CALL tab_1d_2d( nbpb, hfx_thd , npb, hfx_thd_1d(1:nbpb) , jpi, jpj ) 534 540 CALL tab_1d_2d( nbpb, hfx_spr , npb, hfx_spr_1d(1:nbpb) , jpi, jpj ) … … 549 555 ! 550 556 END SELECT 551 557 ! 552 558 END SUBROUTINE lim_thd_1d2d 553 559 … … 580 586 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 581 587 IF(lwm) WRITE ( numoni, namicethd ) 582 !583 IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN584 nn_monocat = 0585 IF(lwp) WRITE(numout, *) ' nn_monocat must be 0 in multi-category case '586 ENDIF587 588 ! 588 589 IF(lwp) THEN ! control print … … 615 616 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 616 617 ENDIF 618 IF( jpl > 1 .AND. nn_monocat == 1 ) THEN 619 nn_monocat = 0 620 IF(lwp) WRITE(numout,*) 621 IF(lwp) WRITE(numout,*) ' nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen' 622 ENDIF 617 623 ! 618 624 END SUBROUTINE lim_thd_init
Note: See TracChangeset
for help on using the changeset viewer.
