- Timestamp:
- 2015-12-16T10:25:22+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5541 r6060 25 25 USE thd_ice ! LIM-3: thermodynamical variables 26 26 USE dom_ice ! LIM-3: ice domain 27 27 ! 28 28 USE sbc_oce ! Surface boundary condition: ocean fields 29 29 USE sbc_ice ! Surface boundary condition: ice fields … … 32 32 USE sbccpl ! Surface boundary condition: coupled interface 33 33 USE albedo ! ocean & ice albedo 34 34 ! 35 35 USE phycst ! Define parameters for the routines 36 36 USE eosbn2 ! equation of state … … 47 47 USE limupdate2 ! update of global variables 48 48 USE limvar ! Ice variables switch 49 49 USE limctl ! 50 50 USE limmsh ! LIM mesh 51 51 USE limistate ! LIM initial state 52 52 USE limthd_sal ! LIM ice thermodynamics: salinity 53 53 ! 54 54 USE c1d ! 1D vertical configuration 55 USE in_out_manager ! I/O manager 56 USE iom ! I/O manager library 57 USE prtctl ! Print control 58 USE lib_fortran ! 55 59 USE lbclnk ! lateral boundary condition - MPP link 56 60 USE lib_mpp ! MPP library 57 61 USE wrk_nemo ! work arrays 58 62 USE timing ! Timing 59 USE iom ! I/O manager library60 USE in_out_manager ! I/O manager61 USE prtctl ! Print control62 USE lib_fortran !63 USE limctl64 63 65 64 #if defined key_bdy … … 74 73 75 74 !! * Substitutions 76 # include "domzgr_substitute.h90"77 75 # include "vectopt_loop_substitute.h90" 78 76 !!---------------------------------------------------------------------- … … 82 80 !!---------------------------------------------------------------------- 83 81 CONTAINS 84 85 !!======================================================================86 82 87 83 SUBROUTINE sbc_ice_lim( kt, kblk ) … … 270 266 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM-3) time stepping' 271 267 ! 272 268 ! ! Open the reference and configuration namelist files and namelist output file 273 269 CALL ctl_opn( numnam_ice_ref, 'namelist_ice_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 274 270 CALL ctl_opn( numnam_ice_cfg, 'namelist_ice_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 275 271 IF(lwm) CALL ctl_opn( numoni, 'output.namelist.ice', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, 1 ) 276 272 ! 277 273 CALL ice_run ! set some ice run parameters 278 274 ! … … 348 344 REWIND( numnam_ice_ref ) ! Namelist namicerun in reference namelist : Parameters for ice 349 345 READ ( numnam_ice_ref, namicerun, IOSTAT = ios, ERR = 901) 350 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp )351 346 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in reference namelist', lwp ) 347 ! 352 348 REWIND( numnam_ice_cfg ) ! Namelist namicerun in configuration namelist : Parameters for ice 353 349 READ ( numnam_ice_cfg, namicerun, IOSTAT = ios, ERR = 902 ) 354 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 355 IF(lwm) WRITE ( numoni, namicerun ) 356 ! 350 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicerun in configuration namelist', lwp ) 351 IF(lwm) WRITE( numoni, namicerun ) 357 352 ! 358 353 IF(lwp) THEN ! control print … … 405 400 REWIND( numnam_ice_ref ) ! Namelist namiceitd in reference namelist : Parameters for ice 406 401 READ ( numnam_ice_ref, namiceitd, IOSTAT = ios, ERR = 903) 407 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp )408 402 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in reference namelist', lwp ) 403 ! 409 404 REWIND( numnam_ice_cfg ) ! Namelist namiceitd in configuration namelist : Parameters for ice 410 405 READ ( numnam_ice_cfg, namiceitd, IOSTAT = ios, ERR = 904 ) 411 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 412 IF(lwm) WRITE ( numoni, namiceitd ) 413 ! 406 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceitd in configuration namelist', lwp ) 407 IF(lwm) WRITE( numoni, namiceitd ) 414 408 ! 415 409 IF(lwp) THEN ! control print … … 417 411 WRITE(numout,*) 'ice_itd : ice cat distribution' 418 412 WRITE(numout,*) ' ~~~~~~' 419 WRITE(numout,*) ' shape of ice categories distribution 420 WRITE(numout,*) ' mean ice thickness in the domain ( only active if nn_catbnd=2)rn_himean = ', rn_himean413 WRITE(numout,*) ' shape of ice categories distribution nn_catbnd = ', nn_catbnd 414 WRITE(numout,*) ' mean ice thickness in the domain (used if nn_catbnd=2) rn_himean = ', rn_himean 421 415 ENDIF 422 416 ! 423 417 !---------------------------------- 424 418 !- Thickness categories boundaries … … 427 421 IF(lwp) WRITE(numout,*) 'lim_itd_init : Initialization of ice cat distribution ' 428 422 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 429 423 ! 430 424 hi_max(:) = 0._wp 431 432 SELECT CASE ( nn_catbnd ) 433 !---------------------- 434 CASE (1) ! tanh function (CICE) 435 !---------------------- 425 ! 426 SELECT CASE ( nn_catbnd ) ! type of ice categories distribution 427 ! 428 CASE (1) !== tanh function (CICE) ==! 436 429 zc1 = 3._wp / REAL( jpl, wp ) 437 430 zc2 = 10._wp * zc1 438 431 zc3 = 3._wp 439 440 432 DO jl = 1, jpl 441 433 zx1 = REAL( jl-1, wp ) / REAL( jpl, wp ) 442 434 hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) ) 443 435 END DO 444 445 !---------------------- 446 CASE (2) ! h^(-alpha) function 447 !---------------------- 448 zalpha = 0.05 ! exponent of the transform function 449 450 zhmax = 3.*rn_himean 451 436 ! 437 CASE (2) !== h^(-alpha) function ==! 438 zalpha = 0.05_wp 439 zhmax = 3._wp * rn_himean 452 440 DO jl = 1, jpl 453 441 znum = jpl * ( zhmax+1 )**zalpha 454 zden = ( jpl - jl ) * ( zhmax+1 )**zalpha + jl442 zden = REAL( jpl-jl , wp ) * ( zhmax + 1._wp )**zalpha + REAL( jl , wp ) 455 443 hi_max(jl) = ( znum / zden )**(1./zalpha) - 1 456 444 END DO 457 445 ! 458 446 END SELECT 459 460 DO jl = 1, jpl 447 ! 448 DO jl = 1, jpl ! mean thickness by category 461 449 hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 462 450 END DO 463 464 ! Set hi_max(jpl) to a big value to ensure that all ice is thinner than hi_max(jpl) 465 hi_max(jpl) = 99._wp 466 451 ! 452 hi_max(jpl) = 99._wp ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 453 ! 467 454 IF(lwp) WRITE(numout,*) ' Thickness category boundaries ' 468 455 IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl) … … 471 458 472 459 473 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 460 SUBROUTINE ice_lim_flx( ptn_ice , palb_ice, pqns_ice , & 461 & pqsr_ice, pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 474 462 !!--------------------------------------------------------------------- 475 463 !! *** ROUTINE ice_lim_flx *** … … 483 471 !!--------------------------------------------------------------------- 484 472 INTEGER , INTENT(in ) :: k_limflx ! =-1 do nothing; =0 average ; 485 473 ! ! =1 average and redistribute ; =2 redistribute 486 474 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptn_ice ! ice surface temperature 487 475 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb_ice ! ice albedo … … 503 491 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 504 492 !!---------------------------------------------------------------------- 505 493 ! 506 494 IF( nn_timing == 1 ) CALL timing_start('ice_lim_flx') 507 !508 495 ! 509 496 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! … … 529 516 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 530 517 END SELECT 531 518 ! 532 519 SELECT CASE( k_limflx ) !== redistribution on all ice categories ==! 533 520 CASE( 1 , 2 ) … … 548 535 ! 549 536 END SUBROUTINE ice_lim_flx 537 550 538 551 539 SUBROUTINE sbc_lim_bef … … 564 552 u_ice_b(:,:) = u_ice(:,:) 565 553 v_ice_b(:,:) = v_ice(:,:) 566 554 ! 567 555 END SUBROUTINE sbc_lim_bef 556 568 557 569 558 SUBROUTINE sbc_lim_diag0 … … 580 569 sfx_bom(:,:) = 0._wp ; sfx_sum(:,:) = 0._wp 581 570 sfx_res(:,:) = 0._wp 582 571 ! 583 572 wfx_snw(:,:) = 0._wp ; wfx_ice(:,:) = 0._wp 584 573 wfx_sni(:,:) = 0._wp ; wfx_opw(:,:) = 0._wp … … 587 576 wfx_res(:,:) = 0._wp ; wfx_sub(:,:) = 0._wp 588 577 wfx_spr(:,:) = 0._wp ; 589 578 ! 590 579 hfx_thd(:,:) = 0._wp ; 591 580 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 596 585 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 597 586 hfx_err_dif(:,:) = 0._wp ; 598 587 ! 599 588 afx_tot(:,:) = 0._wp ; 600 589 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 601 590 ! 602 591 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ; 603 592 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ; 604 593 ! 605 594 END SUBROUTINE sbc_lim_diag0 606 595 … … 634 623 END FUNCTION fice_ice_ave 635 624 636 637 625 #else 638 626 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
