- Timestamp:
- 2017-09-01T15:49:35+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icectl.F90
r8426 r8486 9 9 #if defined key_lim3 10 10 !!---------------------------------------------------------------------- 11 !! 'key_lim3' LIM3 sea-ice model11 !! 'key_lim3' LIM3 sea-ice model 12 12 !!---------------------------------------------------------------------- 13 13 !! ice_ctl : control prints in case of crash … … 15 15 !! ice_prt3D : control prints of ice arrays 16 16 !!---------------------------------------------------------------------- 17 USE oce 18 USE dom_oce 19 USE ice 20 USE ice1D 21 USE sbc_oce 22 USE sbc_ice 23 USE phycst 17 USE oce ! ocean dynamics and tracers 18 USE dom_oce ! ocean space and time domain 19 USE ice ! LIM-3: ice variables 20 USE ice1D ! LIM-3: thermodynamical variables 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE phycst ! Define parameters for the routines 24 24 ! 25 USE lib_mpp 26 USE timing 27 USE in_out_manager 28 USE prtctl 29 USE lib_fortran 25 USE lib_mpp ! MPP library 26 USE timing ! Timing 27 USE in_out_manager ! I/O manager 28 USE prtctl ! Print control 29 USE lib_fortran ! 30 30 31 31 IMPLICIT NONE … … 41 41 # include "vectopt_loop_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 !! NEMO/ LIM3 4.0 , UCL - NEMO Consortium (2011)43 !! NEMO/ICE 4.0 , NEMO Consortium (2017) 44 44 !! $Id: icectl.F90 5043 2015-01-28 16:44:18Z clem $ 45 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- 47 48 47 CONTAINS 49 48 50 49 SUBROUTINE ice_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 51 !!---------------------------------------------------------------------- ----------------------------------52 !! 50 !!---------------------------------------------------------------------- 51 !! *** ROUTINE ice_cons_hsm *** 53 52 !! 54 53 !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine … … 61 60 !! For salt and heat thresholds, ice is considered to have a salinity of 10 62 61 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 63 !!-------------------------------------------------------------------------------------------------------- 64 INTEGER , INTENT(in) :: icount ! determine wether this is the beggining of the routine (0) or the end (1) 65 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 66 REAL(wp) , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 62 !!---------------------------------------------------------------------- 63 INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end 64 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 65 REAL(wp) , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b ! ???? 66 !! 67 67 REAL(wp) :: zvi, zsmv, zei, zfs, zfw, zft 68 68 REAL(wp) :: zvmin, zamin, zamax … … 70 70 REAL(wp) :: zarea, zv_sill, zs_sill, zh_sill 71 71 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 72 72 !!---------------------------------------------------------------------- 73 74 !!gm Note that glo_sum for a 2D or 3D array use a multiplication by tmask_i(ji,jj) 75 !! so below the * tmask(:,:,1) is useless ===>> I have removed them 76 !! I also move the conversion factor from then glo_sum argument (become a single multiplication 77 73 78 IF( icount == 0 ) THEN 74 75 ! salt flux 79 ! ! salt flux 76 80 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 77 81 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 78 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv )79 80 ! water flux82 & ) * e1e2t(:,:) ) * zconv 83 ! 84 ! ! water flux 81 85 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + & 82 86 & wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_ice_sub(:,:) + & 83 & wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:) 84 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv )85 86 ! heat flux87 & wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:) & 88 & ) * e1e2t(:,:) ) * zconv 89 ! 90 ! ! heat flux 87 91 zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 88 92 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 89 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 90 91 zvi_b = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 92 93 zsmv_b = glob_sum( SUM( smv_i * rhoic , dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 94 95 zei_b = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + & 96 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) & 97 ) * e1e2t * tmask(:,:,1) * zconv ) 93 & ) * e1e2t(:,:) ) * zconv 94 95 zvi_b = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * zconv ) 96 97 zsmv_b = glob_sum( SUM( smv_i * rhoic , dim=3 ) * e1e2t * zconv ) 98 99 zei_b = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & 100 & + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv 98 101 99 102 ELSEIF( icount == 1 ) THEN … … 102 105 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 103 106 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_sub(:,:) + sfx_lam(:,:) & 104 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv )- zfs_b107 & ) * e1e2t(:,:) ) * zconv - zfs_b 105 108 106 109 ! water flux … … 108 111 & wfx_opw(:,:) + wfx_res(:,:) + wfx_dyn(:,:) + wfx_lam(:,:) + wfx_ice_sub(:,:) + & 109 112 & wfx_snw_sni(:,:) + wfx_snw_sum(:,:) + wfx_snw_dyn(:,:) + wfx_snw_sub(:,:) + wfx_spr(:,:) & 110 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv )- zfw_b113 & ) * e1e2t(:,:) ) * zconv - zfw_b 111 114 112 115 ! heat flux 113 116 zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 114 117 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 115 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv )- zft_b118 & ) * e1e2t(:,:) ) * zconv - zft_b 116 119 117 120 ! outputs 118 zvi = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) &119 & * e1e2t * tmask(:,:,1) * zconv )- zvi_b ) * r1_rdtice - zfw ) * rday120 121 zsmv = ( ( glob_sum( SUM( smv_i * rhoic , dim=3 ) &122 & * e1e2t * tmask(:,:,1) * zconv )- zsmv_b ) * r1_rdtice + zfs ) * rday123 124 zei = ( glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) +&125 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 )&126 & ) * e1e2t * tmask(:,:,1) * zconv )- zei_b ) * r1_rdtice + zft121 zvi = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t ) * zconv & 122 & - zvi_b ) * r1_rdtice - zfw ) * rday 123 124 zsmv = ( ( glob_sum( SUM( smv_i * rhoic , dim=3 ) * e1e2t ) * zconv & 125 & - zsmv_b ) * r1_rdtice + zfs ) * rday 126 127 zei = ( glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) & 128 & + SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) ) * e1e2t ) * zconv & 129 & - zei_b ) * r1_rdtice + zft 127 130 128 131 ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 129 zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv )* rday130 zetrp = glob_sum( ( diag_trp_ei + diag_trp_es ) * e1e2t * tmask(:,:,1) * zconv )132 zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t ) * zconv * rday 133 zetrp = glob_sum( ( diag_trp_ei + diag_trp_es ) * e1e2t ) * zconv 131 134 132 135 zvmin = glob_min( v_i ) … … 135 138 136 139 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 137 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv )! in 1.e9 m2140 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 138 141 zv_sill = zarea * 2.5e-5 139 142 zs_sill = zarea * 25.e-5 … … 156 159 IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 157 160 ENDIF 158 161 ! 159 162 ENDIF 160 163 … … 163 166 164 167 SUBROUTINE ice_cons_final( cd_routine ) 165 !!---------------------------------------------------------------------- -----------------------------------166 !! 168 !!---------------------------------------------------------------------- 169 !! *** ROUTINE ice_cons_final *** 167 170 !! 168 171 !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step … … 174 177 !! For salt and heat thresholds, ice is considered to have a salinity of 10 175 178 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 176 !!---------------------------------------------------------------------- ----------------------------------179 !!---------------------------------------------------------------------- 177 180 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 178 181 REAL(wp) :: zhfx, zsfx, zvfx 179 182 REAL(wp) :: zarea, zv_sill, zs_sill, zh_sill 180 183 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 184 !!---------------------------------------------------------------------- 181 185 182 186 ! heat flux 183 187 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es & 184 188 ! & - SUM( qevap_ice * a_i_b, dim=3 ) & !!clem: I think this line must be commented (but need check) 185 & ) * e1e2t * tmask(:,:,1) * zconv )189 & ) * e1e2t ) * zconv 186 190 ! salt flux 187 zsfx = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv )* rday191 zsfx = glob_sum( ( sfx + diag_smvi ) * e1e2t ) * zconv * rday 188 192 ! water flux 189 zvfx = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv )* rday193 zvfx = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t ) * zconv * rday 190 194 191 195 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 192 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv )! in 1.e9 m2196 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t ) * zconv ! in 1.e9 m2 193 197 zv_sill = zarea * 2.5e-5 194 198 zs_sill = zarea * 25.e-5 195 199 zh_sill = zarea * 10.e-5 196 200 197 IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx [Mt/day] (',cd_routine,') = ',(zvfx) 198 IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx [psu*Mt/day] (',cd_routine,') = ',(zsfx) 199 IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx [GW] (',cd_routine,') = ',(zhfx) 200 201 IF(lwp) THEN 202 IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx [Mt/day] (',cd_routine,') = ',(zvfx) 203 IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx [psu*Mt/day] (',cd_routine,') = ',(zsfx) 204 IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx [GW] (',cd_routine,') = ',(zhfx) 205 ENDIF 206 ! 201 207 END SUBROUTINE ice_cons_final 202 208 … … 671 677 !! Default option Empty Module No LIM3 sea-ice model 672 678 !!-------------------------------------------------------------------------- 673 CONTAINS674 SUBROUTINE ice_ctl ! Empty routine675 END SUBROUTINE ice_ctl676 SUBROUTINE ice_prt ! Empty routine677 END SUBROUTINE ice_prt678 SUBROUTINE ice_prt3D ! Empty routine679 END SUBROUTINE ice_prt3D680 679 #endif 680 681 681 !!====================================================================== 682 682 END MODULE icectl
Note: See TracChangeset
for help on using the changeset viewer.