MODULE limdiahsb !!====================================================================== !! *** MODULE limdia_hsb *** !! LIM-3 sea ice model : diagnostics of ice model !!====================================================================== !! History : 3.4 ! 2012-10 (C. Rousset) original code !!---------------------------------------------------------------------- #if defined key_lim3 !!---------------------------------------------------------------------- !! 'key_lim3' LIM3 sea-ice model !!---------------------------------------------------------------------- !! lim_dia_hsb : computation and output of the time evolution of keys variables !! lim_dia_hsb_init : initialization and namelist read !!---------------------------------------------------------------------- USE ice ! LIM-3: sea-ice variable USE par_ice ! LIM-3: ice parameters USE dom_ice ! LIM-3: sea-ice domain USE dom_oce ! ocean domain USE sbc_oce ! surface boundary condition: ocean fields USE daymod ! model calendar USE phycst ! physical constant USE in_out_manager ! I/O manager USE lib_mpp ! MPP library USE timing ! preformance summary USE iom ! I/O manager USE lib_fortran ! glob_sum USE limrst ! ice restart IMPLICIT NONE PRIVATE PUBLIC lim_diahsb ! routine called by ice_step.F90 !!PUBLIC lim_diahsb_init ! routine called by ice_init.F90 !!PUBLIC lim_diahsb_rst ! routine called by ice_init.F90 REAL(dp) :: frc_sal, frc_vol ! global forcing trends REAL(dp) :: bg_grme ! global ice growth+melt trends REAL(wp) :: epsi06 = 1.e-6_wp ! small number REAL(wp) :: epsi03 = 1.e-3_wp ! small number !! * Substitutions # include "vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.4 , NEMO Consortium (2012) !! $Id: limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod $ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE lim_diahsb !!--------------------------------------------------------------------------- !! *** ROUTINE lim_diahsb *** !! !! ** Purpose: Compute the ice global heat content, salt content and volume conservation !! !!--------------------------------------------------------------------------- !! REAL(dp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc REAL(dp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_thd, zbg_sfx_res, zbg_sfx_mec REAL(dp) :: zbg_emp, zbg_emp_bog, zbg_emp_lag, zbg_emp_sig, zbg_emp_dyg, zbg_emp_bom, zbg_emp_sum, zbg_emp_res REAL(dp) :: z_frc_vol, z_frc_sal, z_bg_grme REAL(dp) :: z1_area ! - - REAL(dp) :: zinda, zindb !!--------------------------------------------------------------------------- IF( nn_timing == 1 ) CALL timing_start('lim_diahsb') IF( numit == nstart ) CALL lim_diahsb_init ! 1/area z1_area = 1.d0 / MAX( glob_sum( area(:,:) * tms(:,:) ), epsi06 ) zinda = MAX( 0.d0 , SIGN( 1.d0 , glob_sum( area(:,:) * tms(:,:) ) - epsi06 ) ) ! ----------------------- ! ! 1 - Content variations ! ! ----------------------- ! zbg_ivo = glob_sum( vt_i(:,:) * area(:,:) * tms(:,:) ) ! volume ice zbg_svo = glob_sum( vt_s(:,:) * area(:,:) * tms(:,:) ) ! volume snow zbg_are = glob_sum( at_i(:,:) * area(:,:) * tms(:,:) ) ! area zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) ! mean salt content zbg_tem = glob_sum( ( tm_i(:,:) - rtt ) * vt_i(:,:) * area(:,:) * tms(:,:) ) ! mean temp content !zbg_ihc = glob_sum( et_i(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content !zbg_shc = glob_sum( et_s(:,:) * area(:,:) * tms(:,:) ) / MAX( zbg_svo,epsi06 ) ! snow heat content zbg_ihc = glob_sum( et_i(:,:) * 1.e-11 ) ! ice heat content [10^9*1.e-11 J] zbg_shc = glob_sum( et_s(:,:) * 1.e-11 ) ! snow heat content [10^9*1.e-11 J] zbg_emp = zinda * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday zbg_emp_bog = zinda * glob_sum( diag_bot_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday zbg_emp_lag = zinda * glob_sum( diag_lat_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday zbg_emp_sig = zinda * glob_sum( diag_sni_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday zbg_emp_dyg = zinda * glob_sum( diag_dyn_gr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday zbg_emp_bom = zinda * glob_sum( diag_bot_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday zbg_emp_sum = zinda * glob_sum( diag_sur_me(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday zbg_emp_res = zinda * glob_sum( diag_res_pr(:,:) * area(:,:) * tms(:,:) ) * z1_area * rhoic * r1_rau0 * rday zbg_sfx = zinda * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday zbg_sfx_bri = zinda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday zbg_sfx_thd = zinda * glob_sum( sfx_thd(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday zbg_sfx_res = zinda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday zbg_sfx_mec = zinda * glob_sum( sfx_mec(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday ! --------------------------------------------- ! ! 2 - Trends due to forcing and ice growth/melt ! ! --------------------------------------------- ! z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * area(:,:) * tms(:,:) ) ! volume fluxes z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) ! salt fluxes z_bg_grme = glob_sum( ( diag_bot_gr(:,:) + diag_lat_gr(:,:) + diag_sni_gr(:,:) + diag_dyn_gr(:,:) + & & diag_bot_me(:,:) + diag_sur_me(:,:) + diag_res_pr(:,:) ) * area(:,:) * tms(:,:) ) ! volume fluxes ! frc_vol = frc_vol + z_frc_vol * rdt_ice frc_sal = frc_sal + z_frc_sal * rdt_ice bg_grme = bg_grme + z_bg_grme * rdt_ice ! difference !frc_vol = zbg_ivo - frc_vol !frc_sal = zbg_sal - frc_sal ! ----------------------- ! ! 3 - Diagnostics writing ! ! ----------------------- ! zindb = MAX( 0.d0 , SIGN( 1.d0 , zbg_ivo - epsi06 ) ) ! CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9 ) ! ice volume (km3 equivalent liquid) CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9 ) ! snw volume (km3 equivalent liquid) CALL iom_put( 'ibgarea' , zbg_are * 1.e-6 ) ! ice area (km2) CALL iom_put( 'ibgsaline' , zindb * zbg_sal / MAX( zbg_ivo, epsi06 ) ) ! ice saline (psu) CALL iom_put( 'ibgtemper' , zindb * zbg_tem / MAX( zbg_ivo, epsi06 ) ) ! ice temper (C) CALL iom_put( 'ibgheatco' , zbg_ihc ) ! ice heat content (1.e20 J) CALL iom_put( 'sbgheatco' , zbg_shc ) ! snw heat content (1.e20 J) CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) CALL iom_put( 'ibgemp' , zbg_emp ) ! volume flux emp (m/day liquid) CALL iom_put( 'ibgempbog' , zbg_emp_bog ) ! volume flux bottom growth -(m/day equivalent liquid) CALL iom_put( 'ibgemplag' , zbg_emp_lag ) ! volume flux open water growth - CALL iom_put( 'ibgempsig' , zbg_emp_sig ) ! volume flux snow ice growth - CALL iom_put( 'ibgempdyg' , zbg_emp_dyg ) ! volume flux dynamic growth - CALL iom_put( 'ibgempbom' , zbg_emp_bom ) ! volume flux bottom melt - CALL iom_put( 'ibgempsum' , zbg_emp_sum ) ! volume flux surface melt - CALL iom_put( 'ibgempres' , zbg_emp_res ) ! volume flux resultant - CALL iom_put( 'ibgsfx' , zbg_sfx ) ! salt flux -(psu*m/day equivalent liquid) CALL iom_put( 'ibgsfxbri' , zbg_sfx_bri ) ! salt flux brines - CALL iom_put( 'ibgsfxthd' , zbg_sfx_thd ) ! salt flux thermo - CALL iom_put( 'ibgsfxmec' , zbg_sfx_mec ) ! salt flux dynamic - CALL iom_put( 'ibgsfxres' , zbg_sfx_res ) ! salt flux result - CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) CALL iom_put( 'ibggrme' , bg_grme * rhoic * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) ! IF( lrst_ice ) CALL lim_diahsb_rst( numit, 'WRITE' ) ! IF( nn_timing == 1 ) CALL timing_stop('lim_diahsb') ! END SUBROUTINE lim_diahsb SUBROUTINE lim_diahsb_init !!--------------------------------------------------------------------------- !! *** ROUTINE lim_diahsb_init *** !! !! ** Purpose: Initialization for the heat salt volume budgets !! !! ** Method : Compute initial heat content, salt content and volume !! !! ** Action : - Compute initial heat content, salt content and volume !! - Initialize forcing trends !! - Compute coefficients for conversion !!--------------------------------------------------------------------------- INTEGER :: jk ! dummy loop indice INTEGER :: ierror ! local integer !! !!NAMELIST/namicehsb/ blabla !!---------------------------------------------------------------------- ! !!REWIND ( numnam_ice ) ! Read Namelist namicehsb !!READ ( numnam_ice, namicehsb ) ! IF(lwp) THEN ! Control print WRITE(numout,*) WRITE(numout,*) 'lim_diahsb_init : check the heat and salt budgets' WRITE(numout,*) '~~~~~~~~~~~~' ENDIF ! ---------------------------------- ! ! 2 - initial conservation variables ! ! ---------------------------------- ! !frc_vol = 0.d0 ! volume trend due to forcing !frc_sal = 0.d0 ! salt content - - - - !bg_grme = 0.d0 ! ice growth + melt volume trend ! CALL lim_diahsb_rst( nstart, 'READ' ) !* read or initialize all required files ! END SUBROUTINE lim_diahsb_init SUBROUTINE lim_diahsb_rst( kt, cdrw ) !!--------------------------------------------------------------------- !! *** ROUTINE limdia_rst *** !! !! ** Purpose : Read or write DIA file in restart file !! !! ** Method : use of IOM library !!---------------------------------------------------------------------- INTEGER , INTENT(in) :: kt ! ice time-step CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag ! INTEGER :: id1, id2, id3 ! local integers !!---------------------------------------------------------------------- ! IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise IF( ln_rstart ) THEN !* Read the restart file !id1 = iom_varid( numrir, 'frc_vol' , ldstop = .TRUE. ) ! IF(lwp) WRITE(numout,*) '~~~~~~~' IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp IF(lwp) WRITE(numout,*) '~~~~~~~' CALL iom_get( numrir, 'frc_vol', frc_vol ) CALL iom_get( numrir, 'frc_sal', frc_sal ) CALL iom_get( numrir, 'bg_grme', bg_grme ) ELSE IF(lwp) WRITE(numout,*) '~~~~~~~' IF(lwp) WRITE(numout,*) ' lim_diahsb at initial state ' IF(lwp) WRITE(numout,*) '~~~~~~~' frc_vol = 0.d0 frc_sal = 0.d0 bg_grme = 0.d0 ENDIF ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file ! ! ------------------- IF(lwp) WRITE(numout,*) '~~~~~~~' IF(lwp) WRITE(numout,*) ' lim_diahsb_rst at it= ', kt,' date= ', ndastp IF(lwp) WRITE(numout,*) '~~~~~~~' CALL iom_rstput( kt, nitrst, numriw, 'frc_vol' , frc_vol ) CALL iom_rstput( kt, nitrst, numriw, 'frc_sal' , frc_sal ) CALL iom_rstput( kt, nitrst, numriw, 'bg_grme' , bg_grme ) ! ENDIF ! END SUBROUTINE lim_diahsb_rst #else !!---------------------------------------------------------------------- !! Default option : Empty module NO LIM sea-ice model !!---------------------------------------------------------------------- CONTAINS SUBROUTINE lim_diahsb ! Empty routine END SUBROUTINE lim_diahsb #endif !!====================================================================== END MODULE limdiahsb