Changeset 9977
- Timestamp:
- 2018-07-20T10:24:45+02:00 (6 years ago)
- Location:
- NEMO/branches/UKMO/dev_r9888_proto_GO8_package
- Files:
-
- 39 edited
- 4 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/AGRIF_DEMO/EXPREF/file_def_nemo-ice.xml
r9572 r9977 5 5 ============================================================================================================ 6 6 = output files definition = 7 = Define your own files for lim3=7 = Define your own files for sea ice = 8 8 = put the variables you want... = 9 9 ============================================================================================================ -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_ICE_PISCES/EXPREF/file_def_nemo-ice.xml
r9572 r9977 5 5 ============================================================================================================ 6 6 = output files definition = 7 = Define your own files for lim3=7 = Define your own files for sea ice = 8 8 = put the variables you want... = 9 9 ============================================================================================================ -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_ICE_PISCES/EXPREF/file_def_nemo-pisces.xml
r9572 r9977 14 14 15 15 <file id="file31" name_suffix="_bioscalar" description="pisces sms variables" > 16 <field field_ref="tdenit" name="tdenit" unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>17 <field field_ref="tnfix" name="tnfix" unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>18 <field field_ref="tcflx" name="tcflx" unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>19 <field field_ref="tcflxcum" name="tcflxcum" unit="PgC" operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>20 <field field_ref="tcexp" name="tcexp" unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>21 <field field_ref="tintpp" name="tintpp" unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>22 <field field_ref="pno3tot" name="pno3tot" unit="umolN" > pno3tot * 16. / 122. * 1e6 </field>23 <field field_ref="ppo4tot" name="ppo4tot" unit="umolP" > ppo4tot * 1. / 122. * 1e6 </field>24 <field field_ref="psiltot" name="psiltot" unit="umolC" > psiltot * 1e6 </field>25 <field field_ref="palktot" name="palktot" unit="umolC" > palktot * 1e6 </field>26 <field field_ref="pfertot" name="pfertot" unit="nmolFe" > pfertot * 1e9 </field>16 <field field_ref="tdenit" name="tdenit" grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field> 17 <field field_ref="tnfix" name="tnfix" grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field> 18 <field field_ref="tcflx" name="tcflx" grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field> 19 <field field_ref="tcflxcum" name="tcflxcum" grid_ref="grid_1point" unit="PgC" operation="instant" > tcflxcum * -1. * 12. / 1e15 </field> 20 <field field_ref="tcexp" name="tcexp" grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field> 21 <field field_ref="tintpp" name="tintpp" grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field> 22 <field field_ref="pno3tot" name="pno3tot" grid_ref="grid_1point" unit="umolN" > pno3tot * 16. / 122. * 1e6 </field> 23 <field field_ref="ppo4tot" name="ppo4tot" grid_ref="grid_1point" unit="umolP" > ppo4tot * 1. / 122. * 1e6 </field> 24 <field field_ref="psiltot" name="psiltot" grid_ref="grid_1point" unit="umolC" > psiltot * 1e6 </field> 25 <field field_ref="palktot" name="palktot" grid_ref="grid_1point" unit="umolC" > palktot * 1e6 </field> 26 <field field_ref="pfertot" name="pfertot" grid_ref="grid_1point" unit="nmolFe" > pfertot * 1e9 </field> 27 27 </file> 28 28 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_OFF_PISCES/EXPREF/file_def_nemo.xml
r9539 r9977 19 19 <file_group id="1d" output_freq="1d" output_level="10" enabled=".TRUE."> <!-- 1d files --> 20 20 <file id="file1" name_suffix="_bioscalar" description="pisces sms variables" > 21 <field field_ref="tdenit" name="tdenit" unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field>22 <field field_ref="tnfix" name="tnfix" unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field>23 <field field_ref="tcflx" name="tcflx" unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field>24 <field field_ref="tcflxcum" name="tcflxcum" unit="PgC" operation="instant" > tcflxcum * -1. * 12. / 1e15 </field>25 <field field_ref="tcexp" name="tcexp" unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field>26 <field field_ref="tintpp" name="tintpp" unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field>27 <field field_ref="pno3tot" name="pno3tot" unit="umolN" > pno3tot * 16. / 122. * 1e6 </field>28 <field field_ref="ppo4tot" name="ppo4tot" unit="umolP" > ppo4tot * 1. / 122. * 1e6 </field>29 <field field_ref="psiltot" name="psiltot" unit="umolC" > psiltot * 1e6 </field>30 <field field_ref="palktot" name="palktot" unit="umolC" > palktot * 1e6 </field>31 <field field_ref="pfertot" name="pfertot" unit="nmolFe" > pfertot * 1e9 </field>21 <field field_ref="tdenit" name="tdenit" grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tdenit * 14. * 86400. * 365. / 1e12 </field> 22 <field field_ref="tnfix" name="tnfix" grid_ref="grid_1point" unit="TgN/yr" operation="instant" > tnfix * 14. * 86400. * 365. / 1e12 </field> 23 <field field_ref="tcflx" name="tcflx" grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcflx * -1. * 12. * 86400. * 365. / 1e15 </field> 24 <field field_ref="tcflxcum" name="tcflxcum" grid_ref="grid_1point" unit="PgC" operation="instant" > tcflxcum * -1. * 12. / 1e15 </field> 25 <field field_ref="tcexp" name="tcexp" grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tcexp * 12. * 86400. * 365. / 1e15 </field> 26 <field field_ref="tintpp" name="tintpp" grid_ref="grid_1point" unit="PgC/yr" operation="instant" > tintpp * 12. * 86400. * 365. / 1e15 </field> 27 <field field_ref="pno3tot" name="pno3tot" grid_ref="grid_1point" unit="umolN" > pno3tot * 16. / 122. * 1e6 </field> 28 <field field_ref="ppo4tot" name="ppo4tot" grid_ref="grid_1point" unit="umolP" > ppo4tot * 1. / 122. * 1e6 </field> 29 <field field_ref="psiltot" name="psiltot" grid_ref="grid_1point" unit="umolC" > psiltot * 1e6 </field> 30 <field field_ref="palktot" name="palktot" grid_ref="grid_1point" unit="umolC" > palktot * 1e6 </field> 31 <field field_ref="pfertot" name="pfertot" grid_ref="grid_1point" unit="nmolFe" > pfertot * 1e9 </field> 32 32 </file> 33 33 </file_group> -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/ORCA2_SAS_ICE/EXPREF/file_def_nemo-ice.xml
r9572 r9977 5 5 ============================================================================================================ 6 6 = output files definition = 7 = Define your own files for lim3=7 = Define your own files for sea ice = 8 8 = put the variables you want... = 9 9 ============================================================================================================ -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/SHARED/field_def_nemo-oce.xml
r9893 r9977 347 347 <field id="uoce" long_name="ocean current along i-axis" standard_name="sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D" /> 348 348 <field id="uoce_e3u" long_name="ocean current along i-axis (thickness weighted)" unit="m/s" grid_ref="grid_U_3D" > uoce * e3u </field> 349 <field id="uoce2_e3u" long_name="ocean current along i-axis squared * e3u" unit="m3/s2" grid_ref="grid_U_3D" > uoce * uoce * e3u </field> 349 350 <field id="ssu" long_name="ocean surface current along i-axis" unit="m/s" /> 350 351 <field id="sbu" long_name="ocean bottom current along i-axis" unit="m/s" /> … … 401 402 <field id="voce" long_name="ocean current along j-axis" standard_name="sea_water_y_velocity" unit="m/s" grid_ref="grid_V_3D" /> 402 403 <field id="voce_e3v" long_name="ocean current along j-axis (thickness weighted)" unit="m/s" grid_ref="grid_V_3D" > voce * e3v </field> 404 <field id="voce2_e3v" long_name="ocean current along j-axis squared * e3v" unit="m3/s2" grid_ref="grid_V_3D" > voce * voce * e3v </field> 403 405 <field id="ssv" long_name="ocean surface current along j-axis" unit="m/s" /> 404 406 <field id="sbv" long_name="ocean bottom current along j-axis" unit="m/s" /> -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/SPITZ12/EXPREF/file_def_nemo-ice.xml
r9572 r9977 5 5 ============================================================================================================ 6 6 = output files definition = 7 = Define your own files for lim3=7 = Define your own files for sea ice = 8 8 = put the variables you want... = 9 9 ============================================================================================================ -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/cfgs/SPITZ12/EXPREF/namelist_ice_cfg
r9801 r9977 86 86 &namini ! Ice initialization 87 87 !------------------------------------------------------------------------------ 88 ln_iceini = . false. ! activate ice initialization (T) or not (F)88 ln_iceini = .true. ! activate ice initialization (T) or not (F) 89 89 rn_thres_sst = 0.5 ! max delta temp. above Tfreeze with initial ice = (sst - tfreeze) 90 90 rn_hts_ini_n = 0.1 ! initial real snow thickness (m), North -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/ice.F90
r9892 r9977 210 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 211 211 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlead !: heat balance of the lead (or of the open ocean) 212 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhtur!: net downward heat flux from the ice to the ocean212 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsb_ice_bot !: net downward heat flux from the ice to the ocean 213 213 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhld !: heat flux from the lead used for bottom melting 214 214 … … 256 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 257 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping [W.m-2] 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in!: heat flux available for thermo transformations [W.m-2]259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_out!: heat flux remaining at the end of thermo transformations [W.m-2]258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_atm_oi !: heat flux available for thermo transformations [W.m-2] 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qt_oce_ai !: heat flux remaining at the end of thermo transformations [W.m-2] 260 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_err_sub !: mass flux error after sublimation [kg.m-2.s-1] 261 261 … … 270 270 271 271 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice!: transmitted solar radiation under ice272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_bot !: transmitted solar radiation under ice 273 273 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t1_ice !: temperature of the first layer (Jules coupling) [K] 274 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: cnd_ice !: effective conductivity at the top of ice/snow (Jules coupling) [W.m-2.K-1] … … 360 360 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_si !: Temperature at Snow-ice interface (K) 361 361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_si !: mean temperature at the snow-ice interface (K) 362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: diag_fc_bo !: Bottomconduction flux (W/m2)363 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: diag_fc_su!: Surface conduction flux (W/m2)362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_bot !: Bottom conduction flux (W/m2) 363 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice_top !: Surface conduction flux (W/m2) 364 364 365 365 ! … … 387 387 388 388 ii = ii + 1 389 ALLOCATE( t_bo (jpi,jpj) , wfx_snw_sni(jpi,jpj) , &390 & wfx_snw (jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) , &391 & wfx_ice (jpi,jpj) , wfx_sub (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam (jpi,jpj) , &392 & wfx_pnd (jpi,jpj) , &393 & wfx_bog (jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,&394 & wfx_res (jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,&395 & afx_tot (jpi,jpj) , rn_amax_2d(jpi,jpj), &396 & fhtur (jpi,jpj) , qlead (jpi,jpj) ,&397 & sfx_res (jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , &398 & sfx_bog (jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , &399 & hfx_res (jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , &400 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld (jpi,jpj) , &401 & hfx_sum (jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , &402 & hfx_opw (jpi,jpj) , hfx_thd(jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , &403 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) , STAT=ierr(ii) )389 ALLOCATE( t_bo (jpi,jpj) , wfx_snw_sni(jpi,jpj) , & 390 & wfx_snw (jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) , & 391 & wfx_ice (jpi,jpj) , wfx_sub (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam (jpi,jpj) , & 392 & wfx_pnd (jpi,jpj) , & 393 & wfx_bog (jpi,jpj) , wfx_dyn (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 394 & wfx_res (jpi,jpj) , wfx_sni (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 395 & afx_tot (jpi,jpj) , rn_amax_2d(jpi,jpj), & 396 & qsb_ice_bot(jpi,jpj) , qlead (jpi,jpj) , & 397 & sfx_res (jpi,jpj) , sfx_bri (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , & 398 & sfx_bog (jpi,jpj) , sfx_bom (jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 399 & hfx_res (jpi,jpj) , hfx_snw (jpi,jpj) , hfx_sub(jpi,jpj) , & 400 & qt_atm_oi (jpi,jpj) , qt_oce_ai (jpi,jpj) , fhld (jpi,jpj) , & 401 & hfx_sum (jpi,jpj) , hfx_bom (jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , & 402 & hfx_opw (jpi,jpj) , hfx_thd (jpi,jpj) , hfx_dyn(jpi,jpj) , hfx_spr(jpi,jpj) , & 403 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , wfx_err_sub(jpi,jpj) , STAT=ierr(ii) ) 404 404 405 405 ! * Ice global state variables 406 406 ii = ii + 1 407 ALLOCATE( ftr_ice(jpi,jpj,jpl) , cnd_ice(jpi,jpj,jpl) , t1_ice(jpi,jpj,jpl) , &408 & h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , &409 & v_s (jpi,jpj,jpl) , h_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , &410 & s_i (jpi,jpj,jpl) , sv_i (jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , &411 & oa_i (jpi,jpj,jpl) , bv_i (jpi,jpj,jpl) , STAT=ierr(ii) )407 ALLOCATE( qtr_ice_bot(jpi,jpj,jpl) , cnd_ice(jpi,jpj,jpl) , t1_ice(jpi,jpj,jpl) , & 408 & h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & 409 & v_s (jpi,jpj,jpl) , h_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 410 & s_i (jpi,jpj,jpl) , sv_i (jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 411 & oa_i (jpi,jpj,jpl) , bv_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 412 412 413 413 ii = ii + 1 … … 451 451 ! * SIMIP diagnostics 452 452 ii = ii + 1 453 ALLOCATE( t_si (jpi,jpj,jpl) , tm_si(jpi,jpj) , diag_fc_bo(jpi,jpj) , diag_fc_su(jpi,jpj) , STAT = ierr(ii) )453 ALLOCATE( t_si(jpi,jpj,jpl) , tm_si(jpi,jpj) , qcn_ice_bot(jpi,jpj,jpl) , qcn_ice_top(jpi,jpj,jpl) , STAT = ierr(ii) ) 454 454 455 455 ice_alloc = MAXVAL( ierr(:) ) -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/ice1d.F90
r9892 r9977 32 32 33 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlead_1d 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftr_ice_1d34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qtr_ice_bot_1d 35 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d 36 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qns_ice_1d … … 40 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qml_ice_1d !: heat available for snow / ice surface melting [W/m2] 41 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qcn_ice_1d !: heat available for snow / ice surface sublimation [W/m2] 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: q sr_ice_tr_1d!: solar flux transmitted below the ice surface [W/m2]42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qtr_ice_top_1d !: solar flux transmitted below the ice surface [W/m2] 43 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t1_ice_1d !: temperature of the 1st layer (Jules coupling) [K] 44 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cnd_ice_1d !: conductivity at the top of ice/snow (Jules coupling) [W/K/m2] … … 53 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d 54 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_dif_1d 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_out_1d55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qt_oce_ai_1d 56 56 57 57 ! heat flux associated with ice-atmosphere mass exchange … … 93 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_dyn_1d 94 94 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d !: <==> the 2D sprecip 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_1d !: <==> the 2D at_i 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ato_i_1d !: <==> the 2D ato_i 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhtur_1d !: <==> the 2D fhtur 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d !: <==> the 2D fhld 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: evap_ice_1d !: <==> the 2D evap_ice 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qprec_ice_1d !: <==> the 2D qprec_ice 103 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_su_1d !: <==> the 2D t_su 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_si_1d !: <==> the 2D t_si 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_i_1d !: <==> the 2D a_i 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_ib_1d !: <==> the 2D a_i_b 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_i_1d !: 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_ib_1d !: 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_s_1d !: 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_su !: Surface Conduction flux 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_bo_i !: Bottom Conduction flux 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_1d 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ato_i_1d 98 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsb_ice_bot_1d 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: evap_ice_1d 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qprec_ice_1d 103 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_su_1d 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_si_1d 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_i_1d 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_ib_1d 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_i_1d 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_ib_1d 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: h_s_1d 113 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_tot !: Snow accretion/ablation [m] 114 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_sum !: Ice surface ablation [m] … … 140 138 141 139 ! Conduction flux diagnostics (SIMIP) 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: diag_fc_bo_1d !: <==> the 2D diag_fc_bo143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: diag_fc_su_1d !: <==> the 2D diag_fc_su140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qcn_ice_bot_1d 141 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qcn_ice_top_1d 144 142 145 143 ! surface fields from the ocean … … 182 180 ii = 1 183 181 ALLOCATE( nptidx (jpij) , & 184 & qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d(jpij) , &185 & qns_ice_1d(jpij) , qml_ice_1d (jpij) , qcn_ice_1d(jpij) , qsr_ice_tr_1d(jpij) , &186 & cnd_ice_1d(jpij) , t1_ice_1d (jpij) , t_bo_1d (jpij) , &187 & hfx_sum_1d(jpij) , hfx_bom_1d (jpij) , hfx_bog_1d(jpij) , &188 & hfx_dif_1d(jpij) , hfx_opw_1d (jpij) , hfx_dyn_1d(jpij) , &189 & rn_amax_1d(jpij) , &190 & hfx_thd_1d(jpij) , hfx_spr_1d (jpij) , &191 & hfx_snw_1d(jpij) , hfx_sub_1d (jpij) , &192 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , hfx_out_1d(jpij), STAT=ierr(ii) )182 & qlead_1d (jpij) , qtr_ice_bot_1d(jpij) , qsr_ice_1d(jpij) , & 183 & qns_ice_1d(jpij) , qml_ice_1d (jpij) , qcn_ice_1d(jpij) , qtr_ice_top_1d(jpij) , & 184 & cnd_ice_1d(jpij) , t1_ice_1d (jpij) , t_bo_1d (jpij) , & 185 & hfx_sum_1d(jpij) , hfx_bom_1d (jpij) , hfx_bog_1d(jpij) , & 186 & hfx_dif_1d(jpij) , hfx_opw_1d (jpij) , hfx_dyn_1d(jpij) , & 187 & rn_amax_1d(jpij) , & 188 & hfx_thd_1d(jpij) , hfx_spr_1d (jpij) , & 189 & hfx_snw_1d(jpij) , hfx_sub_1d (jpij) , & 190 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , qt_oce_ai_1d(jpij), STAT=ierr(ii) ) 193 191 ! 194 192 ii = ii + 1 195 193 ALLOCATE( sprecip_1d (jpij) , at_i_1d (jpij) , ato_i_1d (jpij) , & 196 & fhtur_1d(jpij) , wfx_snw_sni_1d(jpij) , wfx_spr_1d (jpij) , wfx_snw_sum_1d(jpij) , &194 & qsb_ice_bot_1d(jpij) , wfx_snw_sni_1d(jpij) , wfx_spr_1d (jpij) , wfx_snw_sum_1d(jpij) , & 197 195 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d (jpij) , & 198 196 & wfx_sum_1d (jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d (jpij) , & … … 206 204 ii = ii + 1 207 205 ALLOCATE( t_su_1d (jpij) , t_si_1d (jpij) , a_i_1d (jpij) , a_ib_1d (jpij) , & 208 & h_i_1d (jpij) , h_ib_1d (jpij) , h_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) ,&206 & h_i_1d (jpij) , h_ib_1d (jpij) , h_s_1d (jpij) , & 209 207 & dh_s_tot(jpij) , dh_i_sum(jpij) , dh_i_itm (jpij) , dh_i_bom(jpij) , dh_i_bog(jpij) , & 210 208 & dh_i_sub(jpij) , dh_s_mlt(jpij) , dh_snowice(jpij) , s_i_1d (jpij) , s_i_new (jpij) , & … … 219 217 ! 220 218 ii = ii + 1 221 ALLOCATE( diag_fc_bo_1d(jpij) , diag_fc_su_1d(jpij), STAT=ierr(ii) )219 ALLOCATE( qcn_ice_bot_1d(jpij) , qcn_ice_top_1d(jpij) , STAT=ierr(ii) ) 222 220 ! 223 221 ii = ii + 1 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icealb.F90
r9892 r9977 16 16 USE ice, ONLY: jpl ! sea-ice: number of categories 17 17 USE phycst ! physical constants 18 USE dom_oce ! domain: ocean 18 19 ! 19 20 USE in_out_manager ! I/O manager … … 160 161 ENDIF 161 162 ! !--- Surface albedo is weighted mean of snow, ponds and bare ice contributions 162 palb_os(ji,jj,jl) = zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice 163 palb_os(ji,jj,jl) = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 164 ! 165 palb_cs(ji,jj,jl) = palb_os(ji,jj,jl) & 166 & - ( - 0.1010 * palb_os(ji,jj,jl) * palb_os(ji,jj,jl) & 167 & + 0.1933 * palb_os(ji,jj,jl) - 0.0148 ) * tmask(ji,jj,1) 163 168 ! 164 169 END DO … … 166 171 END DO 167 172 ! 168 palb_cs(:,:,:) = palb_os(:,:,:) - ( - 0.1010 * palb_os(:,:,:) * palb_os(:,:,:) + 0.1933 * palb_os(:,:,:) - 0.0148 )169 173 ! 170 174 IF( ln_timing ) CALL timing_stop('icealb') -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icectl.F90
r9892 r9977 189 189 190 190 ! heat flux 191 zhfx = glob_sum( ( hfx_in - hfx_out- diag_heat - diag_trp_ei - diag_trp_es &191 zhfx = glob_sum( ( qt_atm_oi - qt_oce_ai - diag_heat - diag_trp_ei - diag_trp_es & 192 192 ! & - SUM( qevap_ice * a_i_b, dim=3 ) & !!clem: I think this line must be commented (but need check) 193 193 & ) * e1e2t ) * zconv … … 572 572 WRITE(numout,*) 573 573 WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 574 WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj)575 WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj)574 WRITE(numout,*) ' qt_atm_oi : ', qt_atm_oi(ji,jj) 575 WRITE(numout,*) ' qt_oce_ai : ', qt_oce_ai(ji,jj) 576 576 WRITE(numout,*) ' dhc : ', diag_heat(ji,jj) 577 577 WRITE(numout,*) … … 579 579 WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj) 580 580 WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj) 581 WRITE(numout,*) ' fhtur : ', fhtur(ji,jj)581 WRITE(numout,*) ' qsb_ice_bot : ', qsb_ice_bot(ji,jj) 582 582 WRITE(numout,*) ' qlead : ', qlead(ji,jj) * r1_rdtice 583 583 WRITE(numout,*) -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icedia.F90
r9892 r9977 95 95 ! 2 - Trends due to forcing ! 96 96 ! ---------------------------! 97 z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-ocean98 z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9! freshwater flux ice/snow-atm99 z_frc_sal = r1_rau0 * glob_sum( - sfx(:,:) * e1e2t(:,:) ) * 1.e-9! salt fluxes ice/snow-ocean100 z_frc_tembot = glob_sum( hfx_out(:,:) * e1e2t(:,:) ) * 1.e-20! heat on top of ocean (and below ice)101 z_frc_temtop = glob_sum( hfx_in (:,:) * e1e2t(:,:) ) * 1.e-20! heat on top of ice-coean97 z_frc_volbot = r1_rau0 * glob_sum( - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-ocean 98 z_frc_voltop = r1_rau0 * glob_sum( - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater flux ice/snow-atm 99 z_frc_sal = r1_rau0 * glob_sum( - sfx(:,:) * e1e2t(:,:) ) * 1.e-9 ! salt fluxes ice/snow-ocean 100 z_frc_tembot = glob_sum( qt_oce_ai(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat on top of ocean (and below ice) 101 z_frc_temtop = glob_sum( qt_atm_oi(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat on top of ice-coean 102 102 ! 103 103 frc_voltop = frc_voltop + z_frc_voltop * rdt_ice ! km3 … … 110 110 ! 3 - Content variations ! 111 111 ! ----------------------- ! 112 zdiff_vol = r1_rau0 * glob_sum( ( rhoic*vt_i(:,:) + rhosn*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3)113 zdiff_sal = r1_rau0 * glob_sum( ( rhoic* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9! salt content trend (km3*pss)114 zdiff_tem = glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J)112 zdiff_vol = r1_rau0 * glob_sum( ( rhoic*vt_i(:,:) + rhosn*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! freshwater trend (km3) 113 zdiff_sal = r1_rau0 * glob_sum( ( rhoic* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9 ! salt content trend (km3*pss) 114 zdiff_tem = glob_sum( ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20 ! heat content trend (1.e20 J) 115 115 ! + SUM( qevap_ice * a_i_b, dim=3 ) !! clem: I think this term should not be there (but needs a check) 116 116 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icestp.F90
r9892 r9977 189 189 IF( ln_icethd ) CALL ice_thd( kt ) ! -- Ice thermodynamics 190 190 ! 191 !192 191 IF( ln_icethd ) CALL ice_cor( kt , 2 ) ! -- Corrections 193 192 ! … … 427 426 428 427 ! SIMIP diagnostics 429 diag_fc_bo(:,:) = 0._wp ; diag_fc_su(:,:) = 0._wp430 t_si (:,:,:) = rt0! temp at the ice-snow interface428 qcn_ice_bot(:,:,:) = 0._wp ; qcn_ice_top(:,:,:) = 0._wp ! conductive fluxes 429 t_si (:,:,:) = rt0 ! temp at the ice-snow interface 431 430 432 431 tau_icebfr(:,:) = 0._wp ! landfast ice param only (clem: important to keep the init here) 433 cnd_ice (:,:,:) = 0._wp ! initialisation of the effective conductivity at the top of ice/snow (Jules coupling) 432 cnd_ice (:,:,:) = 0._wp ! initialisation: effective conductivity at the top of ice/snow (Jules coupling) 433 qtr_ice_bot(:,:,:) = 0._wp ! initialization: part of solar radiation transmitted through the ice needed at least for outputs 434 434 ! 435 435 ! for control checks (ln_icediachk) -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd.F90
r9892 r9977 20 20 USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl 21 21 USE sbc_ice , ONLY : qsr_oce, qns_oce, qemp_oce, qsr_ice, qns_ice, dqns_ice, evap_ice, qprec_ice, qevap_ice, & 22 & qml_ice, qcn_ice, q sr_ice_tr22 & qml_ice, qcn_ice, qtr_ice_top 23 23 USE ice1D ! sea-ice: thermodynamics variables 24 24 USE icethd_zdf ! sea-ice: vertical heat diffusion … … 128 128 CALL lbc_lnk( zfric, 'T', 1. ) 129 129 ! 130 ftr_ice(:,:,:) = 0._wp ! initialization (part of solar radiation transmitted through the ice)131 132 130 !--------------------------------------------------------------------! 133 131 ! Partial computation of forcing for the thermodynamic sea ice model … … 143 141 ! ! temperature and turbulent mixing (McPhee, 1992) 144 142 ! 145 ! --- Energy received in the lead , zqld is defined everywhere (J.m-2) --- !143 ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 146 144 zqld = tmask(ji,jj,1) * rdt_ice * & 147 145 & ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) + & 148 146 & ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 149 147 150 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 151 ! includes supercooling potential energy (>0) or "above-freezing" energy (<0) 152 zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 153 154 ! --- Above-freezing sensible heat content (J/m2 grid) 155 zqfr_neg = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * MIN( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ), 0._wp ) 156 157 ! --- Sensible ocean-to-ice heat flux (W/m2) 158 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 159 fhtur(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 160 161 fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 162 ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach 163 ! the freezing point, so that we do not have SST < T_freeze 164 ! This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 165 166 !-- Energy Budget of the leads (J.m-2), source of lateral accretion. Must be < 0 to form ice 167 qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 148 ! --- Energy needed to bring ocean surface layer until its freezing (mostly<0 but >0 if supercooling, J.m-2) --- ! 149 zqfr = rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1) ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 150 zqfr_neg = MIN( zqfr , 0._wp ) ! only < 0 151 152 ! --- Sensible ocean-to-ice heat flux (mostly>0 but <0 if supercooling, W/m2) 153 zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 154 qsb_ice_bot(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 155 156 qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 157 ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 158 ! the freezing point, so that we do not have SST < T_freeze 159 ! This implies: - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 160 161 !-- Energy Budget of the leads (J.m-2), source of ice growth in open water. Must be < 0 to form ice 162 qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 168 163 169 164 ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting … … 177 172 ! Net heat flux on top of the ice-ocean [W.m-2] 178 173 ! --------------------------------------------- 179 hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)174 qt_atm_oi(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 180 175 END DO 181 176 END DO … … 185 180 ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 186 181 IF( .NOT. ln_icedH ) THEN 187 hfx_in(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)188 fhtur(:,:) = 0._wp189 fhld (:,:) = 0._wp182 qt_atm_oi (:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 183 qsb_ice_bot(:,:) = 0._wp 184 fhld (:,:) = 0._wp 190 185 ENDIF 191 186 … … 193 188 ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 194 189 ! --------------------------------------------------------------------- 195 ! First step here : non solar + precip - qlead - q turb190 ! First step here : non solar + precip - qlead - qsensible 196 191 ! Second step in icethd_dh : heat remaining if total melt (zq_rema) 197 192 ! Third step in iceupdate.F90 : heat from ice-ocean mass exchange (zf_mass) + solar 198 hfx_out(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:) & ! Non solar heat flux received by the ocean199 & - qlead(:,:) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation200 & - at_i (:,:) * fhtur(:,:) & ! heat flux taken by turbulence201 & - at_i (:,:) * fhld(:,:)! heat flux taken during bottom growth/melt202 ! (fhld should be 0 while bott growth)193 qt_oce_ai(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:) & ! Non solar heat flux received by the ocean 194 & - qlead(:,:) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation 195 & - at_i (:,:) * qsb_ice_bot(:,:) & ! heat flux taken by sensible flux 196 & - at_i (:,:) * fhld (:,:) ! heat flux taken during bottom growth/melt 197 ! ! (fhld should be 0 while bott growth) 203 198 !-------------------------------------------------------------------------------------------! 204 199 ! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories … … 377 372 CALL tab_2d_1d( npti, nptidx(1:npti), a_ip_frac_1d(1:npti), a_ip_frac(:,:,kl) ) 378 373 ! 379 CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d(1:npti), qprec_ice ) 380 CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_1d (1:npti), qsr_ice (:,:,kl) ) 381 CALL tab_2d_1d( npti, nptidx(1:npti), qns_ice_1d (1:npti), qns_ice (:,:,kl) ) 382 CALL tab_2d_1d( npti, nptidx(1:npti), ftr_ice_1d (1:npti), ftr_ice (:,:,kl) ) 383 CALL tab_2d_1d( npti, nptidx(1:npti), evap_ice_1d (1:npti), evap_ice(:,:,kl) ) 384 CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d (1:npti), dqns_ice(:,:,kl) ) 385 CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d (1:npti), t_bo ) 386 CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d (1:npti), sprecip ) 387 CALL tab_2d_1d( npti, nptidx(1:npti), fhtur_1d (1:npti), fhtur ) 388 CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d (1:npti), fhld ) 374 CALL tab_2d_1d( npti, nptidx(1:npti), qprec_ice_1d (1:npti), qprec_ice ) 375 CALL tab_2d_1d( npti, nptidx(1:npti), qsr_ice_1d (1:npti), qsr_ice (:,:,kl) ) 376 CALL tab_2d_1d( npti, nptidx(1:npti), qns_ice_1d (1:npti), qns_ice (:,:,kl) ) 377 CALL tab_2d_1d( npti, nptidx(1:npti), evap_ice_1d (1:npti), evap_ice(:,:,kl) ) 378 CALL tab_2d_1d( npti, nptidx(1:npti), dqns_ice_1d (1:npti), dqns_ice(:,:,kl) ) 379 CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d (1:npti), t_bo ) 380 CALL tab_2d_1d( npti, nptidx(1:npti), sprecip_1d (1:npti), sprecip ) 381 CALL tab_2d_1d( npti, nptidx(1:npti), qsb_ice_bot_1d(1:npti), qsb_ice_bot ) 382 CALL tab_2d_1d( npti, nptidx(1:npti), fhld_1d (1:npti), fhld ) 389 383 390 CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d (1:npti), qml_ice (:,:,kl))391 CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d (1:npti), qcn_ice(:,:,kl) )392 CALL tab_2d_1d( npti, nptidx(1:npti), q sr_ice_tr_1d(1:npti), qsr_ice_tr(:,:,kl) )384 CALL tab_2d_1d( npti, nptidx(1:npti), qml_ice_1d (1:npti), qml_ice (:,:,kl) ) 385 CALL tab_2d_1d( npti, nptidx(1:npti), qcn_ice_1d (1:npti), qcn_ice (:,:,kl) ) 386 CALL tab_2d_1d( npti, nptidx(1:npti), qtr_ice_top_1d(1:npti), qtr_ice_top(:,:,kl) ) 393 387 ! 394 388 CALL tab_2d_1d( npti, nptidx(1:npti), wfx_snw_sni_1d(1:npti), wfx_snw_sni ) … … 417 411 CALL tab_2d_1d( npti, nptidx(1:npti), sfx_lam_1d (1:npti), sfx_lam ) 418 412 ! 419 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd)420 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr)421 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum)422 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom)423 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog)424 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif)425 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw)426 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw)427 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub)428 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res)413 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd ) 414 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr ) 415 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum ) 416 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom ) 417 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog ) 418 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif ) 419 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw ) 420 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw ) 421 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub ) 422 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 429 423 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 430 424 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem ) 431 CALL tab_2d_1d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out ) 432 ! 433 ! SIMIP diagnostics 434 CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo ) 435 CALL tab_2d_1d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su ) 425 CALL tab_2d_1d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 426 ! 436 427 ! ocean surface fields 437 428 CALL tab_2d_1d( npti, nptidx(1:npti), sst_1d(1:npti), sst_m ) … … 507 498 CALL tab_1d_2d( npti, nptidx(1:npti), sfx_lam_1d (1:npti), sfx_lam ) 508 499 ! 509 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd)510 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr)511 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum)512 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom)513 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog)514 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif)515 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw)516 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw)517 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub)518 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res)500 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_thd_1d (1:npti), hfx_thd ) 501 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_spr_1d (1:npti), hfx_spr ) 502 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sum_1d (1:npti), hfx_sum ) 503 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bom_1d (1:npti), hfx_bom ) 504 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_bog_1d (1:npti), hfx_bog ) 505 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_dif_1d (1:npti), hfx_dif ) 506 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_opw_1d (1:npti), hfx_opw ) 507 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_snw_1d (1:npti), hfx_snw ) 508 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_sub_1d (1:npti), hfx_sub ) 509 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_res_1d (1:npti), hfx_res ) 519 510 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_dif_1d(1:npti), hfx_err_dif ) 520 511 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_err_rem_1d(1:npti), hfx_err_rem ) 521 CALL tab_1d_2d( npti, nptidx(1:npti), hfx_out_1d (1:npti), hfx_out)522 ! 523 CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d (1:npti), qns_ice(:,:,kl) )524 CALL tab_1d_2d( npti, nptidx(1:npti), ftr_ice_1d(1:npti), ftr_ice(:,:,kl) )512 CALL tab_1d_2d( npti, nptidx(1:npti), qt_oce_ai_1d (1:npti), qt_oce_ai ) 513 ! 514 CALL tab_1d_2d( npti, nptidx(1:npti), qns_ice_1d (1:npti), qns_ice (:,:,kl) ) 515 CALL tab_1d_2d( npti, nptidx(1:npti), qtr_ice_bot_1d(1:npti), qtr_ice_bot(:,:,kl) ) 525 516 ! effective conductivity and 1st layer temperature (for Jules coupling) 526 517 CALL tab_1d_2d( npti, nptidx(1:npti), cnd_ice_1d(1:npti), cnd_ice(:,:,kl) ) 527 518 CALL tab_1d_2d( npti, nptidx(1:npti), t1_ice_1d (1:npti), t1_ice (:,:,kl) ) 528 519 ! SIMIP diagnostics 529 CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d (1:npti), t_si(:,:,kl) )530 CALL tab_1d_2d( npti, nptidx(1:npti), diag_fc_bo_1d(1:npti), diag_fc_bo)531 CALL tab_1d_2d( npti, nptidx(1:npti), diag_fc_su_1d(1:npti), diag_fc_su)520 CALL tab_1d_2d( npti, nptidx(1:npti), t_si_1d (1:npti), t_si (:,:,kl) ) 521 CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) ) 522 CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_top_1d(1:npti), qcn_ice_top(:,:,kl) ) 532 523 ! extensive variables 533 524 CALL tab_1d_2d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i (:,:,kl) ) -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd_dh.F90
r9892 r9977 85 85 86 86 REAL(wp), DIMENSION(jpij) :: zqprec ! energy of fallen snow (J.m-3) 87 REAL(wp), DIMENSION(jpij) :: zq_ su! heat for surface ablation (J.m-2)88 REAL(wp), DIMENSION(jpij) :: zq_bo 87 REAL(wp), DIMENSION(jpij) :: zq_top ! heat for surface ablation (J.m-2) 88 REAL(wp), DIMENSION(jpij) :: zq_bot ! heat for bottom ablation (J.m-2) 89 89 REAL(wp), DIMENSION(jpij) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 90 90 REAL(wp), DIMENSION(jpij) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) … … 131 131 ! 132 132 DO ji = 1, npti 133 zq_ su(ji)= MAX( 0._wp, qml_ice_1d(ji) * rdt_ice )133 zq_top(ji) = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 134 134 END DO 135 135 ! 136 CASE( np_jules_ EMULE )136 CASE( np_jules_OFF , np_jules_EMULE ) 137 137 ! 138 138 DO ji = 1, npti 139 zdum = qns_ice_1d(ji) + qsr_ice_1d(ji) - q sr_ice_tr_1d(ji) - fc_su(ji)139 zdum = qns_ice_1d(ji) + qsr_ice_1d(ji) - qtr_ice_top_1d(ji) - qcn_ice_top_1d(ji) 140 140 qml_ice_1d(ji) = zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 141 zq_su(ji) = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 142 END DO 143 ! 144 CASE( np_jules_OFF ) 145 ! 146 DO ji = 1, npti 147 zdum = qns_ice_1d(ji) + qsr_ice_1d(ji) - qsr_ice_tr_1d(ji) - fc_su(ji) 148 qml_ice_1d(ji) = zdum * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 149 zq_su(ji) = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 141 zq_top(ji) = MAX( 0._wp, qml_ice_1d(ji) * rdt_ice ) 150 142 END DO 151 143 ! … … 153 145 ! 154 146 DO ji = 1, npti 155 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)156 zq_bo (ji)= MAX( 0._wp, zf_tt(ji) * rdt_ice )147 zf_tt(ji) = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) 148 zq_bot(ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 157 149 END DO 158 150 … … 210 202 ! --- melt of falling snow --- 211 203 rswitch = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) ) 212 zdeltah (ji,1) = - rswitch * zq_ su(ji) / MAX( zqprec(ji) , epsi20 ) ! thickness change213 zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting204 zdeltah (ji,1) = - rswitch * zq_top(ji) / MAX( zqprec(ji) , epsi20 ) ! thickness change 205 zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting 214 206 hfx_snw_1d (ji) = hfx_snw_1d (ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice ! heat used to melt snow (W.m-2, >0) 215 207 wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice ! snow melting only = water into the ocean (then without snow precip), >0 … … 217 209 ! updates available heat + precipitations after melting 218 210 dh_s_mlt (ji) = dh_s_mlt(ji) + zdeltah(ji,1) 219 zq_ su (ji) = MAX( 0._wp , zq_su(ji) + zdeltah(ji,1) * zqprec(ji) )211 zq_top (ji) = MAX( 0._wp , zq_top (ji) + zdeltah(ji,1) * zqprec(ji) ) 220 212 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 221 213 … … 240 232 ! Snow melting 241 233 ! ------------ 242 ! If heat still available (zq_ su> 0), then melt more snow234 ! If heat still available (zq_top > 0), then melt more snow 243 235 zdeltah(1:npti,:) = 0._wp 244 236 zdh_s_mel(1:npti) = 0._wp 245 237 DO jk = 1, nlay_s 246 238 DO ji = 1, npti 247 IF( zh_s(ji,jk) > 0._wp .AND. zq_ su(ji) > 0._wp ) THEN239 IF( zh_s(ji,jk) > 0._wp .AND. zq_top(ji) > 0._wp ) THEN 248 240 ! 249 241 rswitch = MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,jk) - epsi20 ) ) 250 zdeltah (ji,jk) = - rswitch * zq_ su(ji) / MAX( e_s_1d(ji,jk), epsi20 ) ! thickness change251 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji,jk) ) ! bound melting242 zdeltah (ji,jk) = - rswitch * zq_top(ji) / MAX( e_s_1d(ji,jk), epsi20 ) ! thickness change 243 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji,jk) ) ! bound melting 252 244 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) 253 245 … … 257 249 ! updates available heat + thickness 258 250 dh_s_mlt(ji) = dh_s_mlt(ji) + zdeltah(ji,jk) 259 zq_ su (ji) = MAX( 0._wp , zq_su(ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) )251 zq_top (ji) = MAX( 0._wp , zq_top(ji) + zdeltah(ji,jk) * e_s_1d(ji,jk) ) 260 252 h_s_1d (ji) = MAX( 0._wp , h_s_1d(ji) + zdeltah(ji,jk) ) 261 253 zh_s (ji,jk) = MAX( 0._wp , zh_s(ji,jk) + zdeltah(ji,jk) ) … … 349 341 zdE = zEi - zEw ! Specific enthalpy difference < 0 350 342 351 zfmdt = - zq_ su(ji) / zdE! Mass flux to the ocean [kg/m2, >0]343 zfmdt = - zq_top(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 352 344 353 345 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Melt of layer jk [m, <0] … … 355 347 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0] 356 348 357 zq_ su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat349 zq_top(ji) = MAX( 0._wp , zq_top(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 358 350 359 351 dh_i_sum(ji) = dh_i_sum(ji) + zdeltah(ji,jk) ! Cumulate surface melt … … 416 408 !------------------ 417 409 ! Basal growth is driven by heat imbalance at the ice-ocean interface, 418 ! between the inner conductive flux ( fc_bo_i), from the open water heat flux419 ! (fhld) and the turbulent ocean flux (fhtur).420 ! fc_bo_i is positive downwards. fhturand fhld are positive to the ice410 ! between the inner conductive flux (qcn_ice_bot), from the open water heat flux 411 ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot). 412 ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice 421 413 422 414 ! If salinity varies in time, an iterative procedure is required, because … … 515 507 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 516 508 517 zfmdt = - zq_bo (ji) / zdE! Mass flux x time step (kg/m2, >0)509 zfmdt = - zq_bot(ji) / zdE ! Mass flux x time step (kg/m2, >0) 518 510 519 511 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Gross thickness change … … 521 513 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 522 514 523 zq_bo (ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE )! update available heat. MAX is necessary for roundup errors524 525 dh_i_bom(ji) = dh_i_bom(ji) + zdeltah(ji,jk) ! Update basal melt515 zq_bot(ji) = MAX( 0._wp , zq_bot(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 516 517 dh_i_bom(ji) = dh_i_bom(ji) + zdeltah(ji,jk) ! Update basal melt 526 518 527 519 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 … … 556 548 zdeltah(1:npti,:) = 0._wp ! important 557 549 DO ji = 1, npti 558 zq_rema (ji) = zq_ su(ji) + zq_bo(ji)550 zq_rema (ji) = zq_top(ji) + zq_bot(ji) 559 551 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - h_s_1d(ji) ) ) ! =1 if snow 560 552 rswitch = rswitch * MAX( 0._wp, SIGN( 1._wp, e_s_1d(ji,1) - epsi20 ) ) … … 570 562 ! 571 563 ! Remaining heat flux (W.m-2) is sent to the ocean heat budget 572 hfx_out_1d(ji) = hfx_out_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice564 qt_oce_ai_1d(ji) = qt_oce_ai_1d(ji) + ( zq_rema(ji) * a_i_1d(ji) ) * r1_rdtice 573 565 574 566 IF( ln_icectl .AND. zq_rema(ji) < 0. .AND. lwp ) WRITE(numout,*) 'ALERTE zq_rema <0 = ', zq_rema(ji) -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/icethd_zdf_bl99.F90
r9892 r9977 178 178 !------------- 179 179 ! --- Transmission/absorption of solar radiation in the ice --- ! 180 zradtr_s(1:npti,0) = q sr_ice_tr_1d(1:npti)180 zradtr_s(1:npti,0) = qtr_ice_top_1d(1:npti) 181 181 DO jk = 1, nlay_s 182 182 DO ji = 1, npti … … 188 188 END DO 189 189 ! 190 zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + q sr_ice_tr_1d(1:npti) * ( 1._wp - isnow(1:npti) )190 zradtr_i(1:npti,0) = zradtr_s(1:npti,nlay_s) * isnow(1:npti) + qtr_ice_top_1d(1:npti) * ( 1._wp - isnow(1:npti) ) 191 191 DO jk = 1, nlay_i 192 192 DO ji = 1, npti … … 198 198 END DO 199 199 ! 200 ftr_ice_1d(1:npti) = zradtr_i(1:npti,nlay_i) ! record radiation transmitted below the ice200 qtr_ice_bot_1d(1:npti) = zradtr_i(1:npti,nlay_i) ! record radiation transmitted below the ice 201 201 ! 202 202 iconv = 0 ! number of iterations … … 330 330 331 331 DO ji = 1, npti 332 zfnet(ji) = qsr_ice_1d(ji) - q sr_ice_tr_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar332 zfnet(ji) = qsr_ice_1d(ji) - qtr_ice_top_1d(ji) + qns_ice_1d(ji) ! net heat flux = net - transmitted solar + non solar 333 333 END DO 334 334 ! … … 728 728 !----------------------------- 729 729 ! 730 ! --- update conduction fluxes731 ! 730 ! --- calculate conduction fluxes (positive downward) 731 732 732 DO ji = 1, npti 733 733 ! ! surface ice conduction flux 734 fc_su(ji) = - isnow(ji) * zkappa_s(ji,0)* zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) &735 & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0)* zg1 * ( t_i_1d(ji,1) - t_su_1d(ji) )734 qcn_ice_top_1d(ji) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_1d(ji,1) - t_su_1d(ji) ) & 735 & - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1 * ( t_i_1d(ji,1) - t_su_1d(ji) ) 736 736 ! ! bottom ice conduction flux 737 fc_bo_i(ji) = - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji) - t_i_1d(ji,nlay_i) )737 qcn_ice_bot_1d(ji) = - zkappa_i(ji,nlay_i) * zg1 * ( t_bo_1d(ji ) - t_i_1d (ji,nlay_i) ) 738 738 END DO 739 739 … … 750 750 ! 751 751 DO ji = 1, npti 752 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( fc_su(ji)- qcn_ice_1d(ji) ) * a_i_1d(ji)752 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) - ( qcn_ice_top_1d(ji) - qcn_ice_1d(ji) ) * a_i_1d(ji) 753 753 END DO 754 754 ! … … 770 770 771 771 IF( t_su_1d(ji) < rt0 ) THEN ! case T_su < 0degC 772 zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 772 zhfx_err = ( qns_ice_1d(ji) + qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji) & 773 & + zdq * r1_rdtice ) * a_i_1d(ji) 773 774 ELSE ! case T_su = 0degC 774 zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice )*a_i_1d(ji) 775 zhfx_err = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji) & 776 & + zdq * r1_rdtice ) * a_i_1d(ji) 775 777 ENDIF 776 778 777 779 ELSEIF( k_jules == np_jules_ACTIVE ) THEN 778 780 779 zhfx_err = ( fc_su(ji) + qsr_ice_tr_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq * r1_rdtice ) * a_i_1d(ji) 781 zhfx_err = ( qcn_ice_top_1d(ji) + qtr_ice_top_1d(ji) - zradtr_i(ji,nlay_i) - qcn_ice_bot_1d(ji) & 782 & + zdq * r1_rdtice ) * a_i_1d(ji) 780 783 781 784 ENDIF … … 787 790 hfx_dif_1d(ji) = hfx_dif_1d(ji) - zdq * r1_rdtice * a_i_1d(ji) 788 791 ! 789 END DO790 !791 ! --- SIMIP diagnostics792 !793 DO ji = 1, npti794 !--- Conduction fluxes (positive downwards)795 diag_fc_bo_1d(ji) = diag_fc_bo_1d(ji) + fc_bo_i(ji) * a_i_1d(ji) / at_i_1d(ji)796 diag_fc_su_1d(ji) = diag_fc_su_1d(ji) + fc_su (ji) * a_i_1d(ji) / at_i_1d(ji)797 798 !--- Snow-ice interfacial temperature (diagnostic SIMIP)799 zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji)800 IF( h_s_1d(ji) >= zhs_min ) THEN801 t_si_1d(ji) = ( rn_cnd_s * zh_i(ji) * t_s_1d(ji,1) + &802 & ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac )803 ELSE804 t_si_1d(ji) = t_su_1d(ji)805 ENDIF806 792 END DO 807 793 ! … … 827 813 IF( k_jules == np_jules_EMULE ) THEN 828 814 ! Restore temperatures to their initial values 829 t_s_1d (1:npti,:) = ztsold (1:npti,:)830 t_i_1d (1:npti,:) = ztiold (1:npti,:)831 qcn_ice_1d(1:npti) = fc_su(1:npti)815 t_s_1d (1:npti,:) = ztsold (1:npti,:) 816 t_i_1d (1:npti,:) = ztiold (1:npti,:) 817 qcn_ice_1d(1:npti) = qcn_ice_top_1d(1:npti) 832 818 ENDIF 833 819 ! 820 ! --- SIMIP diagnostics 821 ! 822 DO ji = 1, npti 823 !--- Snow-ice interfacial temperature (diagnostic SIMIP) 824 zfac = rn_cnd_s * zh_i(ji) + ztcond_i(ji,1) * zh_s(ji) 825 IF( h_s_1d(ji) >= zhs_min ) THEN 826 t_si_1d(ji) = ( rn_cnd_s * zh_i(ji) * t_s_1d(ji,1) + & 827 & ztcond_i(ji,1) * zh_s(ji) * t_i_1d(ji,1) ) / MAX( epsi10, zfac ) 828 ELSE 829 t_si_1d(ji) = t_su_1d(ji) 830 ENDIF 831 END DO 832 ! 834 833 END SUBROUTINE ice_thd_zdf_BL99 835 836 834 837 835 #else -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/ICE/iceupdate.F90
r9892 r9977 107 107 ! --- case we bypass ice thermodynamics --- ! 108 108 IF( .NOT. ln_icethd ) THEN ! we suppose ice is impermeable => ocean is isolated from atmosphere 109 hfx_in (:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 110 hfx_out (:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:) 111 ftr_ice (:,:,:) = 0._wp 112 emp_ice (:,:) = 0._wp 113 qemp_ice (:,:) = 0._wp 114 qevap_ice(:,:,:) = 0._wp 109 qt_atm_oi (:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 110 qt_oce_ai (:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:) 111 emp_ice (:,:) = 0._wp 112 qemp_ice (:,:) = 0._wp 113 qevap_ice (:,:,:) = 0._wp 115 114 ENDIF 116 115 … … 120 119 ! Solar heat flux reaching the ocean = zqsr (W.m-2) 121 120 !--------------------------------------------------- 122 zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - ftr_ice(ji,jj,:) ) )123 124 ! Total heat flux reaching the ocean = hfx_out(W.m-2)121 zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 122 123 ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 125 124 !--------------------------------------------------- 126 zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)127 hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr125 zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 126 qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + zqmass + zqsr 128 127 129 128 ! Add the residual from heat diffusion equation and sublimation (W.m-2) 130 129 !---------------------------------------------------------------------- 131 hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) + &132 & ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) )130 qt_oce_ai(ji,jj) = qt_oce_ai(ji,jj) + hfx_err_dif(ji,jj) + & 131 & ( hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) ) 133 132 134 133 ! New qsr and qns used to compute the oceanic heat flux at the next time step 135 134 !---------------------------------------------------------------------------- 136 135 qsr(ji,jj) = zqsr 137 qns(ji,jj) = hfx_out(ji,jj) - zqsr136 qns(ji,jj) = qt_oce_ai(ji,jj) - zqsr 138 137 139 138 ! Mass flux at the atm. surface … … 250 249 IF( iom_use('qsr_ice' ) ) CALL iom_put( "qsr_ice" , SUM( qsr_ice * a_i_b, dim=3 ) ) ! solar flux at ice surface 251 250 IF( iom_use('qns_ice' ) ) CALL iom_put( "qns_ice" , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice ) ! non-solar flux at ice surface 252 IF( iom_use('qtr_ice_bot') ) CALL iom_put( "qtr_ice_bot", SUM( ftr_ice * a_i_b, dim=3 )) ! solar flux transmitted thru ice253 IF( iom_use('qtr_ice_top') ) CALL iom_put( "qtr_ice_top", SUM( q sr_ice_tr * a_i_b, dim=3 )) ! solar flux transmitted thru ice surface251 IF( iom_use('qtr_ice_bot') ) CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice 252 IF( iom_use('qtr_ice_top') ) CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 ) ) ! solar flux transmitted thru ice surface 254 253 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 255 254 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 ) + qemp_ice ) 256 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( "qt_oce_ai" , hfx_out * tmask(:,:,1)) ! total heat flux at the ocean surface: interface oce-(ice+atm)257 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( "qt_atm_oi" , hfx_in * tmask(:,:,1)) ! total heat flux at the oce-ice surface: interface atm-(ice+oce)255 IF( iom_use('qt_oce_ai' ) ) CALL iom_put( "qt_oce_ai" , qt_oce_ai * tmask(:,:,1) ) ! total heat flux at the ocean surface: interface oce-(ice+atm) 256 IF( iom_use('qt_atm_oi' ) ) CALL iom_put( "qt_atm_oi" , qt_atm_oi * tmask(:,:,1) ) ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 258 257 IF( iom_use('qemp_oce' ) ) CALL iom_put( "qemp_oce" , qemp_oce ) ! Downward Heat Flux from E-P over ocean 259 258 IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice" , qemp_ice ) ! Downward Heat Flux from E-P over ice … … 267 266 IF( iom_use('hfxdif' ) ) CALL iom_put ("hfxdif" , hfx_dif ) ! heat flux used for ice temperature change 268 267 IF( iom_use('hfxsnw' ) ) CALL iom_put ("hfxsnw" , hfx_snw ) ! heat flux used for snow melt 269 IF( iom_use('hfxerr' ) ) CALL iom_put ("hfxerr" , hfx_err_dif ) ! heat flux error after heat diffusion (included in hfx_out)268 IF( iom_use('hfxerr' ) ) CALL iom_put ("hfxerr" , hfx_err_dif ) ! heat flux error after heat diffusion (included in qt_oce_ai) 270 269 271 270 ! heat fluxes associated with mass exchange (freeze/melt/precip...) … … 277 276 278 277 ! other heat fluxes 279 IF( iom_use('hfxsensib' ) ) CALL iom_put( "hfxsensib" , -fhtur * at_i_b) ! Sensible oceanic heat flux280 IF( iom_use('hfxcndbot' ) ) CALL iom_put( "hfxcndbot" , diag_fc_bo * at_i_b) ! Bottom conduction flux281 IF( iom_use('hfxcndtop' ) ) CALL iom_put( "hfxcndtop" , diag_fc_su * at_i_b) ! Surface conduction flux278 IF( iom_use('hfxsensib' ) ) CALL iom_put( "hfxsensib" , -qsb_ice_bot * at_i_b ) ! Sensible oceanic heat flux 279 IF( iom_use('hfxcndbot' ) ) CALL iom_put( "hfxcndbot" , SUM( qcn_ice_bot * a_i_b, dim=3 ) ) ! Bottom conduction flux 280 IF( iom_use('hfxcndtop' ) ) CALL iom_put( "hfxcndtop" , SUM( qcn_ice_top * a_i_b, dim=3 ) ) ! Surface conduction flux 282 281 283 282 ! diags -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/BDY/bdydta.F90
r9892 r9977 351 351 ENDIF 352 352 #if defined key_si3 353 ! convert N-cat fields (input) into jpl-cat (output) 353 354 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 354 355 jfld_hti = jfld_htit(jbdy) 355 356 jfld_hts = jfld_htst(jbdy) 356 357 jfld_ai = jfld_ait(jbdy) 357 IF ( nice_cat == 1 ) THEN! case input cat = 1358 IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1 358 359 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 359 360 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 360 ELSEIF( nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl361 ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 361 362 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 362 363 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/BDY/bdyice.F90
r9892 r9977 50 50 !! *** SUBROUTINE bdy_ice *** 51 51 !! 52 !! ** Purpose : - Apply open boundary conditions for ice (SI3)52 !! ** Purpose : Apply open boundary conditions for sea ice 53 53 !! 54 54 !!---------------------------------------------------------------------- 55 55 INTEGER, INTENT(in) :: kt ! Main time step counter 56 56 ! 57 INTEGER :: ib_bdy ! Loopindex57 INTEGER :: jbdy ! BDY set index 58 58 !!---------------------------------------------------------------------- 59 59 ! 60 IF( ln_timing ) CALL timing_start('bdy_ice ')60 IF( ln_timing ) CALL timing_start('bdy_ice_thd') 61 61 ! 62 62 CALL ice_var_glo2eqv 63 63 ! 64 DO ib_bdy = 1, nb_bdy65 ! 66 SELECT CASE( cn_ice( ib_bdy) )64 DO jbdy = 1, nb_bdy 65 ! 66 SELECT CASE( cn_ice(jbdy) ) 67 67 CASE('none') ; CYCLE 68 CASE('frs' ) ; CALL bdy_ice_frs( idx_bdy( ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy )68 CASE('frs' ) ; CALL bdy_ice_frs( idx_bdy(jbdy), dta_bdy(jbdy), kt, jbdy ) 69 69 CASE DEFAULT 70 70 CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' ) … … 79 79 ! 80 80 IF( ln_icectl ) CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 81 IF( ln_timing ) CALL timing_stop('bdy_ice ')81 IF( ln_timing ) CALL timing_stop('bdy_ice_thd') 82 82 ! 83 83 END SUBROUTINE bdy_ice 84 84 85 85 86 SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy )86 SUBROUTINE bdy_ice_frs( idx, dta, kt, jbdy ) 87 87 !!------------------------------------------------------------------------------ 88 88 !! *** SUBROUTINE bdy_ice_frs *** 89 89 !! 90 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 91 !! of unstructured open boundaries. 90 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields 92 91 !! 93 92 !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three- … … 97 96 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 98 97 INTEGER, INTENT(in) :: kt ! main time-step counter 99 INTEGER, INTENT(in) :: ib_bdy! BDY set index98 INTEGER, INTENT(in) :: jbdy ! BDY set index 100 99 ! 101 100 INTEGER :: jpbound ! 0 = incoming ice 102 101 ! ! 1 = outgoing ice 103 INTEGER :: jb, jk, jgrd, jl! dummy loop indices104 INTEGER :: ji, jj, ii, ij ! local scalar102 INTEGER :: i_bdy, jgrd ! dummy loop indices 103 INTEGER :: ji, jj, jk, jl, ib, jb 105 104 REAL(wp) :: zwgt, zwgt1 ! local scalar 106 105 REAL(wp) :: ztmelts, zdh … … 110 109 ! 111 110 DO jl = 1, jpl 112 DO jb= 1, idx%nblenrim(jgrd)113 ji = idx%nbi( jb,jgrd)114 jj = idx%nbj( jb,jgrd)115 zwgt = idx%nbw( jb,jgrd)116 zwgt1 = 1.e0 - idx%nbw( jb,jgrd)117 a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Leads fraction118 h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Ice depth119 h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s( jb,jl) * zwgt ) * tmask(ji,jj,1) ! Snow depth111 DO i_bdy = 1, idx%nblenrim(jgrd) 112 ji = idx%nbi(i_bdy,jgrd) 113 jj = idx%nbj(i_bdy,jgrd) 114 zwgt = idx%nbw(i_bdy,jgrd) 115 zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 116 a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Leads fraction 117 h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice depth 118 h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Snow depth 120 119 121 120 ! ----------------- … … 135 134 136 135 ENDDO 137 CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy )138 CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy )139 CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy )140 136 ENDDO 137 CALL lbc_bdy_lnk( a_i(:,:,:), 'T', 1., jbdy ) 138 CALL lbc_bdy_lnk( h_i(:,:,:), 'T', 1., jbdy ) 139 CALL lbc_bdy_lnk( h_s(:,:,:), 'T', 1., jbdy ) 141 140 142 141 DO jl = 1, jpl 143 DO jb= 1, idx%nblenrim(jgrd)144 ji = idx%nbi(jb,jgrd)145 jj = idx%nbj(jb,jgrd)142 DO i_bdy = 1, idx%nblenrim(jgrd) 143 ji = idx%nbi(i_bdy,jgrd) 144 jj = idx%nbj(i_bdy,jgrd) 146 145 147 146 ! condition on ice thickness depends on the ice velocity 148 147 ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 149 jpbound = 0 ; i i = ji ; ij= jj150 ! 151 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij= jj152 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij= jj153 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij= jj+1154 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij= jj-1155 ! 156 IF( nn_ice_dta( ib_bdy) == 0 ) jpbound = 0; ii = ji; ij= jj ! case ice boundaries = initial conditions157 ! ! do not make state variables dependent on velocity158 ! 159 IF( a_i(i i,ij,jl) > 0._wp ) THEN ! there is ice at the boundary160 ! 161 a_i(ji,jj,jl) = a_i(i i,ij,jl) ! concentration162 h_i(ji,jj,jl) = h_i(i i,ij,jl) ! thickness ice163 h_s(ji,jj,jl) = h_s(i i,ij,jl) ! thickness snw148 jpbound = 0 ; ib = ji ; jb = jj 149 ! 150 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1 ; ib = ji+1 ; jb = jj 151 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1 ; ib = ji-1 ; jb = jj 152 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1 ; ib = ji ; jb = jj+1 153 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1 ; ib = ji ; jb = jj-1 154 ! 155 IF( nn_ice_dta(jbdy) == 0 ) jpbound = 0 ; ib = ji ; jb = jj ! case ice boundaries = initial conditions 156 ! ! do not make state variables dependent on velocity 157 ! 158 IF( a_i(ib,jb,jl) > 0._wp ) THEN ! there is ice at the boundary 159 ! 160 a_i(ji,jj,jl) = a_i(ib,jb,jl) ! concentration 161 h_i(ji,jj,jl) = h_i(ib,jb,jl) ! thickness ice 162 h_s(ji,jj,jl) = h_s(ib,jb,jl) ! thickness snw 164 163 ! 165 164 SELECT CASE( jpbound ) … … 167 166 CASE( 0 ) ! velocity is inward 168 167 ! 169 oa_i(ji,jj, jl) = rn_ice_age( ib_bdy) * a_i(ji,jj,jl) ! age170 a_ip(ji,jj, jl) = 0._wp 171 v_ip(ji,jj, jl) = 0._wp 172 t_su(ji,jj, jl) = rn_ice_tem( ib_bdy) ! temperature surface173 t_s (ji,jj,:,jl) = rn_ice_tem( ib_bdy) ! temperature snw174 t_i (ji,jj,:,jl) = rn_ice_tem( ib_bdy) ! temperature ice175 s_i (ji,jj, jl) = rn_ice_sal( ib_bdy) ! salinity176 sz_i(ji,jj,:,jl) = rn_ice_sal( ib_bdy) ! salinity profile168 oa_i(ji,jj, jl) = rn_ice_age(jbdy) * a_i(ji,jj,jl) ! age 169 a_ip(ji,jj, jl) = 0._wp ! pond concentration 170 v_ip(ji,jj, jl) = 0._wp ! pond volume 171 t_su(ji,jj, jl) = rn_ice_tem(jbdy) ! temperature surface 172 t_s (ji,jj,:,jl) = rn_ice_tem(jbdy) ! temperature snw 173 t_i (ji,jj,:,jl) = rn_ice_tem(jbdy) ! temperature ice 174 s_i (ji,jj, jl) = rn_ice_sal(jbdy) ! salinity 175 sz_i(ji,jj,:,jl) = rn_ice_sal(jbdy) ! salinity profile 177 176 ! 178 177 CASE( 1 ) ! velocity is outward 179 178 ! 180 oa_i(ji,jj, jl) = oa_i(i i,ij, jl) ! age181 a_ip(ji,jj, jl) = a_ip(i i,ij, jl) ! pond concentration182 v_ip(ji,jj, jl) = v_ip(i i,ij, jl) ! pond volume183 t_su(ji,jj, jl) = t_su(i i,ij, jl) ! temperature surface184 t_s (ji,jj,:,jl) = t_s (i i,ij,:,jl) ! temperature snw185 t_i (ji,jj,:,jl) = t_i (i i,ij,:,jl) ! temperature ice186 s_i (ji,jj, jl) = s_i (i i,ij, jl) ! salinity187 sz_i(ji,jj,:,jl) = sz_i(i i,ij,:,jl) ! salinity profile179 oa_i(ji,jj, jl) = oa_i(ib,jb, jl) ! age 180 a_ip(ji,jj, jl) = a_ip(ib,jb, jl) ! pond concentration 181 v_ip(ji,jj, jl) = v_ip(ib,jb, jl) ! pond volume 182 t_su(ji,jj, jl) = t_su(ib,jb, jl) ! temperature surface 183 t_s (ji,jj,:,jl) = t_s (ib,jb,:,jl) ! temperature snw 184 t_i (ji,jj,:,jl) = t_i (ib,jb,:,jl) ! temperature ice 185 s_i (ji,jj, jl) = s_i (ib,jb, jl) ! salinity 186 sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) ! salinity profile 188 187 ! 189 188 END SELECT … … 243 242 END DO 244 243 ! 245 CALL lbc_bdy_lnk( a_i (:,:,jl), 'T', 1., ib_bdy )246 CALL lbc_bdy_lnk( h_i (:,:,jl), 'T', 1., ib_bdy )247 CALL lbc_bdy_lnk( h_s (:,:,jl), 'T', 1., ib_bdy )248 CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy )249 CALL lbc_bdy_lnk( a_ip(:,:,jl), 'T', 1., ib_bdy )250 CALL lbc_bdy_lnk( v_ip(:,:,jl), 'T', 1., ib_bdy )251 CALL lbc_bdy_lnk( s_i (:,:,jl), 'T', 1., ib_bdy )252 CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy )253 CALL lbc_bdy_lnk( v_i (:,:,jl), 'T', 1., ib_bdy )254 CALL lbc_bdy_lnk( v_s (:,:,jl), 'T', 1., ib_bdy )255 CALL lbc_bdy_lnk( sv_i(:,:,jl), 'T', 1., ib_bdy )256 DO jk = 1, nlay_s257 CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy )258 CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy )259 END DO260 DO jk = 1, nlay_i261 CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy )262 CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy )263 END DO264 !265 244 END DO ! jl 245 246 CALL lbc_bdy_lnk( a_i (:,:,:) , 'T', 1., jbdy ) 247 CALL lbc_bdy_lnk( h_i (:,:,:) , 'T', 1., jbdy ) 248 CALL lbc_bdy_lnk( h_s (:,:,:) , 'T', 1., jbdy ) 249 CALL lbc_bdy_lnk( oa_i(:,:,:) , 'T', 1., jbdy ) 250 CALL lbc_bdy_lnk( a_ip(:,:,:) , 'T', 1., jbdy ) 251 CALL lbc_bdy_lnk( v_ip(:,:,:) , 'T', 1., jbdy ) 252 CALL lbc_bdy_lnk( s_i (:,:,:) , 'T', 1., jbdy ) 253 CALL lbc_bdy_lnk( t_su(:,:,:) , 'T', 1., jbdy ) 254 CALL lbc_bdy_lnk( v_i (:,:,:) , 'T', 1., jbdy ) 255 CALL lbc_bdy_lnk( v_s (:,:,:) , 'T', 1., jbdy ) 256 CALL lbc_bdy_lnk( sv_i(:,:,:) , 'T', 1., jbdy ) 257 CALL lbc_bdy_lnk( t_s (:,:,:,:), 'T', 1., jbdy ) 258 CALL lbc_bdy_lnk( e_s (:,:,:,:), 'T', 1., jbdy ) 259 CALL lbc_bdy_lnk( t_i (:,:,:,:), 'T', 1., jbdy ) 260 CALL lbc_bdy_lnk( e_i (:,:,:,:), 'T', 1., jbdy ) 266 261 ! 267 262 END SUBROUTINE bdy_ice_frs … … 272 267 !! *** SUBROUTINE bdy_ice_dyn *** 273 268 !! 274 !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries. 275 !! u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free 276 !! if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities 269 !! ** Purpose : Apply dynamics boundary conditions for sea-ice. 277 270 !! 278 !! 2013-06 : C. Rousset 271 !! ** Method : if this adjacent grid point is not ice free, then u_ice and v_ice take its value 272 !! if is ice free, then u_ice and v_ice are unchanged by BDY 273 !! they keep values calculated in rheology 274 !! 279 275 !!------------------------------------------------------------------------------ 280 276 CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points 281 277 ! 282 INTEGER :: jb, jgrd! dummy loop indices283 INTEGER :: ji, jj 284 INTEGER :: ib_bdy ! Loopindex278 INTEGER :: i_bdy, jgrd ! dummy loop indices 279 INTEGER :: ji, jj ! local scalar 280 INTEGER :: jbdy ! BDY set index 285 281 REAL(wp) :: zmsk1, zmsk2, zflag 286 282 !!------------------------------------------------------------------------------ 287 ! 288 DO ib_bdy=1, nb_bdy 289 ! 290 SELECT CASE( cn_ice(ib_bdy) ) 283 IF( ln_timing ) CALL timing_start('bdy_ice_dyn') 284 ! 285 DO jbdy=1, nb_bdy 286 ! 287 SELECT CASE( cn_ice(jbdy) ) 291 288 ! 292 289 CASE('none') … … 295 292 CASE('frs') 296 293 ! 297 IF( nn_ice_dta( ib_bdy) == 0 ) CYCLE ! case ice boundaries = initial conditions298 ! 294 IF( nn_ice_dta(jbdy) == 0 ) CYCLE ! case ice boundaries = initial conditions 295 ! ! do not change ice velocity (it is only computed by rheology) 299 296 SELECT CASE ( cd_type ) 300 297 ! 301 298 CASE ( 'U' ) 302 299 jgrd = 2 ! u velocity 303 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)304 ji = idx_bdy( ib_bdy)%nbi(jb,jgrd)305 jj = idx_bdy( ib_bdy)%nbj(jb,jgrd)306 zflag = idx_bdy( ib_bdy)%flagu(jb,jgrd)300 DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 301 ji = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 302 jj = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 303 zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 307 304 ! 308 305 IF ( ABS( zflag ) == 1. ) THEN ! eastern and western boundaries … … 320 317 ! 321 318 END DO 322 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy )319 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., jbdy ) 323 320 ! 324 321 CASE ( 'V' ) 325 322 jgrd = 3 ! v velocity 326 DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd)327 ji = idx_bdy( ib_bdy)%nbi(jb,jgrd)328 jj = idx_bdy( ib_bdy)%nbj(jb,jgrd)329 zflag = idx_bdy( ib_bdy)%flagv(jb,jgrd)323 DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 324 ji = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 325 jj = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 326 zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 330 327 ! 331 328 IF ( ABS( zflag ) == 1. ) THEN ! northern and southern boundaries … … 343 340 ! 344 341 END DO 345 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy )342 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., jbdy ) 346 343 ! 347 344 END SELECT … … 352 349 ! 353 350 END DO 351 ! 352 IF( ln_timing ) CALL timing_stop('bdy_ice_dyn') 354 353 ! 355 354 END SUBROUTINE bdy_ice_dyn -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/CRS/crsdom.F90
r9892 r9977 2246 2246 2247 2247 zmbk(:,:) = 0.0 2248 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0) ; mbathy_crs(:,:) = INT( zmbk(:,:) )2248 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0) ; mbathy_crs(:,:) = NINT( zmbk(:,:) ) 2249 2249 2250 2250 … … 2266 2266 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 2267 2267 zmbk(:,:) = 1.e0; 2268 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs (:,:) = MAX( INT( zmbk(:,:) ), 1 )2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs (:,:) = MAX( INT( zmbk(:,:) ), 1 )2268 zmbk(:,:) = REAL( mbku_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2269 zmbk(:,:) = REAL( mbkv_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs (:,:) = MAX( NINT( zmbk(:,:) ), 1 ) 2270 2270 ! 2271 2271 END SUBROUTINE crs_dom_bat -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DIA/dia25h.F90
r9892 r9977 139 139 ! ----------------- 140 140 ! Define frequency of summing to create 25 h mean 141 IF( MOD( 3600, INT(rdt) ) == 0 ) THEN142 i_steps = 3600/ INT(rdt)141 IF( MOD( 3600,NINT(rdt) ) == 0 ) THEN 142 i_steps = 3600/NINT(rdt) 143 143 ELSE 144 144 CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible') -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DOM/domain.F90
r9893 r9977 543 543 ! 544 544 cd_cfg = 'ORCA' 545 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = INT( zorca_res )545 CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res ) 546 546 ! 547 547 WRITE(ldtxt(ii),*) ' .' ; ii = ii+1 … … 563 563 ENDIF 564 564 ! 565 CALL iom_get( inum, 'jpiglo', ziglo ) ; kpi = INT( ziglo )566 CALL iom_get( inum, 'jpjglo', zjglo ) ; kpj = INT( zjglo )567 CALL iom_get( inum, 'jpkglo', zkglo ) ; kpk = INT( zkglo )568 CALL iom_get( inum, 'jperio', zperio ) ; kperio = INT( zperio )565 CALL iom_get( inum, 'jpiglo', ziglo ) ; kpi = NINT( ziglo ) 566 CALL iom_get( inum, 'jpjglo', zjglo ) ; kpj = NINT( zjglo ) 567 CALL iom_get( inum, 'jpkglo', zkglo ) ; kpk = NINT( zkglo ) 568 CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio ) 569 569 CALL iom_close( inum ) 570 570 ! -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/DOM/domzgr.F90
r9892 r9977 253 253 ! !* ocean top and bottom level 254 254 CALL iom_get( inum, jpdom_data, 'top_level' , z2d , lrowattr=ln_use_jattr ) ! 1st wet T-points (ISF) 255 k_top(:,:) = INT( z2d(:,:) )255 k_top(:,:) = NINT( z2d(:,:) ) 256 256 CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d , lrowattr=ln_use_jattr ) ! last wet T-points 257 k_bot(:,:) = INT( z2d(:,:) )257 k_bot(:,:) = NINT( z2d(:,:) ) 258 258 ! 259 259 ! reference depth for negative bathy (wetting and drying only) … … 307 307 END DO 308 308 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 309 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; miku(:,:) = MAX( INT( zk(:,:) ), 1 )310 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mikv(:,:) = MAX( INT( zk(:,:) ), 1 )311 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( zk, 'F', 1. ) ; mikf(:,:) = MAX( INT( zk(:,:) ), 1 )312 ! 313 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; mbku(:,:) = MAX( INT( zk(:,:) ), 1 )314 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( INT( zk(:,:) ), 1 )309 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 310 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 311 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( zk, 'F', 1. ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 312 ! 313 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 314 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 315 315 ! 316 316 END SUBROUTINE zgr_top_bot -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/IOM/iom.F90
r9892 r9977 83 83 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 84 84 END INTERFACE iom_put 85 86 LOGICAL, PARAMETER :: ltmppatch = .TRUE. !: seb: patch before we remove periodicity87 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files88 INTEGER :: nldj_save, nlej_save !:89 85 90 86 !!---------------------------------------------------------------------- … … 95 91 CONTAINS 96 92 97 SUBROUTINE iom_init( cdname, fname )93 SUBROUTINE iom_init( cdname, fname, ld_tmppatch ) 98 94 !!---------------------------------------------------------------------- 99 95 !! *** ROUTINE *** … … 102 98 !! 103 99 !!---------------------------------------------------------------------- 104 CHARACTER(len=*), INTENT(in) :: cdname100 CHARACTER(len=*), INTENT(in) :: cdname 105 101 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 102 LOGICAL , OPTIONAL, INTENT(in) :: ld_tmppatch 106 103 #if defined key_iomput 107 104 ! … … 113 110 ! 114 111 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 112 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity 113 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files 114 INTEGER :: nldj_save, nlej_save !: 115 115 !!---------------------------------------------------------------------- 116 116 ! 117 117 ! seb: patch before we remove periodicity and close boundaries in output files 118 IF ( ltmppatch ) THEN 118 IF( PRESENT(ld_tmppatch) ) THEN ; ll_tmppatch = ld_tmppatch 119 ELSE ; ll_tmppatch = .TRUE. 120 ENDIF 121 IF ( ll_tmppatch ) THEN 119 122 nldi_save = nldi ; nlei_save = nlei 120 123 nldj_save = nldj ; nlej_save = nlej … … 246 249 DEALLOCATE( zt_bnds, zw_bnds ) 247 250 ! 248 IF ( l tmppatch ) THEN251 IF ( ll_tmppatch ) THEN 249 252 nldi = nldi_save ; nlei = nlei_save 250 253 nldj = nldj_save ; nlej = nlej_save … … 1924 1927 !!---------------------------------------------------------------------- 1925 1928 ! 1926 ! seb: patch before we remove periodicity and close boundaries in output files1927 IF ( ltmppatch ) THEN1928 nldi_save = nldi ; nlei_save = nlei1929 nldj_save = nldj ; nlej_save = nlej1930 IF( nimpp == 1 ) nldi = 11931 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi1932 IF( njmpp == 1 ) nldj = 11933 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj1934 ENDIF1935 !1936 1929 ni = nlei-nldi+1 1937 1930 nj = nlej-nldj+1 … … 1955 1948 ENDIF 1956 1949 ! 1957 IF ( ltmppatch ) THEN1958 nldi = nldi_save ; nlei = nlei_save1959 nldj = nldj_save ; nlej = nlej_save1960 ENDIF1961 !1962 1950 END SUBROUTINE set_grid 1963 1951 … … 1981 1969 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1982 1970 !!---------------------------------------------------------------------- 1983 !1984 ! seb: patch before we remove periodicity and close boundaries in output files1985 IF ( ltmppatch ) THEN1986 nldi_save = nldi ; nlei_save = nlei1987 nldj_save = nldj ; nlej_save = nlej1988 IF( nimpp == 1 ) nldi = 11989 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi1990 IF( njmpp == 1 ) nldj = 11991 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj1992 ENDIF1993 1971 ! 1994 1972 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) … … 2075 2053 DEALLOCATE( z_bnds, z_fld, z_rot ) 2076 2054 ! 2077 IF ( ltmppatch ) THEN2078 nldi = nldi_save ; nlei = nlei_save2079 nldj = nldj_save ; nlej = nlej_save2080 ENDIF2081 !2082 2055 END SUBROUTINE set_grid_bounds 2083 2056 … … 2095 2068 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 2096 2069 !!---------------------------------------------------------------------- 2097 !2098 ! seb: patch before we remove periodicity and close boundaries in output files2099 IF ( ltmppatch ) THEN2100 nldi_save = nldi ; nlei_save = nlei2101 nldj_save = nldj ; nlej_save = nlej2102 IF( nimpp == 1 ) nldi = 12103 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi2104 IF( njmpp == 1 ) nldj = 12105 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj2106 ENDIF2107 2070 ! 2108 2071 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk) … … 2119 2082 ! 2120 2083 CALL iom_update_file_name('ptr') 2121 !2122 IF ( ltmppatch ) THEN2123 nldi = nldi_save ; nlei = nlei_save2124 nldj = nldj_save ; nlej = nlej_save2125 ENDIF2126 2084 ! 2127 2085 END SUBROUTINE set_grid_znl -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/IOM/restart.F90
r9893 r9977 129 129 clpname = TRIM(Agrif_CFixed())//"_"//clname 130 130 ENDIF 131 CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname) )131 CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname), .false. ) 132 132 CALL xios_update_calendar(nitrst) 133 133 CALL iom_swap( cxios_context ) … … 239 239 IF( .NOT.lxios_set ) THEN 240 240 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 241 CALL iom_init( crxios_context )241 CALL iom_init( crxios_context, ld_tmppatch = .false. ) 242 242 lxios_set = .TRUE. 243 243 ENDIF 244 244 ENDIF 245 245 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 246 CALL iom_init( crxios_context )246 CALL iom_init( crxios_context, ld_tmppatch = .false. ) 247 247 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 248 248 lxios_set = .TRUE. -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/lbclnk.F90
r9892 r9977 38 38 ! 39 39 INTERFACE lbc_bdy_lnk 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 41 41 END INTERFACE 42 42 ! -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/lib_mpp.F90
r9892 r9977 88 88 PUBLIC mppsize 89 89 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 90 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 90 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 91 91 PUBLIC mpprank 92 92 … … 456 456 ! !== 4D array and array of 4D pointer ==! 457 457 ! 458 !!# define DIM_4d459 !!# define ROUTINE_BDY mpp_lnk_bdy_4d460 !!# include "mpp_bdy_generic.h90"461 !!# undef ROUTINE_BDY462 !!# undef DIM_4d458 # define DIM_4d 459 # define ROUTINE_BDY mpp_lnk_bdy_4d 460 # include "mpp_bdy_generic.h90" 461 # undef ROUTINE_BDY 462 # undef DIM_4d 463 463 464 464 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/mpp_nfd_generic.h90
r9805 r9977 56 56 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 57 57 INTEGER :: imigr, iihom, ijhom ! local integers 58 INTEGER :: ierr, itaille, il di, ilei, iilb58 INTEGER :: ierr, itaille, ilci, ildi, ilei, iilb 59 59 INTEGER :: ij, iproc 60 60 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf ! for mpi_isend when avoiding mpi_allgather … … 117 117 IF(iproc /= -1) THEN 118 118 iilb = nimppt(iproc+1) 119 ilci = nlcit (iproc+1) 119 120 ildi = nldit (iproc+1) 120 121 ilei = nleit (iproc+1) 121 IF( iilb == 1 ) ildi = 1! e-w boundary already done -> force to take 1st column122 IF( iilb + jpi - 1 == jpiglo ) ilei = jpi ! e-w boundary already done -> force to take last column122 IF( iilb == 1 ) ildi = 1 ! e-w boundary already done -> force to take 1st column 123 IF( iilb + ilci - 1 == jpiglo ) ilei = ilci ! e-w boundary already done -> force to take last column 123 124 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 124 125 ENDIF … … 185 186 iproc = nrank_north(jr) + 1 186 187 iilb = nimppt(iproc) 188 ilci = nlcit (iproc) 187 189 ildi = nldit (iproc) 188 190 ilei = nleit (iproc) 189 IF( iilb == 1 ) ildi = 1! e-w boundary already done -> force to take 1st column190 IF( iilb + jpi - 1 == jpiglo ) ilei = jpi ! e-w boundary already done -> force to take last column191 IF( iilb == 1 ) ildi = 1 ! e-w boundary already done -> force to take 1st column 192 IF( iilb + ilci - 1 == jpiglo ) ilei = ilci ! e-w boundary already done -> force to take last column 191 193 DO jf = 1, ipf 192 194 DO jl = 1, ipl -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/LBC/mppini.F90
r9892 r9977 536 536 & ibonit (jproc), ibonjt (jproc) 537 537 END DO 538 CLOSE(inum)539 538 END IF 540 539 … … 577 576 IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 578 577 CALL mpp_ini_north 579 IF(lwp) WRITE(numout,*) 580 IF(lwp) WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 578 IF (lwp) THEN 579 WRITE(numout,*) 580 WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1' 581 ! additional prints in layout.dat 582 WRITE(inum,*) 583 WRITE(inum,*) 584 WRITE(inum,*) 'number of subdomains located along the north fold : ', ndim_rank_north 585 WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north 586 DO jproc = 1, ndim_rank_north, 5 587 WRITE(inum,*) nrank_north( jproc:MINVAL( (/jproc+4,ndim_rank_north/) ) ) 588 END DO 589 ENDIF 581 590 ENDIF 582 591 ! 583 592 CALL mpp_init_ioipsl ! Prepare NetCDF output file (if necessary) 584 593 ! 585 IF( ln_nnogather ) CALL mpp_init_nfdcom ! northfold neighbour lists 594 IF( ln_nnogather ) THEN 595 CALL mpp_init_nfdcom ! northfold neighbour lists 596 IF (lwp) THEN 597 WRITE(inum,*) 598 WRITE(inum,*) 599 WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 600 WRITE(inum,*) 'nfsloop : ', nfsloop 601 WRITE(inum,*) 'nfeloop : ', nfeloop 602 WRITE(inum,*) 'nsndto : ', nsndto 603 WRITE(inum,*) 'isendto : ', isendto 604 ENDIF 605 ENDIF 606 ! 607 IF (lwp) CLOSE(inum) 586 608 ! 587 609 DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe, & -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbc_ice.F90
r9892 r9977 49 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qml_ice !: heat available for snow / ice surface melting [W/m2] 50 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qcn_ice !: heat conduction flux in the layer below surface [W/m2] 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: q sr_ice_tr!: solar flux transmitted below the ice surface [W/m2]51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qtr_ice_top !: solar flux transmitted below the ice surface [W/m2] 52 52 53 53 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] … … 126 126 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 127 127 & qla_ice (jpi,jpj,jpl) , dqla_ice (jpi,jpj,jpl) , & 128 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , &129 & qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , q sr_ice_tr(jpi,jpj,jpl) , &130 & utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , &131 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , &132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , &133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , &134 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , STAT= ierr(2) )128 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , & 129 & qml_ice (jpi,jpj,jpl) , qcn_ice (jpi,jpj,jpl) , qtr_ice_top(jpi,jpj,jpl) , & 130 & utau_ice(jpi,jpj) , vtau_ice (jpi,jpj) , wndm_ice (jpi,jpj) , & 131 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice (jpi,jpj) , & 132 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 133 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 134 & emp_ice (jpi,jpj) , tsfc_ice (jpi,jpj,jpl) , sstfrz (jpi,jpj) , STAT= ierr(2) ) 135 135 #endif 136 136 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbcblk.F90
r9892 r9977 907 907 ! 908 908 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 909 q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )909 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 910 910 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 911 q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) * zfr1911 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 912 912 ELSEWHERE ! zero when hs>0 913 q sr_ice_tr(:,:,:) = 0._wp913 qtr_ice_top(:,:,:) = 0._wp 914 914 END WHERE 915 915 ! … … 1000 1000 ztsu = ptsu(ji,jj,jl) ! Store current iteration temperature 1001 1001 ztsu0 = ptsu(ji,jj,jl) ! Store initial surface temperature 1002 zqa0 = qsr_ice(ji,jj,jl) - q sr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl)! Net initial atmospheric heat flux1002 zqa0 = qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) ! Net initial atmospheric heat flux 1003 1003 ! 1004 1004 DO iter = 1, nit ! --- Iterative loop … … 1011 1011 qcn_ice(ji,jj,jl) = zkeff_h * ( ptsu(ji,jj,jl) - ptb(ji,jj) ) 1012 1012 qns_ice(ji,jj,jl) = qns_ice(ji,jj,jl) + dqns_ice(ji,jj,jl) * ( ptsu(ji,jj,jl) - ztsu0 ) 1013 qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - q sr_ice_tr(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) )&1013 qml_ice(ji,jj,jl) = ( qsr_ice(ji,jj,jl) - qtr_ice_top(ji,jj,jl) + qns_ice(ji,jj,jl) - qcn_ice(ji,jj,jl) ) & 1014 1014 & * MAX( 0._wp , SIGN( 1._wp, ptsu(ji,jj,jl) - rt0 ) ) 1015 1015 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/SBC/sbccpl.F90
r9892 r9977 1999 1999 ! ! ========================= ! 2000 2000 CASE ('coupled') 2001 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i(:,:,:)2002 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i(:,:,:)2001 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2002 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2003 2003 END SELECT 2004 2004 ! … … 2012 2012 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 2013 2013 ! 2014 q sr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:)2015 WHERE( phs(:,:,:) >= 0.0_wp ) q sr_ice_tr(:,:,:) = 0._wp ! snow fully opaque2016 WHERE( phi(:,:,:) <= 0.1_wp ) q sr_ice_tr(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation2014 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2015 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2016 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2017 2017 ! 2018 2018 CASE( np_jules_ACTIVE ) !== Jules coupler is active ==! 2019 2019 ! 2020 ! ! ===> here we must receive the q sr_ice_trarray from the coupler2020 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2021 2021 ! for now just assume zero (fully opaque ice) 2022 q sr_ice_tr(:,:,:) = 0._wp2022 qtr_ice_top(:,:,:) = 0._wp 2023 2023 ! 2024 2024 END SELECT -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/TRA/traadv_fct.F90
r9892 r9977 548 548 !!gm 549 549 ! 550 IF ( ln_isfcav ) THEN ! set level two values which may not be set in ISF case 551 zwd(:,:,2) = 1._wp ; zwi(:,:,2) = 0._wp ; zws(:,:,2) = 0._wp ; zwrm(:,:,2) = 0._wp 552 END IF 553 ! 550 554 DO jj = 2, jpjm1 ! 2nd order centered at top & bottom 551 555 DO ji = fs_2, fs_jpim1 … … 556 560 zwi (ji,jj,ikt) = 0._wp 557 561 zws (ji,jj,ikt) = 0._wp 558 zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj, jk-1) + pt_in(ji,jj,jk) )562 zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) ) 559 563 ! 560 564 zwd (ji,jj,ikb) = 1._wp ! bottom 561 565 zwi (ji,jj,ikb) = 0._wp 562 566 zws (ji,jj,ikb) = 0._wp 563 zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj, jk-1) + pt_in(ji,jj,jk) )567 zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) ) 564 568 END DO 565 569 END DO -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/TRA/trabbl.F90
r9892 r9977 526 526 zmbku(:,:) = REAL( mbku_d(:,:), wp ) ; zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) 527 527 CALL lbc_lnk_multi( zmbku,'U',1., zmbkv,'V',1.) 528 mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ; mbkv_d(:,:) = MAX( INT( zmbkv(:,:) ), 1 )528 mbku_d(:,:) = MAX( INT( zmbku(:,:) ), 1 ) ; mbkv_d(:,:) = MAX( NINT( zmbkv(:,:) ), 1 ) 529 529 ! 530 530 ! !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/USR/usrdef_zgr.F90
r9892 r9977 204 204 CALL lbc_lnk( z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 205 205 ! 206 k_bot(:,:) = INT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere206 k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 207 207 ! 208 208 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/stpctl.F90
r9892 r9977 114 114 CALL mpp_max_multiple( zmax(:), 5 ) ! max over the global domain 115 115 ! 116 nstop = INT( zmax(5) ) ! nstop indicator sheared among all local domains116 nstop = NINT( zmax(5) ) ! nstop indicator sheared among all local domains 117 117 ENDIF 118 118 ! -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/OCE/timing.F90
r9892 r9977 211 211 WRITE(numtime,*) ' NEMO team' 212 212 WRITE(numtime,*) ' Ocean General Circulation Model' 213 WRITE(numtime,*) ' version 3.6 (2015) '213 WRITE(numtime,*) ' version 4.0 (2018) ' 214 214 WRITE(numtime,*) 215 215 WRITE(numtime,*) ' Timing Informations ' -
NEMO/branches/UKMO/dev_r9888_proto_GO8_package/src/TOP/PISCES/P4Z/p4zsms.F90
r9892 r9977 300 300 IF( ln_p5z ) THEN 301 301 IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 302 CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , size d(:,:,:) )303 CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , size d(:,:,:) )302 CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sizep(:,:,:) ) 303 CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sizen(:,:,:) ) 304 304 CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:) ) 305 305 ELSE … … 321 321 CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 322 322 IF( ln_p5z ) THEN 323 CALL iom_rstput( kt, nitrst, numrtw, 'sizep', size d(:,:,:) )324 CALL iom_rstput( kt, nitrst, numrtw, 'sizen', size d(:,:,:) )323 CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sizep(:,:,:) ) 324 CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sizen(:,:,:) ) 325 325 CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) ) 326 326 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.