Changeset 5407
- Timestamp:
- 2015-06-11T21:13:22+02:00 (7 years ago)
- Location:
- trunk/NEMOGCM
- Files:
-
- 1 added
- 64 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/ARCH/arch-X64_CURIE.fcm
r4865 r5407 29 29 # - fcm variables are starting with a % (and not a $) 30 30 # 31 %NCDF_HOME /usr/local/netcdf-4.2_hdf5_parallel32 %HDF5_HOME /usr/local/hdf5-1.8. 9_parallel33 %XIOS_HOME $WORKDIR/ now/models/xios31 %NCDF_HOME /usr/local/netcdf-4.3.3.1_hdf5_parallel 32 %HDF5_HOME /usr/local/hdf5-1.8.12_parallel 33 %XIOS_HOME $WORKDIR/xios-1.0 34 34 %OASIS_HOME $WORKDIR/now/models/oa3mct 35 35 -
trunk/NEMOGCM/ARCH/arch-macport_osx.fcm
r4865 r5407 40 40 %NCDF_HOME /opt/local 41 41 %HDF5_HOME /opt/local 42 %XIOS_HOME /Users/$( whoami )/ XIOS42 %XIOS_HOME /Users/$( whoami )/xios-1.0 43 43 %OASIS_HOME /not/defined 44 44 -
trunk/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r5147 r5407 129 129 / 130 130 !----------------------------------------------------------------------- 131 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")131 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 132 132 !----------------------------------------------------------------------- 133 133 / -
trunk/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
r5108 r5407 131 131 / 132 132 !----------------------------------------------------------------------- 133 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")133 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 134 134 !----------------------------------------------------------------------- 135 135 / -
trunk/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r5102 r5407 116 116 / 117 117 !----------------------------------------------------------------------- 118 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")118 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 119 119 !----------------------------------------------------------------------- 120 120 / -
trunk/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r5102 r5407 121 121 / 122 122 !----------------------------------------------------------------------- 123 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")123 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 124 124 !----------------------------------------------------------------------- 125 125 / -
trunk/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
r5300 r5407 110 110 / 111 111 !----------------------------------------------------------------------- 112 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")112 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 113 113 !----------------------------------------------------------------------- 114 114 / -
trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
r5385 r5407 73 73 <file id="file5" name_suffix="_grid_W" description="ocean W grid variables" > 74 74 <field field_ref="e3w" /> 75 <field field_ref="woce" name="wo" operation="instant" freq_op="5d" > @woce_e3w / @e3w </field>75 <field field_ref="woce" name="wo" /> 76 76 <field field_ref="avt" name="difvho" /> 77 77 </file> -
trunk/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/iodef.xml
r5385 r5407 102 102 <file id="file5" name_suffix="_grid_W" description="ocean W grid variables" > 103 103 <field field_ref="e3w" /> 104 <field field_ref="woce" name="wo" operation="instant" freq_op="5d" > @woce_e3w / @e3w </field>104 <field field_ref="woce" name="wo" /> 105 105 <field field_ref="avt" name="difvho" /> 106 106 <field field_ref="w_masstr" name="vovematr" /> -
trunk/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/1_namelist_cfg
r4147 r5407 110 110 !! namsbc_clio CLIO bulk formulea formulation 111 111 !! namsbc_core CORE bulk formulea formulation 112 !! namsbc_cpl CouPLed formulation ("key_ coupled")112 !! namsbc_cpl CouPLed formulation ("key_oasis3") 113 113 !! namtra_qsr penetrative solar radiation 114 114 !! namsbc_rnf river runoffs … … 199 199 / 200 200 !----------------------------------------------------------------------- 201 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")201 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 202 202 !----------------------------------------------------------------------- 203 203 ! ! description ! multiple ! vector ! vector ! vector ! … … 640 640 ! = 1 add a tke source below the ML 641 641 ! = 2 add a tke source just at the base of the ML 642 ! = 3 as = 1 applied on HF part of the stress ("key_ coupled")642 ! = 3 as = 1 applied on HF part of the stress ("key_oasis3") 643 643 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 644 644 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML -
trunk/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
r4370 r5407 104 104 / 105 105 !----------------------------------------------------------------------- 106 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")106 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 107 107 !----------------------------------------------------------------------- 108 108 / -
trunk/NEMOGCM/CONFIG/SHARED/field_def.xml
r5385 r5407 202 202 <field id="qsb_oce" long_name="Sensible Downward Heat Flux over open ocean" standard_name="surface_downward_sensible_heat_flux" unit="W/m2" /> 203 203 <field id="qla_oce" long_name="Latent Downward Heat Flux over open ocean" standard_name="surface_downward_latent_heat_flux" unit="W/m2" /> 204 <field id="q hc_oce"long_name="Downward Heat Flux from E-P over open ocean" unit="W/m2" />204 <field id="qemp_oce" long_name="Downward Heat Flux from E-P over open ocean" unit="W/m2" /> 205 205 <field id="taum_oce" long_name="wind stress module over open ocean" standard_name="magnitude_of_surface_downward_stress" unit="N/m2" /> 206 206 207 <!-- available key_ coupled-->207 <!-- available key_oasis3 --> 208 208 <field id="snow_ao_cea" long_name="Snow over ice-free ocean (cell average)" standard_name="snowfall_flux" unit="kg/m2/s" /> 209 209 <field id="snow_ai_cea" long_name="Snow over sea-ice (cell average)" standard_name="snowfall_flux" unit="kg/m2/s" /> … … 212 212 <field id="calving_cea" long_name="Calving" standard_name="water_flux_into_sea_water_from_icebergs" unit="kg/m2/s" /> 213 213 214 <!-- available if key_ coupled+ conservative method -->214 <!-- available if key_oasis3 + conservative method --> 215 215 <field id="rain" long_name="Liquid precipitation" standard_name="rainfall_flux" unit="kg/m2/s" /> 216 216 <field id="evap_ao_cea" long_name="Evaporation over ice-free ocean (cell average)" standard_name="water_evaporation_flux" unit="kg/m2/s" /> … … 269 269 <field id="qns_ice" long_name="non-solar heat flux at ice surface: sum over categories" unit="W/m2" /> 270 270 <field id="qtr_ice" long_name="solar heat flux transmitted through ice: sum over categories" unit="W/m2" /> 271 <field id="qemp_ice" long_name="Downward Heat Flux from E-P over ice" unit="W/m2" /> 271 272 <field id="micesalt" long_name="Mean ice salinity" unit="1e-3" /> 272 273 <field id="miceage" long_name="Mean ice age" unit="years" /> … … 345 346 <field id="hfxdhc" long_name="Heat content variation in snow and ice" unit="W/m2" /> 346 347 <field id="hfxtur" long_name="turbulent heat flux at the ice base" unit="W/m2" /> 348 <!-- sbcssm variables --> 349 <field id="sst_m" unit="degC" /> 350 <field id="sss_m" unit="psu" /> 351 <field id="ssu_m" unit="m/s" /> 352 <field id="ssv_m" unit="m/s" /> 353 <field id="ssh_m" unit="m" /> 354 <field id="e3t_m" unit="m" /> 355 <field id="frq_m" unit="-" /> 356 347 357 </field_group> 348 358 … … 420 430 <field id="e3w" long_name="W-cell thickness" standard_name="cell_thickness" unit="m" /> 421 431 <field id="woce" long_name="ocean vertical velocity" standard_name="upward_sea_water_velocity" unit="m/s" /> 422 <field id="woce_e3w" long_name="ocean vertical velocity * e3v" unit="m2/s" > woce * e3w </field>423 432 <field id="wocetr_eff" long_name="effective ocean vertical transport" unit="m3/s" /> 424 433 -
trunk/NEMOGCM/CONFIG/SHARED/namelist_ref
r5397 r5407 220 220 !! namsbc_core CORE bulk formulae formulation 221 221 !! namsbc_mfs MFS bulk formulae formulation 222 !! namsbc_cpl CouPLed formulation ("key_ coupled")222 !! namsbc_cpl CouPLed formulation ("key_oasis3") 223 223 !! namsbc_sas StAndalone Surface module 224 224 !! namtra_qsr penetrative solar radiation … … 240 240 ln_blk_core = .true. ! CORE bulk formulation (T => fill namsbc_core) 241 241 ln_blk_mfs = .false. ! MFS bulk formulation (T => fill namsbc_mfs ) 242 ln_cpl = .false. ! atmosphere coupled formulation ( requires key_oasis3 ) 243 ln_mixcpl = .false. ! forced-coupled mixed formulation ( requires key_oasis3 ) 244 nn_components = 0 ! configuration of the opa-sas OASIS coupling 245 ! =0 no opa-sas OASIS coupling: default single executable configuration 246 ! =1 opa-sas OASIS coupling: multi executable configuration, OPA component 247 ! =2 opa-sas OASIS coupling: multi executable configuration, SAS component 242 248 ln_apr_dyn = .false. ! Patm gradient added in ocean & ice Eqs. (T => fill namsbc_apr ) 243 249 nn_ice = 2 ! =0 no ice boundary condition , … … 347 353 / 348 354 !----------------------------------------------------------------------- 349 &namsbc_cpl ! coupled ocean/atmosphere model ("key_ coupled")355 &namsbc_cpl ! coupled ocean/atmosphere model ("key_oasis3") 350 356 !----------------------------------------------------------------------- 351 357 ! ! description ! multiple ! vector ! vector ! vector ! … … 383 389 sn_sal = 'sas_grid_T' , 120 , 'sosaline' , .true. , .true. , 'yearly' , '' , '' , '' 384 390 sn_ssh = 'sas_grid_T' , 120 , 'sossheig' , .true. , .true. , 'yearly' , '' , '' , '' 385 386 ln_3d_uv = .true. ! specify whether we are supplying a 3D u,v field 391 sn_e3t = 'sas_grid_T' , 120 , 'e3t_m' , .true. , .true. , 'yearly' , '' , '' , '' 392 sn_frq = 'sas_grid_T' , 120 , 'frq_m' , .true. , .true. , 'yearly' , '' , '' , '' 393 394 ln_3d_uve = .true. ! specify whether we are supplying a 3D u,v and e3 field 395 ln_read_frq = .false. ! specify whether we must read frq or not 387 396 cn_dir = './' ! root directory for the location of the bulk files are 388 397 / … … 417 426 418 427 cn_dir = './' ! root directory for the location of the runoff files 419 ln_rnf_emp = .false. ! runoffs included into precipitation field (T) or into a file (F)420 428 ln_rnf_mouth = .true. ! specific treatment at rivers mouths 421 429 rn_hrnf = 15.e0 ! depth over which enhanced vertical mixing is used … … 949 957 ! = 1 add a tke source below the ML 950 958 ! = 2 add a tke source just at the base of the ML 951 ! = 3 as = 1 applied on HF part of the stress ("key_ coupled")959 ! = 3 as = 1 applied on HF part of the stress ("key_oasis3") 952 960 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 953 961 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML -
trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile
r2528 r5407 22 22 23 23 conv : $(OBJS) 24 @$(CC) $(OBJS) -o ../$@24 @$(CC) $(OBJS) -o0 ../$@ 25 25 26 26 main.o : main.c -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r5385 r5407 96 96 !! - fr_i : ice fraction 97 97 !! - tn_ice : sea-ice surface temperature 98 !! - alb_ice : sea-ice albedo (l k_cpl=T)98 !! - alb_ice : sea-ice albedo (ln_cpl=T) 99 99 !! 100 100 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 178 178 179 179 ! computation the solar flux at ocean surface 180 IF( l k_cpl ) THEN180 IF( ln_cpl ) THEN 181 181 zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 182 182 ELSE … … 202 202 ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area) 203 203 ! ! coupled mode: 204 IF( l k_cpl ) THEN204 IF( ln_cpl ) THEN 205 205 zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area) 206 206 & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice … … 252 252 !-----------------------------------------------! 253 253 254 IF( l k_cpl) THEN254 IF( ln_cpl) THEN 255 255 tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature 256 256 ht_i(:,:,1) = hicif(:,:) -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r5385 r5407 216 216 217 217 ! partial computation of the lead energy budget (qldif) 218 IF( l k_cpl ) THEN218 IF( ln_cpl ) THEN 219 219 qldif(ji,jj) = tms(ji,jj) * rdt_ice & 220 220 & * ( ( qsr_tot(ji,jj) - qsr_ice(ji,jj,1) * zfricp ) * ( 1.0 - thcm(ji,jj) ) & … … 288 288 CALL tab_2d_1d_2( nbpb, qns_ice_1d(1:nbpb) , qns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 289 289 CALL tab_2d_1d_2( nbpb, dqns_ice_1d(1:nbpb) , dqns_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 290 IF( .NOT. l k_cpl ) THEN290 IF( .NOT. ln_cpl ) THEN 291 291 CALL tab_2d_1d_2( nbpb, qla_ice_1d (1:nbpb) , qla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) 292 292 CALL tab_2d_1d_2( nbpb, dqla_ice_1d(1:nbpb) , dqla_ice(:,:,1), jpi, jpj, npb(1:nbpb) ) … … 333 333 CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) 334 334 CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) 335 IF( .NOT. l k_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj )335 IF( .NOT. ln_cpl ) CALL tab_1d_2d_2( nbpb, qla_ice(:,:,1), npb, qla_ice_1d(1:nbpb), jpi, jpj ) 336 336 ! 337 337 ENDIF … … 434 434 IF( iom_use('qsr_ai_cea' ) ) CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 435 435 IF( iom_use('qns_ai_cea' ) ) CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 436 IF( iom_use('qla_ai_cea' ) .AND. .NOT. l k_cpl ) &436 IF( iom_use('qla_ai_cea' ) .AND. .NOT. ln_cpl ) & 437 437 & CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 438 438 ! … … 557 557 IF(lwm) WRITE ( numoni, namicethd ) 558 558 559 IF( l k_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )559 IF( ln_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 560 560 ! 561 561 IF(lwp) THEN ! control print -
trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r5385 r5407 18 18 USE ice_2 19 19 USE limistate_2 20 USE sbc_oce, ONLY : l k_cpl20 USE sbc_oce, ONLY : ln_cpl 21 21 USE in_out_manager 22 22 USE lib_mpp ! MPP library … … 325 325 !---------------------------------------------------------------------- 326 326 327 IF ( .NOT. l k_cpl ) THEN ! duplicate the loop for performances issues327 IF ( .NOT. ln_cpl ) THEN ! duplicate the loop for performances issues 328 328 DO ji = kideb, kiut 329 329 sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r5202 r5407 117 117 118 118 ! basal temperature (considered at freezing point) 119 t_bo(:,:) = ( eos_fzp( tsn(:,:,1,jp_sal) ) + rt0 ) * tmask(:,:,1)119 t_bo(:,:) = ( eos_fzp( sss_m(:,:) ) + rt0 ) * tmask(:,:,1) 120 120 121 121 IF( ln_iceini ) THEN … … 127 127 DO jj = 1, jpj ! ice if sst <= t-freez + ttest 128 128 DO ji = 1, jpi 129 IF( ( tsn(ji,jj,1,jp_tem) - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN129 IF( ( sst_m(ji,jj) - ( t_bo(ji,jj) - rt0 ) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 130 130 zswitch(ji,jj) = 0._wp * tmask(ji,jj,1) ! no ice 131 131 ELSE -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r5202 r5407 91 91 !!------------------------------------------------------------------ 92 92 93 CALL wrk_alloc( jpi,jpj, zremap_flag ) ! integer94 CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) ! integer93 CALL wrk_alloc( jpi,jpj, zremap_flag ) 94 CALL wrk_alloc( jpi,jpj,jpl-1, zdonor ) 95 95 CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 96 96 CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice ) 97 97 CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) 98 98 CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax ) 99 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer99 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 100 100 CALL wrk_alloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 101 101 … … 128 128 rswitch = MAX( 0.0, SIGN( 1.0, a_i(ji,jj,jl) - epsi10 ) ) !0 if no ice and 1 if yes 129 129 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * rswitch 130 rswitch = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) ) !0 if no ice and 1 if yes130 rswitch = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) ) 131 131 zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 132 zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)132 IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) ! clem: useless IF statement? 133 133 END DO 134 134 END DO … … 172 172 ! 173 173 zhbnew(ii,ij,jl) = hi_max(jl) 174 IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN174 IF ( a_i_b(ii,ij,jl) > epsi10 .AND. a_i_b(ii,ij,jl+1) > epsi10 ) THEN 175 175 !interpolate between adjacent category growth rates 176 176 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / ( zht_i_b(ii,ij,jl+1) - zht_i_b(ii,ij,jl) ) 177 177 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) + zslope * ( hi_max(jl) - zht_i_b(ii,ij,jl) ) 178 ELSEIF 178 ELSEIF( a_i_b(ii,ij,jl) > epsi10) THEN 179 179 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl) 180 ELSEIF 180 ELSEIF( a_i_b(ii,ij,jl+1) > epsi10) THEN 181 181 zhbnew(ii,ij,jl) = hi_max(jl) + zdhice(ii,ij,jl+1) 182 182 ENDIF … … 187 187 ii = nind_i(ji) 188 188 ij = nind_j(ji) 189 IF( a_i(ii,ij,jl) > epsi10 .AND. ht_i(ii,ij,jl) >= zhbnew(ii,ij,jl) ) THEN 189 190 ! clem: we do not want ht_i to be too close to either HR or HL otherwise a division by nearly 0 is possible 191 ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 192 IF ( a_i(ii,ij,jl ) > epsi10 .AND. ht_i(ii,ij,jl ) > ( zhbnew(ii,ij,jl) - epsi10 ) ) THEN 190 193 zremap_flag(ii,ij) = 0 191 ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < = zhbnew(ii,ij,jl) ) THEN194 ELSEIF( a_i(ii,ij,jl+1) > epsi10 .AND. ht_i(ii,ij,jl+1) < ( zhbnew(ii,ij,jl) + epsi10 ) ) THEN 192 195 zremap_flag(ii,ij) = 0 193 196 ENDIF 194 197 195 198 !- 4.3 Check that each zhbnew does not exceed maximal values hi_max 199 IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 196 200 IF( zhbnew(ii,ij,jl) > hi_max(jl+1) ) zremap_flag(ii,ij) = 0 197 IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 201 ! clem bug: why is not the following instead? 202 !!IF( zhbnew(ii,ij,jl) < hi_max(jl-1) ) zremap_flag(ii,ij) = 0 203 !!IF( zhbnew(ii,ij,jl) > hi_max(jl ) ) zremap_flag(ii,ij) = 0 204 198 205 END DO 199 206 … … 219 226 DO jj = 1, jpj 220 227 DO ji = 1, jpi 221 zhb0(ji,jj) = hi_max(0) ! 0eme 222 zhb1(ji,jj) = hi_max(1) ! 1er 223 224 zhbnew(ji,jj,klbnd-1) = 0._wp 228 zhb0(ji,jj) = hi_max(0) 229 zhb1(ji,jj) = hi_max(1) 225 230 226 231 IF( a_i(ji,jj,kubnd) > epsi10 ) THEN 227 232 zhbnew(ji,jj,kubnd) = MAX( hi_max(kubnd-1), 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) ) 228 233 ELSE 229 zhbnew(ji,jj,kubnd) = hi_max(kubnd) 230 !!? clem bug: since hi_max(jpl)=99, this limit is very high 231 !!? but I think it is erased in fitline subroutine 234 !clem bug zhbnew(ji,jj,kubnd) = hi_max(kubnd) 235 zhbnew(ji,jj,kubnd) = hi_max(kubnd-1) ! not used anyway 236 ENDIF 237 238 ! clem: we do not want ht_i_b to be too close to either HR or HL otherwise a division by nearly 0 is possible 239 ! in lim_itd_fitline in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 240 IF ( zht_i_b(ji,jj,klbnd) < ( zhb0(ji,jj) + epsi10 ) ) THEN 241 zremap_flag(ji,jj) = 0 242 ELSEIF( zht_i_b(ji,jj,klbnd) > ( zhb1(ji,jj) - epsi10 ) ) THEN 243 zremap_flag(ji,jj) = 0 232 244 ENDIF 233 245 … … 248 260 249 261 IF( a_i(ii,ij,klbnd) > epsi10 ) THEN 262 250 263 zdh0 = zdhice(ii,ij,klbnd) !decrease of ice thickness in the lower category 251 IF( zdh0 < 0.0 ) THEN !remove area from category 1 264 265 IF( zdh0 < 0.0 ) THEN !remove area from category 1 252 266 zdh0 = MIN( -zdh0, hi_max(klbnd) ) 253 254 267 !Integrate g(1) from 0 to dh0 to estimate area melted 255 268 zetamax = MIN( zdh0, hR(ii,ij,klbnd) ) - hL(ii,ij,klbnd) 269 256 270 IF( zetamax > 0.0 ) THEN 257 zx1 = zetamax 258 zx2 = 0.5 * zetamax * zetamax 259 zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 !ice area removed 260 ! Constrain new thickness <= ht_i 261 zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! zdamax > 0 262 !ice area lost due to melting of thin ice 263 zda0 = MIN( zda0, zdamax ) 264 271 zx1 = zetamax 272 zx2 = 0.5 * zetamax * zetamax 273 zda0 = g1(ii,ij,klbnd) * zx2 + g0(ii,ij,klbnd) * zx1 ! ice area removed 274 zdamax = a_i(ii,ij,klbnd) * (1.0 - ht_i(ii,ij,klbnd) / zht_i_b(ii,ij,klbnd) ) ! Constrain new thickness <= ht_i 275 zda0 = MIN( zda0, zdamax ) ! ice area lost due to melting 276 ! of thin ice (zdamax > 0) 265 277 ! Remove area, conserving volume 266 278 ht_i(ii,ij,klbnd) = ht_i(ii,ij,klbnd) * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) … … 269 281 ENDIF 270 282 271 ELSE ! if ice accretion ! a_i > epsi10; zdh0 > 0 283 ELSE ! if ice accretion zdh0 > 0 284 ! zhbnew was 0, and is shifted to the right to account for thin ice growth in openwater (F0 = f1) 272 285 zhbnew(ii,ij,klbnd-1) = MIN( zdh0, hi_max(klbnd) ) 273 ! zhbnew was 0, and is shifted to the right to account for thin ice 274 ! growth in openwater (F0 = f1) 275 ENDIF ! zdh0 276 277 ENDIF ! a_i > epsi10 286 ENDIF 287 288 ENDIF 278 289 279 290 END DO … … 303 314 304 315 IF (zhbnew(ii,ij,jl) > hi_max(jl)) THEN ! transfer from jl to jl+1 305 306 316 ! left and right integration limits in eta space 307 317 zvetamin(ji) = MAX( hi_max(jl), hL(ii,ij,jl) ) - hL(ii,ij,jl) 308 zvetamax(ji) = MIN (zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl)318 zvetamax(ji) = MIN( zhbnew(ii,ij,jl), hR(ii,ij,jl) ) - hL(ii,ij,jl) 309 319 zdonor(ii,ij,jl) = jl 310 320 311 ELSE ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 312 321 ELSE ! zhbnew(jl) <= hi_max(jl) ; transfer from jl+1 to jl 313 322 ! left and right integration limits in eta space 314 323 zvetamin(ji) = 0.0 … … 316 325 zdonor(ii,ij,jl) = jl + 1 317 326 318 ENDIF ! zhbnew(jl) > hi_max(jl)327 ENDIF 319 328 320 329 zetamax = MAX( zvetamax(ji), zvetamin(ji) ) ! no transfer if etamax < etamin … … 333 342 334 343 END DO 335 END DO ! jl klbnd -> kubnd - 1344 END DO 336 345 337 346 !!---------------------------------------------------------------------------------------------- … … 375 384 ENDIF 376 385 377 CALL wrk_dealloc( jpi,jpj, zremap_flag ) ! integer378 CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) ! integer386 CALL wrk_dealloc( jpi,jpj, zremap_flag ) 387 CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor ) 379 388 CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_b, dummy_es ) 380 389 CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice ) 381 390 CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) 382 391 CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax ) 383 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer392 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 384 393 CALL wrk_dealloc( jpi,jpj, zhb0,zhb1,vt_i_init,vt_i_final,vt_s_init,vt_s_final,et_i_init,et_i_final,et_s_init,et_s_final ) 385 394 … … 406 415 INTEGER , DIMENSION(jpi,jpj), INTENT(in ) :: zremap_flag ! 407 416 ! 408 INTEGER :: ji,jj! horizontal indices417 INTEGER :: ji,jj ! horizontal indices 409 418 REAL(wp) :: zh13 ! HbL + 1/3 * (HbR - HbL) 410 419 REAL(wp) :: zh23 ! HbL + 2/3 * (HbR - HbL) … … 413 422 !!------------------------------------------------------------------ 414 423 ! 415 !416 424 DO jj = 1, jpj 417 425 DO ji = 1, jpi 418 426 ! 419 427 IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10 & 420 & .AND. hice(ji,jj) > 0._wp )THEN428 & .AND. hice(ji,jj) > 0._wp ) THEN 421 429 422 430 ! Initialize hL and hR 423 424 431 hL(ji,jj) = HbL(ji,jj) 425 432 hR(ji,jj) = HbR(ji,jj) 426 433 427 434 ! Change hL or hR if hice falls outside central third of range 428 429 435 zh13 = 1.0 / 3.0 * ( 2.0 * hL(ji,jj) + hR(ji,jj) ) 430 436 zh23 = 1.0 / 3.0 * ( hL(ji,jj) + 2.0 * hR(ji,jj) ) … … 435 441 436 442 ! Compute coefficients of g(eta) = g0 + g1*eta 437 438 443 zdhr = 1._wp / (hR(ji,jj) - hL(ji,jj)) 439 444 zwk1 = 6._wp * a_i(ji,jj,num_cat) * zdhr … … 442 447 g1(ji,jj) = 2._wp * zdhr * zwk1 * ( zwk2 - 0.5 ) 443 448 ! 444 ELSE 449 ELSE ! remap_flag = .false. or a_i < epsi10 445 450 hL(ji,jj) = 0._wp 446 451 hR(ji,jj) = 0._wp 447 452 g0(ji,jj) = 0._wp 448 453 g1(ji,jj) = 0._wp 449 ENDIF ! a_i > epsi10454 ENDIF 450 455 ! 451 456 END DO … … 471 476 472 477 INTEGER :: ji, jj, jl, jl2, jl1, jk ! dummy loop indices 473 INTEGER :: ii, ij ! indices when changing from 2D-1D is done478 INTEGER :: ii, ij ! indices when changing from 2D-1D is done 474 479 475 480 REAL(wp), POINTER, DIMENSION(:,:,:) :: zaTsfn … … 484 489 INTEGER, POINTER, DIMENSION(:) :: nind_i, nind_j ! compressed indices for i/j directions 485 490 486 INTEGER :: nbrem ! number of cells with ice to transfer 487 488 LOGICAL :: zdaice_negative ! true if daice < -puny 489 LOGICAL :: zdvice_negative ! true if dvice < -puny 490 LOGICAL :: zdaice_greater_aicen ! true if daice > aicen 491 LOGICAL :: zdvice_greater_vicen ! true if dvice > vicen 491 INTEGER :: nbrem ! number of cells with ice to transfer 492 492 !!------------------------------------------------------------------ 493 493 494 494 CALL wrk_alloc( jpi,jpj,jpl, zaTsfn ) 495 495 CALL wrk_alloc( jpi,jpj, zworka ) 496 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer496 CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 497 497 498 498 !---------------------------------------------------------------------------------------------- … … 504 504 END DO 505 505 506 !clem: I think the following is wrong (if enabled, it creates negative concentration/volume around -epsi10)507 ! !----------------------------------------------------------------------------------------------508 ! ! 2) Check for daice or dvice out of range, allowing for roundoff error509 ! !----------------------------------------------------------------------------------------------510 ! ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl511 ! ! has a small area, with h(n) very close to a boundary. Then512 ! ! the coefficients of g(h) are large, and the computed daice and513 ! ! dvice can be in error. If this happens, it is best to transfer514 ! ! either the entire category or nothing at all, depending on which515 ! ! side of the boundary hice(n) lies.516 ! !-----------------------------------------------------------------517 ! DO jl = klbnd, kubnd-1518 !519 ! zdaice_negative = .false.520 ! zdvice_negative = .false.521 ! zdaice_greater_aicen = .false.522 ! zdvice_greater_vicen = .false.523 !524 ! DO jj = 1, jpj525 ! DO ji = 1, jpi526 !527 ! IF (zdonor(ji,jj,jl) > 0) THEN528 ! jl1 = zdonor(ji,jj,jl)529 !530 ! IF (zdaice(ji,jj,jl) < 0.0) THEN531 ! IF (zdaice(ji,jj,jl) > -epsi10) THEN532 ! IF ( ( jl1 == jl .AND. ht_i(ji,jj,jl1) > hi_max(jl) ) .OR. &533 ! ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN534 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category535 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl1)536 ! ELSE537 ! zdaice(ji,jj,jl) = 0.0 ! shift no ice538 ! zdvice(ji,jj,jl) = 0.0539 ! ENDIF540 ! ELSE541 ! zdaice_negative = .true.542 ! ENDIF543 ! ENDIF544 !545 ! IF (zdvice(ji,jj,jl) < 0.0) THEN546 ! IF (zdvice(ji,jj,jl) > -epsi10 ) THEN547 ! IF ( ( jl1 == jl .AND. ht_i(ji,jj,jl1) > hi_max(jl) ) .OR. &548 ! ( jl1 == jl+1 .AND. ht_i(ji,jj,jl1) <= hi_max(jl) ) ) THEN549 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category550 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl1)551 ! ELSE552 ! zdaice(ji,jj,jl) = 0.0 ! shift no ice553 ! zdvice(ji,jj,jl) = 0.0554 ! ENDIF555 ! ELSE556 ! zdvice_negative = .true.557 ! ENDIF558 ! ENDIF559 !560 ! ! If daice is close to aicen, set daice = aicen.561 ! IF (zdaice(ji,jj,jl) > a_i(ji,jj,jl1) - epsi10 ) THEN562 ! IF (zdaice(ji,jj,jl) < a_i(ji,jj,jl1)+epsi10) THEN563 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl1)564 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl1)565 ! ELSE566 ! zdaice_greater_aicen = .true.567 ! ENDIF568 ! ENDIF569 !570 ! IF (zdvice(ji,jj,jl) > v_i(ji,jj,jl1)-epsi10) THEN571 ! IF (zdvice(ji,jj,jl) < v_i(ji,jj,jl1)+epsi10) THEN572 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl1)573 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl1)574 ! ELSE575 ! zdvice_greater_vicen = .true.576 ! ENDIF577 ! ENDIF578 !579 ! ENDIF ! donor > 0580 ! END DO581 ! END DO582 !583 ! END DO584 !clem585 506 !------------------------------------------------------------------------------- 586 ! 3) Transfer volume and energy between categories507 ! 2) Transfer volume and energy between categories 587 508 !------------------------------------------------------------------------------- 588 509 … … 604 525 605 526 jl1 = zdonor(ii,ij,jl) 606 rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi 20 ) )607 zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi 20 ) * rswitch527 rswitch = MAX( 0._wp , SIGN( 1._wp , v_i(ii,ij,jl1) - epsi10 ) ) 528 zworka(ii,ij) = zdvice(ii,ij,jl) / MAX( v_i(ii,ij,jl1), epsi10 ) * rswitch 608 529 IF( jl1 == jl) THEN ; jl2 = jl1+1 609 530 ELSE ; jl2 = jl … … 613 534 ! Ice areas 614 535 !-------------- 615 616 536 a_i(ii,ij,jl1) = a_i(ii,ij,jl1) - zdaice(ii,ij,jl) 617 537 a_i(ii,ij,jl2) = a_i(ii,ij,jl2) + zdaice(ii,ij,jl) … … 620 540 ! Ice volumes 621 541 !-------------- 622 623 542 v_i(ii,ij,jl1) = v_i(ii,ij,jl1) - zdvice(ii,ij,jl) 624 543 v_i(ii,ij,jl2) = v_i(ii,ij,jl2) + zdvice(ii,ij,jl) … … 627 546 ! Snow volumes 628 547 !-------------- 629 630 548 zdvsnow = v_s(ii,ij,jl1) * zworka(ii,ij) 631 549 v_s(ii,ij,jl1) = v_s(ii,ij,jl1) - zdvsnow … … 635 553 ! Snow heat content 636 554 !-------------------- 637 638 555 zdesnow = e_s(ii,ij,1,jl1) * zworka(ii,ij) 639 556 e_s(ii,ij,1,jl1) = e_s(ii,ij,1,jl1) - zdesnow … … 643 560 ! Ice age 644 561 !-------------- 645 646 562 zdo_aice = oa_i(ii,ij,jl1) * zdaice(ii,ij,jl) 647 563 oa_i(ii,ij,jl1) = oa_i(ii,ij,jl1) - zdo_aice … … 651 567 ! Ice salinity 652 568 !-------------- 653 654 569 zdsm_vice = smv_i(ii,ij,jl1) * zworka(ii,ij) 655 570 smv_i(ii,ij,jl1) = smv_i(ii,ij,jl1) - zdsm_vice … … 659 574 ! Surface temperature 660 575 !--------------------- 661 662 576 zdaTsf = t_su(ii,ij,jl1) * zdaice(ii,ij,jl) 663 577 zaTsfn(ii,ij,jl1) = zaTsfn(ii,ij,jl1) - zdaTsf … … 710 624 CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn ) 711 625 CALL wrk_dealloc( jpi,jpj, zworka ) 712 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) ! integer626 CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j ) 713 627 ! 714 628 END SUBROUTINE lim_itd_shiftice … … 859 773 ENDIF 860 774 ! 861 CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) ! interger775 CALL wrk_dealloc( jpi,jpj,jpl, zdonor ) 862 776 CALL wrk_dealloc( jpi,jpj,jpl, zdaice, zdvice ) 863 777 CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5187 r5407 30 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 31 USE sbccpl 32 USE oce , ONLY : fraqsr_1lev,sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass32 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 33 33 USE albedo ! albedo parameters 34 34 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 94 94 !! - fr_i : ice fraction 95 95 !! - tn_ice : sea-ice surface temperature 96 !! - alb_ice : sea-ice albedo ( lk_cpl=T)96 !! - alb_ice : sea-ice albedo (only useful in coupled mode) 97 97 !! 98 98 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 101 101 !! The ref should be Rousset et al., 2015 102 102 !!--------------------------------------------------------------------- 103 INTEGER, INTENT(in) :: kt ! number of iteration 104 INTEGER :: ji, jj, jl, jk ! dummy loop indices 105 REAL(wp) :: zemp ! local scalars 106 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 107 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 103 INTEGER, INTENT(in) :: kt ! number of iteration 104 INTEGER :: ji, jj, jl, jk ! dummy loop indices 105 REAL(wp) :: zqmass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 106 REAL(wp) :: zqsr ! New solar flux received by the ocean 108 107 ! 109 108 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace … … 111 110 112 111 ! make calls for heat fluxes before it is modified 113 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 114 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 115 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 116 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 117 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 118 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 119 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 112 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr_oce(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 113 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns_oce(:,:) * pfrld(:,:) + qemp_oce(:,:) ) ! non-solar flux at ocean surface 114 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 115 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 116 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 117 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr_oce(:,:) + qns_oce(:,:) ) * pfrld(:,:) + qemp_oce(:,:) ) 118 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) & 119 & * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) 120 IF( iom_use('qemp_oce' ) ) CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 121 IF( iom_use('qemp_ice' ) ) CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 120 122 121 123 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) … … 126 128 ! heat flux at the ocean surface ! 127 129 !------------------------------------------! 128 ! Solar heat flux reaching the ocean = z fcm1(W.m-2)130 ! Solar heat flux reaching the ocean = zqsr (W.m-2) 129 131 !--------------------------------------------------- 130 IF( lk_cpl ) THEN 131 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 132 zfcm1 = qsr_tot(ji,jj) 133 DO jl = 1, jpl 134 zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 135 END DO 136 ELSE 137 !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 138 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 139 DO jl = 1, jpl 140 zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 141 END DO 142 ENDIF 132 zqsr = qsr_tot(ji,jj) 133 DO jl = 1, jpl 134 zqsr = zqsr - a_i_b(ji,jj,jl) * ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) 135 END DO 143 136 144 137 ! Total heat flux reaching the ocean = hfx_out (W.m-2) 145 138 !--------------------------------------------------- 146 z f_mass= hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC)147 hfx_out(ji,jj) = hfx_out(ji,jj) + z f_mass + zfcm1139 zqmass = hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) ! heat flux from snow is 0 (T=0 degC) 140 hfx_out(ji,jj) = hfx_out(ji,jj) + zqmass + zqsr 148 141 149 142 ! Add the residual from heat diffusion equation (W.m-2) … … 153 146 ! New qsr and qns used to compute the oceanic heat flux at the next time step 154 147 !--------------------------------------------------- 155 qsr(ji,jj) = z fcm1156 qns(ji,jj) = hfx_out(ji,jj) - z fcm1148 qsr(ji,jj) = zqsr 149 qns(ji,jj) = hfx_out(ji,jj) - zqsr 157 150 158 151 !------------------------------------------! … … 167 160 ! Even if i see Ice melting as a FW and SALT flux 168 161 ! 169 ! computing freshwater exchanges at the ice/ocean interface170 IF( lk_cpl ) THEN171 zemp = emp_tot(ji,jj) & ! net mass flux over grid cell172 & - emp_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! minus the mass flux intercepted by sea ice173 & + sprecip(ji,jj) * ( pfrld(ji,jj) - pfrld(ji,jj)**rn_betas ) !174 ELSE175 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction176 & - tprecip(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! all precipitation reach the ocean177 & + sprecip(ji,jj) * ( 1._wp - pfrld(ji,jj)**rn_betas ) ! except solid precip intercepted by sea-ice178 ENDIF179 180 162 ! mass flux from ice/ocean 181 163 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & … … 184 166 ! mass flux at the ocean/ice interface 185 167 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice ! F/M mass flux save at least for biogeochemical model 186 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj)! mass flux + F/M mass flux (always ice/ocean mass exchange)168 emp(ji,jj) = emp_oce(ji,jj) - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 187 169 188 170 END DO … … 213 195 tn_ice(:,:,:) = t_su(:,:,:) ! Ice surface temperature 214 196 215 !------------------------------------------------! 216 ! Snow/ice albedo (only if sent to coupler) ! 217 !------------------------------------------------! 218 IF( lk_cpl ) THEN ! coupled case 219 220 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 221 222 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 223 224 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 225 226 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 227 228 ENDIF 197 !------------------------------------------------------------------------! 198 ! Snow/ice albedo (only if sent to coupler, useless in forced mode) ! 199 !------------------------------------------------------------------------! 200 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 201 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 202 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 203 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 229 204 230 205 ! conservation test … … 346 321 sice_0(:,:) = 2._wp 347 322 END WHERE 348 ENDIF349 350 IF( .NOT. ln_rstart ) THEN351 fraqsr_1lev(:,:) = 1._wp352 323 ENDIF 353 324 ! -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5385 r5407 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE oce , ONLY : fraqsr_1lev25 24 USE ice ! LIM: sea-ice variables 26 25 USE sbc_oce ! Surface boundary condition: ocean fields … … 28 27 USE thd_ice ! LIM thermodynamic sea-ice variables 29 28 USE dom_ice ! LIM sea-ice domain 30 USE domvvl ! domain: variable volume level31 29 USE limthd_dif ! LIM: thermodynamics, vertical diffusion 32 30 USE limthd_dh ! LIM: thermodynamics, ice and snow thickness variation … … 50 48 PRIVATE 51 49 52 PUBLIC lim_thd ! called by limstp module53 PUBLIC lim_thd_init ! called by sbc_lim_init50 PUBLIC lim_thd ! called by limstp module 51 PUBLIC lim_thd_init ! called by sbc_lim_init 54 52 55 53 !! * Substitutions … … 92 90 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 93 91 ! 94 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns95 92 !!------------------------------------------------------------------- 96 CALL wrk_alloc( jpi,jpj, zqsr, zqns )97 93 98 94 IF( nn_timing == 1 ) CALL timing_start('limthd') … … 136 132 ! 2) Partial computation of forcing for the thermodynamic sea ice model. ! 137 133 !-----------------------------------------------------------------------------! 138 139 !--- Ocean solar and non solar fluxes to be used in zqld140 IF ( .NOT. lk_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean141 !142 zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:)143 !144 ELSE ! --- coupled case, fluxes to the lead are total - intercepted145 !146 zqsr(:,:) = qsr_tot(:,:) ; zqns(:,:) = qns_tot(:,:)147 !148 DO jl = 1, jpl149 DO jj = 1, jpj150 DO ji = 1, jpi151 zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * a_i_b(ji,jj,jl)152 zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * a_i_b(ji,jj,jl)153 END DO154 END DO155 END DO156 !157 ENDIF158 159 134 DO jj = 1, jpj 160 135 DO ji = 1, jpi … … 167 142 ! ! temperature and turbulent mixing (McPhee, 1992) 168 143 ! 169 170 144 ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 171 ! REMARK valid at least in forced mode from clem 172 ! precip is included in qns but not in qns_ice 173 IF ( lk_cpl ) THEN 174 zqld = tmask(ji,jj,1) * rdt_ice * & 175 & ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) & ! pfrld already included in coupled mode 176 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 177 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 178 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 179 ELSE 180 zqld = tmask(ji,jj,1) * rdt_ice * & 181 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) & 182 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 183 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 184 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) ) 185 ENDIF 145 zqld = tmask(ji,jj,1) * rdt_ice * & 146 & ( pfrld(ji,jj) * qsr_oce(ji,jj) * frq_m(ji,jj) + pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 186 147 187 148 ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! … … 210 171 ! Net heat flux on top of ice-ocean [W.m-2] 211 172 ! ----------------------------------------- 212 ! heat flux at the ocean surface + precip 213 ! + heat flux at the ice surface 214 hfx_in(ji,jj) = hfx_in(ji,jj) & 215 ! heat flux above the ocean 216 & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) & 217 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 218 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 219 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) & 220 ! heat flux above the ice 221 & + SUM( a_i_b(ji,jj,:) * ( qns_ice(ji,jj,:) + qsr_ice(ji,jj,:) ) ) 173 hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj) 222 174 223 175 ! ----------------------------------------------------------------------------- 224 ! Net heat flux that is retroceded to the ocean or taken from the ocean[W.m-2]176 ! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2] 225 177 ! ----------------------------------------------------------------------------- 226 178 ! First step here : non solar + precip - qlead - qturb 227 179 ! Second step in limthd_dh : heat remaining if total melt (zq_rema) 228 180 ! Third step in limsbc : heat from ice-ocean mass exchange (zf_mass) + solar 229 hfx_out(ji,jj) = hfx_out(ji,jj) & 230 ! Non solar heat flux received by the ocean 231 & + pfrld(ji,jj) * zqns(ji,jj) & 232 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 233 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) & 234 & * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 235 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) & 236 ! heat flux taken from the ocean where there is open water ice formation 237 & - qlead(ji,jj) * r1_rdtice & 238 ! heat flux taken from the ocean during bottom growth/melt (fhld should be 0 while bott growth) 239 & - at_i(ji,jj) * fhtur(ji,jj) & 240 & - at_i(ji,jj) * fhld(ji,jj) 241 181 hfx_out(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + qemp_oce(ji,jj) & ! Non solar heat flux received by the ocean 182 & - qlead(ji,jj) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation 183 & - at_i(ji,jj) * fhtur(ji,jj) & ! heat flux taken by turbulence 184 & - at_i(ji,jj) * fhld(ji,jj) ! heat flux taken during bottom growth/melt 185 ! (fhld should be 0 while bott growth) 242 186 END DO 243 187 END DO … … 412 356 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 413 357 414 CALL wrk_dealloc( jpi,jpj, zqsr, zqns )415 416 358 !------------------------------------------------------------------------------| 417 359 ! 6) Transport of ice between thickness categories. | … … 472 414 END SUBROUTINE lim_thd 473 415 416 474 417 SUBROUTINE lim_thd_temp( kideb, kiut ) 475 418 !!----------------------------------------------------------------------- … … 570 513 END DO 571 514 572 CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:), jpi, jpj, npb(1:nbpb) )515 CALL tab_2d_1d( nbpb, qprec_ice_1d(1:nbpb), qprec_ice(:,:) , jpi, jpj, npb(1:nbpb) ) 573 516 CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 574 517 CALL tab_2d_1d( nbpb, fr1_i0_1d (1:nbpb), fr1_i0 , jpi, jpj, npb(1:nbpb) ) … … 576 519 CALL tab_2d_1d( nbpb, qns_ice_1d (1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 577 520 CALL tab_2d_1d( nbpb, ftr_ice_1d (1:nbpb), ftr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 578 IF( .NOT. lk_cpl ) THEN 579 CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) ) 580 CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 581 ENDIF 521 CALL tab_2d_1d( nbpb, evap_ice_1d (1:nbpb), evap_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 582 522 CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl), jpi, jpj, npb(1:nbpb) ) 583 523 CALL tab_2d_1d( nbpb, t_bo_1d (1:nbpb), t_bo , jpi, jpj, npb(1:nbpb) ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r5202 r5407 29 29 PRIVATE 30 30 31 PUBLIC lim_thd_dh ! called by lim_thd 31 PUBLIC lim_thd_dh ! called by lim_thd 32 PUBLIC lim_thd_snwblow ! called in sbcblk/sbccpl and here 33 34 INTERFACE lim_thd_snwblow 35 MODULE PROCEDURE lim_thd_snwblow_1d, lim_thd_snwblow_2d 36 END INTERFACE 32 37 33 38 !!---------------------------------------------------------------------- … … 71 76 REAL(wp) :: zfdum 72 77 REAL(wp) :: zfracs ! fractionation coefficient for bottom salt entrapment 73 REAL(wp) :: zcoeff ! dummy argument for snowfall partitioning over ice and leads 74 REAL(wp) :: zs_snic ! snow-ice salinity 78 REAL(wp) :: zs_snic ! snow-ice salinity 75 79 REAL(wp) :: zswi1 ! switch for computation of bottom salinity 76 80 REAL(wp) :: zswi12 ! switch for computation of bottom salinity … … 103 107 REAL(wp), POINTER, DIMENSION(:) :: zqh_s ! total snow heat content (J.m-2) 104 108 REAL(wp), POINTER, DIMENSION(:) :: zq_s ! total snow enthalpy (J.m-3) 109 REAL(wp), POINTER, DIMENSION(:) :: zsnw ! distribution of snow after wind blowing 105 110 106 111 REAL(wp) :: zswitch_sal … … 118 123 119 124 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 120 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )125 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s, zsnw ) 121 126 CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 122 127 CALL wrk_alloc( jpij, nlay_i, icount ) … … 219 224 220 225 zdeltah(:,:) = 0._wp 226 CALL lim_thd_snwblow( 1. - at_i_1d, zsnw ) ! snow distribution over ice after wind blowing 221 227 DO ji = kideb, kiut 222 228 !----------- … … 224 230 !----------- 225 231 ! thickness change 226 zcoeff = ( 1._wp - ( 1._wp - at_i_1d(ji) )**rn_betas ) / at_i_1d(ji) 227 zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice * r1_rhosn 228 ! enthalpy of the precip (>0, J.m-3) (tatm_ice is now in K) 229 zqprec (ji) = rhosn * ( cpic * ( rt0 - MIN( tatm_ice_1d(ji), rt0_snow) ) + lfus ) 232 zdh_s_pre(ji) = zsnw(ji) * sprecip_1d(ji) * rdt_ice * r1_rhosn / at_i_1d(ji) 233 ! enthalpy of the precip (>0, J.m-3) 234 zqprec (ji) = - qprec_ice_1d(ji) 230 235 IF( sprecip_1d(ji) == 0._wp ) zqprec(ji) = 0._wp 231 236 ! heat flux from snow precip (>0, W.m-2) … … 280 285 ! clem comment: ice should also sublimate 281 286 zdeltah(:,:) = 0._wp 282 IF( lk_cpl ) THEN 283 ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) 284 zdh_s_sub(:) = 0._wp 285 ELSE 286 ! forced mode: snow thickness change due to sublimation 287 DO ji = kideb, kiut 288 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 289 ! Heat flux by sublimation [W.m-2], < 0 290 ! sublimate first snow that had fallen, then pre-existing snow 291 zdeltah(ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 292 hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1) & 293 & ) * a_i_1d(ji) * r1_rdtice 294 ! Mass flux by sublimation 295 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 296 ! new snow thickness 297 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 298 ! update precipitations after sublimation and correct sublimation 299 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 300 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 301 END DO 302 ENDIF 303 287 ! coupled mode: sublimation is set to 0 (evap_ice = 0) until further notice 288 ! forced mode: snow thickness change due to sublimation 289 DO ji = kideb, kiut 290 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - evap_ice_1d(ji) * r1_rhosn * rdt_ice ) 291 ! Heat flux by sublimation [W.m-2], < 0 292 ! sublimate first snow that had fallen, then pre-existing snow 293 zdeltah(ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 294 hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1) & 295 & ) * a_i_1d(ji) * r1_rdtice 296 ! Mass flux by sublimation 297 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 298 ! new snow thickness 299 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 300 ! update precipitations after sublimation and correct sublimation 301 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 302 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 303 END DO 304 304 305 ! --- Update snow diags --- ! 305 306 DO ji = kideb, kiut … … 689 690 690 691 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 691 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s )692 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s, zsnw ) 692 693 CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 693 694 CALL wrk_dealloc( jpij, nlay_i, icount ) … … 695 696 ! 696 697 END SUBROUTINE lim_thd_dh 698 699 700 !!-------------------------------------------------------------------------- 701 !! INTERFACE lim_thd_snwblow 702 !! ** Purpose : Compute distribution of precip over the ice 703 !!-------------------------------------------------------------------------- 704 SUBROUTINE lim_thd_snwblow_2d( pin, pout ) 705 REAL(wp), DIMENSION(:,:), INTENT(in) :: pin ! previous fraction lead ( pfrld or (1. - a_i_b) ) 706 REAL(wp), DIMENSION(:,:), INTENT(out) :: pout 707 pout = ( 1._wp - ( pin )**rn_betas ) 708 END SUBROUTINE lim_thd_snwblow_2d 709 710 SUBROUTINE lim_thd_snwblow_1d( pin, pout ) 711 REAL(wp), DIMENSION(:), INTENT(in) :: pin 712 REAL(wp), DIMENSION(:), INTENT(out) :: pout 713 pout = ( 1._wp - ( pin )**rn_betas ) 714 END SUBROUTINE lim_thd_snwblow_1d 715 697 716 698 717 #else -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5385 r5407 24 24 USE wrk_nemo ! work arrays 25 25 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 26 USE sbc_oce, ONLY : lk_cpl27 26 28 27 IMPLICIT NONE … … 745 744 !-------------------------------------------------------------------------! 746 745 DO ji = kideb, kiut 747 ! forced mode only : update of latent heat fluxes (sublimation) (always >=0, upward flux)748 IF( .NOT. lk_cpl) qla_ice_1d (ji) = MAX( 0._wp, qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_1d(ji) - ztsub(ji) ) )749 746 ! ! surface ice conduction flux 750 747 isnow(ji) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_1d(ji) ) ) -
trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r5202 r5407 176 176 CALL iom_put( "utau_ice" , utau_ice ) ! wind stress over ice along i-axis at I-point 177 177 CALL iom_put( "vtau_ice" , vtau_ice ) ! wind stress over ice along j-axis at I-point 178 CALL iom_put( "snowpre" , sprecip 178 CALL iom_put( "snowpre" , sprecip * 86400. ) ! snow precipitation 179 179 CALL iom_put( "micesalt" , smt_i ) ! mean ice salinity 180 180 … … 232 232 CALL iom_put ('hfxdif' , hfx_dif(:,:) ) ! 233 233 CALL iom_put ('hfxopw' , hfx_opw(:,:) ) ! 234 CALL iom_put ('hfxtur' , fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base234 CALL iom_put ('hfxtur' , fhtur(:,:) * SUM(a_i_b(:,:,:), dim=3) ) ! turbulent heat flux at ice base 235 235 CALL iom_put ('hfxdhc' , diag_heat(:,:) ) ! Heat content variation in snow and ice 236 236 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip -
trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r5167 r5407 89 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d !: <==> the 2D fhld 90 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qla_ice_1d !: <==> the 2D qla_ice 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqla_ice_1d !: <==> the 2D dqla_ice 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: tatm_ice_1d !: <==> the 2D tatm_ice 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: evap_ice_1d !: <==> the 2D evap_ice 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qprec_ice_1d !: <==> the 2D qprec_ice 94 93 ! ! to reintegrate longwave flux inside the ice thermodynamics 95 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice … … 153 152 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) , & 154 153 & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) , & 155 & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,&156 & tatm_ice_1d(jpij), i0 (jpij) , &154 & dqns_ice_1d(jpij) , evap_ice_1d (jpij), & 155 & qprec_ice_1d(jpij), i0 (jpij) , & 157 156 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), & 158 157 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & -
trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r5215 r5407 152 152 !!---------------------------------------------------------------------- 153 153 cltxt = '' 154 cxios_context = 'nemo' 154 155 ! 155 156 ! ! Open reference namelist and configuration namelist files … … 182 183 #if defined key_iomput 183 184 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) 184 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection185 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 185 186 #else 186 187 ilocal_comm = 0 187 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)188 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 188 189 #endif 189 190 -
trunk/NEMOGCM/NEMO/OOO_SRC/nemogcm.F90
r5120 r5407 133 133 ! 134 134 cltxt = '' 135 cxios_context = 'nemo' 135 136 ! 136 137 ! ! Open reference namelist and configuration namelist files … … 162 163 #if defined key_iomput 163 164 IF( Agrif_Root() ) THEN 164 IF( lk_ cpl) THEN165 IF( lk_oasis ) THEN 165 166 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 166 167 CALL xios_initialize( "oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios 167 168 ELSE 168 CALL xios_initialize( " nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios169 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 169 170 ENDIF 170 171 ENDIF 171 172 ENDIF 172 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection173 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 173 174 #else 174 IF( lk_ cpl) THEN175 IF( lk_oasis ) THEN 175 176 IF( Agrif_Root() ) THEN 176 177 CALL cpl_init( ilocal_comm ) ! nemo local communicator given by oasis 177 178 ENDIF 178 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)179 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 179 180 ELSE 180 181 ilocal_comm = 0 181 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)182 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 182 183 ENDIF 183 184 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5217 r5407 593 593 ENDIF 594 594 595 IF( .NOT. l k_cpl ) THEN595 IF( .NOT. ln_cpl ) THEN 596 596 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 597 597 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 602 602 ENDIF 603 603 604 IF( l k_cpl .AND. nn_ice <= 1 ) THEN604 IF( ln_cpl .AND. nn_ice <= 1 ) THEN 605 605 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 606 606 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 625 625 #endif 626 626 627 IF( l k_cpl .AND. nn_ice == 2 ) THEN627 IF( ln_cpl .AND. nn_ice == 2 ) THEN 628 628 CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice 629 629 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 780 780 ENDIF 781 781 782 IF( .NOT. l k_cpl ) THEN782 IF( .NOT. ln_cpl ) THEN 783 783 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 784 784 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping … … 786 786 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 787 787 ENDIF 788 IF( l k_cpl .AND. nn_ice <= 1 ) THEN788 IF( ln_cpl .AND. nn_ice <= 1 ) THEN 789 789 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 790 790 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping … … 802 802 #endif 803 803 804 IF( l k_cpl .AND. nn_ice == 2 ) THEN804 IF( ln_cpl .AND. nn_ice == 2 ) THEN 805 805 CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature 806 806 CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo -
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r5120 r5407 98 98 ! 99 99 CALL wrk_alloc( jpi , jpj+2, zwu ) 100 CALL wrk_alloc( jpi+4, jpj , zwv, k jstart = -1 )100 CALL wrk_alloc( jpi+4, jpj , zwv, kistart = -1 ) 101 101 ! 102 102 IF( kt == nit000 ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r5363 r5407 149 149 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. ln_ctl 150 150 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 151 CHARACTER(lc) :: cxios_context !: context name used in xios 151 152 152 153 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5385 r5407 121 121 CALL set_scalar 122 122 123 IF( TRIM(cdname) == "nemo") THEN123 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 124 124 CALL set_grid( "T", glamt, gphit ) 125 125 CALL set_grid( "U", glamu, gphiu ) … … 129 129 ENDIF 130 130 131 IF( TRIM(cdname) == "nemo_crs" ) THEN131 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 132 132 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 133 133 ! … … 1212 1212 CALL iom_swap( cdname ) ! swap to cdname context 1213 1213 CALL xios_update_calendar(kt) 1214 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1214 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1215 1215 ! 1216 1216 END SUBROUTINE iom_setkt … … 1222 1222 CALL iom_swap( cdname ) ! swap to cdname context 1223 1223 CALL xios_context_finalize() ! finalize the context 1224 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1224 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1225 1225 ENDIF 1226 1226 ! … … 1291 1291 CASE ('T', 'W') 1292 1292 icnr = -1 ; jcnr = -1 1293 IF( TRIM(cdname) == "nemo_crs" ) THEN1293 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 1294 1294 z_cnr(:,:,1) = gphif_crs ; z_cnr(:,:,2) = glamf_crs 1295 1295 z_pnt(:,:,1) = gphit_crs ; z_pnt(:,:,2) = glamt_crs … … 1300 1300 CASE ('U') 1301 1301 icnr = 0 ; jcnr = -1 1302 IF( TRIM(cdname) == "nemo_crs" ) THEN1302 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 1303 1303 z_cnr(:,:,1) = gphiv_crs ; z_cnr(:,:,2) = glamv_crs 1304 1304 z_pnt(:,:,1) = gphiu_crs ; z_pnt(:,:,2) = glamu_crs … … 1309 1309 CASE ('V') 1310 1310 icnr = -1 ; jcnr = 0 1311 IF( TRIM(cdname) == "nemo_crs" ) THEN1311 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 1312 1312 z_cnr(:,:,1) = gphiu_crs ; z_cnr(:,:,2) = glamu_crs 1313 1313 z_pnt(:,:,1) = gphiv_crs ; z_pnt(:,:,2) = glamv_crs -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5341 r5407 24 24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 25 25 USE divcur ! hor. divergence and curl (div & cur routines) 26 USE sbc_ice, ONLY : lk_lim327 26 28 27 IMPLICIT NONE … … 135 134 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 136 135 ! 137 IF( lk_lim3 ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )138 !139 136 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields 140 137 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn ) … … 148 145 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 149 146 #endif 150 IF( lk_lim3 ) THEN151 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif152 ENDIF153 147 IF( kt == nitrst ) THEN 154 148 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 236 230 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 237 231 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 238 IF( lk_lim3 ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )239 232 ELSE 240 233 neuler = 0 … … 279 272 ENDIF 280 273 281 IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN282 DO jk = 1, jpk283 fse3t_b(:,:,jk) = fse3t_n(:,:,jk)284 END DO285 ENDIF286 287 ENDIF288 !289 IF( lk_lim3 ) THEN290 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )291 274 ENDIF 292 275 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4990 r5407 164 164 165 165 166 FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )166 FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 167 167 !!---------------------------------------------------------------------- 168 168 !! *** routine mynode *** … … 171 171 !!---------------------------------------------------------------------- 172 172 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt 173 CHARACTER(len=*) , INTENT(in ) :: ldname 173 174 INTEGER , INTENT(in ) :: kumnam_ref ! logical unit for reference namelist 174 175 INTEGER , INTENT(in ) :: kumnam_cfg ! logical unit for configuration namelist … … 297 298 298 299 IF( mynode == 0 ) THEN 299 CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )300 WRITE(kumond, nammpp)300 CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 301 WRITE(kumond, nammpp) 301 302 ENDIF 302 303 ! … … 3192 3193 END FUNCTION lib_mpp_alloc 3193 3194 3194 FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg, kumond , kstop, localComm ) RESULT (function_value)3195 FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg, kumond , kstop, localComm ) RESULT (function_value) 3195 3196 INTEGER, OPTIONAL , INTENT(in ) :: localComm 3196 3197 CHARACTER(len=*),DIMENSION(:) :: ldtxt 3198 CHARACTER(len=*) :: ldname 3197 3199 INTEGER :: kumnam_ref, knumnam_cfg , kumond , kstop 3198 3200 IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) ) function_value = 0 3199 3201 IF( .FALSE. ) ldtxt(:) = 'never done' 3200 CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )3202 CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 3201 3203 END FUNCTION mynode 3202 3204 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r4990 r5407 15 15 !!---------------------------------------------------------------------- 16 16 !!---------------------------------------------------------------------- 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT 18 !! 'key_oa3mct_v3' to be added for OASIS3-MCT version 3 18 19 !!---------------------------------------------------------------------- 19 20 !! cpl_init : initialization of coupled mode communication … … 61 62 #endif 62 63 63 INTEGER, PUBLIC, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 64 INTEGER :: nrcv ! total number of fields received 65 INTEGER :: nsnd ! total number of fields sent 66 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 67 INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields 64 68 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 65 69 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields … … 86 90 CONTAINS 87 91 88 SUBROUTINE cpl_init( kl_comm )92 SUBROUTINE cpl_init( cd_modname, kl_comm ) 89 93 !!------------------------------------------------------------------- 90 94 !! *** ROUTINE cpl_init *** … … 95 99 !! ** Method : OASIS3 MPI communication 96 100 !!-------------------------------------------------------------------- 97 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 101 CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file 102 INTEGER , INTENT(out) :: kl_comm ! local communicator of the model 98 103 !!-------------------------------------------------------------------- 99 104 … … 104 109 ! 1st Initialize the OASIS system for the application 105 110 !------------------------------------------------------------------ 106 CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror )111 CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 107 112 IF ( nerror /= OASIS_Ok ) & 108 113 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') … … 144 149 IF(lwp) WRITE(numout,*) 145 150 151 ncplmodel = kcplmodel 146 152 IF( kcplmodel > nmaxcpl ) THEN 147 CALL oasis_abort ( ncomp_id, 'cpl_define', ' kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN153 CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 148 154 ENDIF 155 156 nrcv = krcv 157 IF( nrcv > nmaxfld ) THEN 158 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN 159 ENDIF 160 161 nsnd = ksnd 162 IF( nsnd > nmaxfld ) THEN 163 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN 164 ENDIF 165 149 166 ! 150 167 ! ... Define the shape for the area that excludes the halo … … 400 417 401 418 402 INTEGER FUNCTION cpl_freq( kid)419 INTEGER FUNCTION cpl_freq( cdfieldname ) 403 420 !!--------------------------------------------------------------------- 404 421 !! *** ROUTINE cpl_freq *** … … 406 423 !! ** Purpose : - send back the coupling frequency for a particular field 407 424 !!---------------------------------------------------------------------- 408 INTEGER,INTENT(in) :: kid ! variable index 409 !! 425 CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file 426 !! 427 INTEGER :: id 410 428 INTEGER :: info 411 429 INTEGER, DIMENSION(1) :: itmp 430 INTEGER :: ji,jm ! local loop index 431 INTEGER :: mop 412 432 !!---------------------------------------------------------------------- 413 CALL oasis_get_freqs(kid, 1, itmp, info) 414 cpl_freq = itmp(1) 433 cpl_freq = 0 ! defaut definition 434 id = -1 ! defaut definition 435 ! 436 DO ji = 1, nsnd 437 IF (ssnd(ji)%laction ) THEN 438 DO jm = 1, ncplmodel 439 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 440 IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 441 id = ssnd(ji)%nid(1,jm) 442 mop = OASIS_Out 443 ENDIF 444 ENDIF 445 ENDDO 446 ENDIF 447 ENDDO 448 DO ji = 1, nrcv 449 IF (srcv(ji)%laction ) THEN 450 DO jm = 1, ncplmodel 451 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 452 IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 453 id = srcv(ji)%nid(1,jm) 454 mop = OASIS_In 455 ENDIF 456 ENDIF 457 ENDDO 458 ENDIF 459 ENDDO 460 ! 461 IF( id /= -1 ) THEN 462 #if defined key_oa3mct_v3 463 CALL oasis_get_freqs(id, mop, 1, itmp, info) 464 #else 465 CALL oasis_get_freqs(id, 1, itmp, info) 466 #endif 467 cpl_freq = itmp(1) 468 ENDIF 415 469 ! 416 470 END FUNCTION cpl_freq -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5399 r5407 154 154 IF( PRESENT(kit) ) ll_firstcall = ll_firstcall .and. kit == 1 155 155 156 it_offset = 0 156 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 157 ELSE ; it_offset = 0 158 ENDIF 157 159 IF( PRESENT(kt_offset) ) it_offset = kt_offset 158 160 … … 452 454 ENDIF 453 455 ! 454 it_offset = 0 456 IF ( nn_components == jp_iam_sas ) THEN ; it_offset = nn_fsbc 457 ELSE ; it_offset = 0 458 ENDIF 455 459 IF( PRESENT(kt_offset) ) it_offset = kt_offset 456 460 IF( PRESENT(kit) ) THEN ; it_offset = ( kit + it_offset ) * NINT( rdt/REAL(nn_baro,wp) ) -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5385 r5407 68 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: Solar surface transmission parameter, thick ice [-] 69 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: Solar surface transmission parameter, thin ice [-] 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2]70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s] 71 71 72 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt 73 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt 74 75 #if defined key_lim3 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: evap_ice !: sublimation [kg/m2/s] 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: devap_ice !: sublimation sensitivity [kg/m2/s/K] 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns_oce !: non solar heat flux over ocean [W/m2] 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_oce !: non solar heat flux over ocean [W/m2] 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_oce !: heat flux of precip and evap over ocean [W/m2] 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_ice !: heat flux of precip and evap over ice [W/m2] 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qprec_ice !: heat flux of precip over ice [J/m3] 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s] 84 #endif 85 #if defined key_lim3 || defined key_lim2 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_ice !: wind speed module at T-point [m/s] 87 #endif 74 88 75 89 #if defined key_cice … … 99 113 #endif 100 114 101 #if defined key_lim3 || defined key_cice 102 ! not used with LIM2 115 #if defined key_cice 103 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K] 104 117 #endif … … 124 137 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 125 138 & qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) , & 126 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , & 127 & alb_ice (jpi,jpj,jpl) , & 128 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , & 139 & dqns_ice(jpi,jpj,jpl) , tn_ice (jpi,jpj,jpl) , alb_ice (jpi,jpj,jpl) , & 140 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , wndm_ice(jpi,jpj) , & 129 141 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 130 #if defined key_lim3131 & tatm_ice(jpi,jpj) , &132 #endif133 142 #if defined key_lim2 134 143 & a_i(jpi,jpj,jpl) , & 144 #endif 145 #if defined key_lim3 146 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) , & 147 & qemp_ice(jpi,jpj) , qemp_oce(jpi,jpj) , & 148 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 135 149 #endif 136 150 & emp_ice(jpi,jpj) , STAT= ierr(1) ) … … 144 158 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 145 159 STAT= ierr(1) ) 146 IF( l k_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , &160 IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 147 161 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 148 162 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & … … 152 166 ! 153 167 #if defined key_cice || defined key_lim2 154 IF( l k_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) )168 IF( ln_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 155 169 #endif 156 170 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5385 r5407 36 36 LOGICAL , PUBLIC :: ln_blk_mfs !: MFS bulk formulation 37 37 #if defined key_oasis3 38 LOGICAL , PUBLIC :: lk_ cpl = .TRUE. !: coupled formulation38 LOGICAL , PUBLIC :: lk_oasis = .TRUE. !: OASIS used 39 39 #else 40 LOGICAL , PUBLIC :: lk_cpl = .FALSE. !: coupled formulation 41 #endif 40 LOGICAL , PUBLIC :: lk_oasis = .FALSE. !: OASIS unused 41 #endif 42 LOGICAL , PUBLIC :: ln_cpl !: ocean-atmosphere coupled formulation 43 LOGICAL , PUBLIC :: ln_mixcpl !: ocean-atmosphere forced-coupled mixed formulation 42 44 LOGICAL , PUBLIC :: ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) 43 45 LOGICAL , PUBLIC :: ln_rnf !: runoffs / runoff mouths … … 50 52 ! !: =1 levitating ice with mass and salt exchange but no presure effect 51 53 ! !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 52 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 54 INTEGER , PUBLIC :: nn_components !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 55 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 53 56 ! !: =-1 Use of per-category fluxes 54 57 ! !: = 0 Average per-category fluxes … … 69 72 !! switch definition (improve readability) 70 73 !!---------------------------------------------------------------------- 71 INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation 72 INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation 73 INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation 74 INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation 75 INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation 76 INTEGER , PUBLIC, PARAMETER :: jp_cpl = 5 !: Coupled formulation 77 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 74 INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation 75 INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation 76 INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation 77 INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation 78 INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation 79 INTEGER , PUBLIC, PARAMETER :: jp_purecpl = 5 !: Pure ocean-atmosphere Coupled formulation 80 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 81 INTEGER , PUBLIC, PARAMETER :: jp_none = 7 !: for OPA when doing coupling via SAS module 78 82 INTEGER , PUBLIC, PARAMETER :: jp_esopa = -1 !: esopa test, ALL formulations 79 83 84 !!---------------------------------------------------------------------- 85 !! component definition 86 !!---------------------------------------------------------------------- 87 INTEGER , PUBLIC, PARAMETER :: jp_iam_nemo = 0 !: Initial single executable configuration 88 ! (no internal OASIS coupling) 89 INTEGER , PUBLIC, PARAMETER :: jp_iam_opa = 1 !: Multi executable configuration - OPA component 90 ! (internal OASIS coupling) 91 INTEGER , PUBLIC, PARAMETER :: jp_iam_sas = 2 !: Multi executable configuration - SAS component 92 ! (internal OASIS coupling) 80 93 !!---------------------------------------------------------------------- 81 94 !! Ocean Surface Boundary Condition fields … … 111 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] 112 125 #endif 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 113 127 114 128 !!---------------------------------------------------------------------- … … 122 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_m !: mean (nn_fsbc time-step) sea surface height [m] 123 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3t_m !: mean (nn_fsbc time-step) sea surface layer thickness [m] 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_m !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 124 139 125 140 !! * Substitutions … … 155 170 & atm_co2(jpi,jpj) , & 156 171 #endif 157 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , 158 & ssv_m (jpi,jpj) , sss_m (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )172 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 173 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 159 174 ! 160 175 #if defined key_vvl -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r5126 r5407 34 34 USE albedo 35 35 USE prtctl ! Print control 36 #if defined key_lim3 36 #if defined key_lim3 37 37 USE ice 38 38 USE sbc_ice ! Surface boundary condition: ice fields 39 USE limthd_dh ! for CALL lim_thd_snwblow 39 40 #elif defined key_lim2 40 41 USE ice_2 42 USE sbc_ice ! Surface boundary condition: ice fields 43 USE par_ice_2 ! Surface boundary condition: ice fields 41 44 #endif 42 45 … … 45 48 46 49 PUBLIC sbc_blk_clio ! routine called by sbcmod.F90 47 PUBLIC blk_ice_clio ! routine called by sbcice_lim.F90 50 #if defined key_lim2 || defined key_lim3 51 PUBLIC blk_ice_clio_tau ! routine called by sbcice_lim.F90 52 PUBLIC blk_ice_clio_flx ! routine called by sbcice_lim.F90 53 #endif 48 54 49 55 INTEGER , PARAMETER :: jpfld = 7 ! maximum number of files to read … … 378 384 & + sf(jp_prec)%fnow(:,:,1) * sf(jp_tair)%fnow(:,:,1) * zcprec ! add precip. heat content at Tair in Celcius 379 385 qns(:,:) = qns(:,:) * tmask(:,:,1) 386 #if defined key_lim3 387 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) 388 qsr_oce(:,:) = qsr(:,:) 389 #endif 380 390 ! NB: if sea-ice model, the snow precip are computed and the associated heat is added to qns (see blk_ice_clio) 381 391 382 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 383 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean 384 CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean 385 CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean 392 IF ( nn_ice == 0 ) THEN 393 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 394 CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean 395 CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean 396 CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 397 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 398 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 399 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 400 ENDIF 386 401 387 402 IF(ln_ctl) THEN … … 399 414 END SUBROUTINE blk_oce_clio 400 415 401 402 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, & 403 & p_taui, p_tauj, p_qns , p_qsr, & 404 & p_qla , p_dqns, p_dqla, & 405 & p_tpr , p_spr , & 406 & p_fr1 , p_fr2 , cd_grid, pdim ) 416 # if defined key_lim2 || defined key_lim3 417 SUBROUTINE blk_ice_clio_tau 407 418 !!--------------------------------------------------------------------------- 408 !! *** ROUTINE blk_ice_clio *** 419 !! *** ROUTINE blk_ice_clio_tau *** 420 !! 421 !! ** Purpose : Computation momentum flux at the ice-atm interface 422 !! 423 !! ** Method : Read utau from a forcing file. Rearrange if C-grid 424 !! 425 !!---------------------------------------------------------------------- 426 REAL(wp) :: zcoef 427 INTEGER :: ji, jj ! dummy loop indices 428 !!--------------------------------------------------------------------- 429 ! 430 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_tau') 431 432 SELECT CASE( cp_ice_msh ) 433 434 CASE( 'C' ) ! C-grid ice dynamics 435 436 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 437 utau_ice(:,:) = zcoef * utau(:,:) 438 vtau_ice(:,:) = zcoef * vtau(:,:) 439 440 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 441 442 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 443 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 444 DO ji = 2, jpi ! I-grid : no vector opt. 445 utau_ice(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 446 vtau_ice(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 447 END DO 448 END DO 449 450 CALL lbc_lnk( utau_ice(:,:), 'I', -1. ) ; CALL lbc_lnk( vtau_ice(:,:), 'I', -1. ) ! I-point 451 452 END SELECT 453 454 IF(ln_ctl) THEN 455 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_clio: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 456 ENDIF 457 458 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_tau') 459 460 END SUBROUTINE blk_ice_clio_tau 461 #endif 462 463 # if defined key_lim2 || defined key_lim3 464 SUBROUTINE blk_ice_clio_flx( ptsu , palb_cs, palb_os, palb ) 465 !!--------------------------------------------------------------------------- 466 !! *** ROUTINE blk_ice_clio_flx *** 409 467 !! 410 468 !! ** Purpose : Computation of the heat fluxes at ocean and snow/ice … … 428 486 !! to take into account solid precip latent heat flux 429 487 !!---------------------------------------------------------------------- 430 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: p st! ice surface temperature [Kelvin]488 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: ptsu ! ice surface temperature [Kelvin] 431 489 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 432 490 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 433 491 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 434 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2]435 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2]436 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2]437 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2]438 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2]439 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2]440 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2]441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s]442 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s]443 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-]444 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-]445 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid)446 INTEGER, INTENT(in ) :: pdim ! number of ice categories447 492 !! 448 493 INTEGER :: ji, jj, jl ! dummy loop indices 449 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 450 !! 451 REAL(wp) :: zcoef, zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 494 !! 495 REAL(wp) :: zmt1, zmt2, zmt3, ztatm3 ! temporary scalars 452 496 REAL(wp) :: ztaevbk, zind1, zind2, zind3, ztamr ! - - 453 497 REAL(wp) :: zesi, zqsati, zdesidt ! - - … … 455 499 REAL(wp) :: zcshi, zclei, zrhovaclei, zrhovacshi ! - - 456 500 REAL(wp) :: ztice3, zticemb, zticemb2, zdqlw, zdqsb ! - - 501 REAL(wp) :: z1_lsub ! - - 457 502 !! 458 503 REAL(wp), DIMENSION(:,:) , POINTER :: ztatm ! Tair in Kelvin … … 461 506 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa ! air density 462 507 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw, z_qsb 508 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw 463 509 !!--------------------------------------------------------------------- 464 510 ! 465 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio ')511 IF( nn_timing == 1 ) CALL timing_start('blk_ice_clio_flx') 466 512 ! 467 513 CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 468 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb ) 469 470 ijpl = pdim ! number of ice categories 514 CALL wrk_alloc( jpi,jpj, jpl, z_qlw, z_qsb ) 515 471 516 zpatm = 101000. ! atmospheric pressure (assumed constant here) 472 473 #if defined key_lim3 474 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init 475 #endif 476 ! ! surface ocean fluxes computed with CLIO bulk formulea 477 !------------------------------------! 478 ! momentum fluxes (utau, vtau ) ! 479 !------------------------------------! 480 481 SELECT CASE( cd_grid ) 482 CASE( 'C' ) ! C-grid ice dynamics 483 zcoef = cai / cao ! Change from air-sea stress to air-ice stress 484 p_taui(:,:) = zcoef * utau(:,:) 485 p_tauj(:,:) = zcoef * vtau(:,:) 486 CASE( 'I' ) ! I-grid ice dynamics: I-point (i.e. F-point lower-left corner) 487 zcoef = 0.5_wp * cai / cao ! Change from air-sea stress to air-ice stress 488 DO jj = 2, jpj ! stress from ocean U- and V-points to ice U,V point 489 DO ji = 2, jpi ! I-grid : no vector opt. 490 p_taui(ji,jj) = zcoef * ( utau(ji-1,jj ) + utau(ji-1,jj-1) ) 491 p_tauj(ji,jj) = zcoef * ( vtau(ji ,jj-1) + vtau(ji-1,jj-1) ) 492 END DO 493 END DO 494 CALL lbc_lnk( p_taui(:,:), 'I', -1. ) ; CALL lbc_lnk( p_tauj(:,:), 'I', -1. ) ! I-point 495 END SELECT 496 497 517 !-------------------------------------------------------------------------------- 498 518 ! Determine cloud optical depths as a function of latitude (Chou et al., 1981). 499 519 ! and the correction factor for taking into account the effect of clouds 500 !------------------------------------------------------ 520 !-------------------------------------------------------------------------------- 521 501 522 !CDIR NOVERRCHK 502 523 !CDIR COLLAPSE … … 525 546 zmt2 = ( 272.0 - ztatm(ji,jj) ) / 38.0 ; zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 526 547 zmt3 = ( 281.0 - ztatm(ji,jj) ) / 18.0 ; zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 527 p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s548 sprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday & ! rday = converte mm/day to kg/m2/s 528 549 & * ( zind1 & ! solid (snow) precipitation [kg/m2/s] 529 550 & + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) & … … 535 556 ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 536 557 ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 537 p_fr1(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)538 p_fr2(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)539 END DO 540 END DO 541 CALL iom_put( 'snowpre', p_spr) ! Snow precipitation558 fr1_i0(ji,jj) = 0.18 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 559 fr2_i0(ji,jj) = 0.82 * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 560 END DO 561 END DO 562 CALL iom_put( 'snowpre', sprecip ) ! Snow precipitation 542 563 543 564 !-----------------------------------------------------------! 544 565 ! snow/ice Shortwave radiation (abedo already computed) ! 545 566 !-----------------------------------------------------------! 546 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr)547 548 DO jl = 1, ijpl567 CALL blk_clio_qsr_ice( palb_cs, palb_os, qsr_ice ) 568 569 DO jl = 1, jpl 549 570 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(:,:,1) ) & 550 571 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(:,:,1) ) … … 552 573 553 574 ! ! ========================== ! 554 DO jl = 1, ijpl ! Loop over ice categories !575 DO jl = 1, jpl ! Loop over ice categories ! 555 576 ! ! ========================== ! 556 577 !CDIR NOVERRCHK … … 566 587 ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 567 588 ! 568 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( p st(ji,jj,jl) - ztatm(ji,jj) ) )589 z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) ) 569 590 570 591 !---------------------------------------- … … 573 594 574 595 ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential) 575 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( p st(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )596 zesi = 611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( ptsu(ji,jj,jl) - rtt )/ ( ptsu(ji,jj,jl) - 7.66 ) ) 576 597 ! humidity close to the ice surface (at saturation) 577 598 zqsati = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi ) 578 599 579 600 ! computation of intermediate values 580 zticemb = p st(ji,jj,jl) - 7.66601 zticemb = ptsu(ji,jj,jl) - 7.66 581 602 zticemb2 = zticemb * zticemb 582 ztice3 = p st(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)603 ztice3 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 583 604 zdesidt = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 ) / zticemb2 ) 584 605 … … 593 614 594 615 ! sensible heat flux 595 z_qsb(ji,jj,jl) = zrhovacshi * ( p st(ji,jj,jl) - ztatm(ji,jj) )616 z_qsb(ji,jj,jl) = zrhovacshi * ( ptsu(ji,jj,jl) - ztatm(ji,jj) ) 596 617 597 618 ! latent heat flux 598 p_qla(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) )619 qla_ice(ji,jj,jl) = MAX( 0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) ) ) 599 620 600 621 ! sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes) … … 603 624 zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) ) 604 625 ! 605 p_dqla(ji,jj,jl) = zdqla ! latent flux sensitivity606 p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity626 dqla_ice(ji,jj,jl) = zdqla ! latent flux sensitivity 627 dqns_ice(ji,jj,jl) = -( zdqlw + zdqsb + zdqla ) ! total non solar sensitivity 607 628 END DO 608 629 ! … … 616 637 ! 617 638 !CDIR COLLAPSE 618 p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla(:,:,:) ! Downward Non Solar flux619 !CDIR COLLAPSE 620 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s]639 qns_ice(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - qla_ice (:,:,:) ! Downward Non Solar flux 640 !CDIR COLLAPSE 641 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) / rday ! total precipitation [kg/m2/s] 621 642 ! 622 643 ! ----------------------------------------------------------------------------- ! … … 625 646 !CDIR COLLAPSE 626 647 qns(:,:) = qns(:,:) & ! update the non-solar heat flux with: 627 & - p_spr(:,:) * lfus & ! remove melting solid precip 628 & + p_spr(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 629 & - p_spr(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 630 ! 648 & - sprecip(:,:) * lfus & ! remove melting solid precip 649 & + sprecip(:,:) * MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow - rt0 ) * cpic & ! add solid P at least below melting 650 & - sprecip(:,:) * sf(jp_tair)%fnow(:,:,1) * rcp ! remove solid precip. at Tair 651 652 #if defined key_lim3 653 ! ----------------------------------------------------------------------------- ! 654 ! Distribute evapo, precip & associated heat over ice and ocean 655 ! ---------------=====--------------------------------------------------------- ! 656 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 657 658 ! --- evaporation --- ! 659 z1_lsub = 1._wp / Lsub 660 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 661 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 662 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean 663 664 ! --- evaporation minus precipitation --- ! 665 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow redistribution by wind 666 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * ( 1._wp - zsnw ) 667 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 668 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 669 670 ! --- heat flux associated with emp --- ! 671 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap 672 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip 673 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip 674 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 675 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 676 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 677 678 ! --- total solar and non solar fluxes --- ! 679 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 680 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 681 682 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 683 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 684 685 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 686 #endif 687 631 688 !!gm : not necessary as all input data are lbc_lnk... 632 CALL lbc_lnk( p_fr1(:,:) , 'T', 1. )633 CALL lbc_lnk( p_fr2(:,:) , 'T', 1. )634 DO jl = 1, ijpl635 CALL lbc_lnk( p_qns(:,:,jl) , 'T', 1. )636 CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )637 CALL lbc_lnk( p_qla(:,:,jl) , 'T', 1. )638 CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )689 CALL lbc_lnk( fr1_i0 (:,:) , 'T', 1. ) 690 CALL lbc_lnk( fr2_i0 (:,:) , 'T', 1. ) 691 DO jl = 1, jpl 692 CALL lbc_lnk( qns_ice (:,:,jl) , 'T', 1. ) 693 CALL lbc_lnk( dqns_ice(:,:,jl) , 'T', 1. ) 694 CALL lbc_lnk( qla_ice (:,:,jl) , 'T', 1. ) 695 CALL lbc_lnk( dqla_ice(:,:,jl) , 'T', 1. ) 639 696 END DO 640 697 641 698 !!gm : mask is not required on forcing 642 DO jl = 1, ijpl 643 p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1) 644 p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1) 645 p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1) 646 p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1) 647 END DO 699 DO jl = 1, jpl 700 qns_ice (:,:,jl) = qns_ice (:,:,jl) * tmask(:,:,1) 701 qla_ice (:,:,jl) = qla_ice (:,:,jl) * tmask(:,:,1) 702 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * tmask(:,:,1) 703 dqla_ice(:,:,jl) = dqla_ice(:,:,jl) * tmask(:,:,1) 704 END DO 705 706 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 707 CALL wrk_dealloc( jpi,jpj, jpl , z_qlw, z_qsb ) 648 708 649 709 IF(ln_ctl) THEN 650 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=ijpl) 651 CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl) 652 CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl) 653 CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst , clinfo2=' pst : ', kdim=ijpl) 654 CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_clio: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ') 655 CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 710 CALL prt_ctl(tab3d_1=z_qsb , clinfo1=' blk_ice_clio: z_qsb : ', tab3d_2=z_qlw , clinfo2=' z_qlw : ', kdim=jpl) 711 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_clio: z_qla : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl) 712 CALL prt_ctl(tab3d_1=dqns_ice , clinfo1=' blk_ice_clio: dqns_ice : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl) 713 CALL prt_ctl(tab3d_1=dqla_ice , clinfo1=' blk_ice_clio: dqla_ice : ', tab3d_2=ptsu , clinfo2=' ptsu : ', kdim=jpl) 714 CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_clio: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ') 656 715 ENDIF 657 716 658 CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa ) 659 CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb ) 660 ! 661 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio') 662 ! 663 END SUBROUTINE blk_ice_clio 664 717 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_clio_flx') 718 ! 719 END SUBROUTINE blk_ice_clio_flx 720 721 #endif 665 722 666 723 SUBROUTINE blk_clio_qsr_oce( pqsr_oce ) -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r5385 r5407 44 44 USE sbc_ice ! Surface boundary condition: ice fields 45 45 USE lib_fortran ! to use key_nosignedzero 46 #if defined key_lim3 47 USE ice, ONLY : u_ice, v_ice, jpl, pfrld, a_i_b 48 USE limthd_dh ! for CALL lim_thd_snwblow 49 #elif defined key_lim2 50 USE ice_2, ONLY : u_ice, v_ice 51 USE par_ice_2 52 #endif 46 53 47 54 IMPLICIT NONE … … 49 56 50 57 PUBLIC sbc_blk_core ! routine called in sbcmod module 51 PUBLIC blk_ice_core ! routine called in sbc_ice_lim module 58 #if defined key_lim2 || defined key_lim3 59 PUBLIC blk_ice_core_tau ! routine called in sbc_ice_lim module 60 PUBLIC blk_ice_core_flx ! routine called in sbc_ice_lim module 61 #endif 52 62 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 53 63 … … 371 381 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 372 382 & - sf(jp_prec)%fnow(:,:,1) * rn_pfac ) * tmask(:,:,1) 373 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 383 ! 384 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar 374 385 & - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus & ! remove latent melting heat for solid precip 375 386 & - zevap(:,:) * pst(:,:) * rcp & ! remove evap heat content at SST … … 379 390 & * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 380 391 ! 381 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean 382 CALL iom_put( "qsb_oce", - zqsb ) ! output downward sensible heat over the ocean 383 CALL iom_put( "qla_oce", - zqla ) ! output downward latent heat over the ocean 384 CALL iom_put( "qhc_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 385 CALL iom_put( "qns_oce", qns ) ! output downward non solar heat over the ocean 392 #if defined key_lim3 393 qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! non solar without emp (only needed by LIM3) 394 qsr_oce(:,:) = qsr(:,:) 395 #endif 396 ! 397 IF ( nn_ice == 0 ) THEN 398 CALL iom_put( "qlw_oce" , zqlw ) ! output downward longwave heat over the ocean 399 CALL iom_put( "qsb_oce" , - zqsb ) ! output downward sensible heat over the ocean 400 CALL iom_put( "qla_oce" , - zqla ) ! output downward latent heat over the ocean 401 CALL iom_put( "qemp_oce", qns-zqlw+zqsb+zqla ) ! output downward heat content of E-P over the ocean 402 CALL iom_put( "qns_oce" , qns ) ! output downward non solar heat over the ocean 403 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 404 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 405 ENDIF 386 406 ! 387 407 IF(ln_ctl) THEN … … 401 421 402 422 403 SUBROUTINE blk_ice_core( pst , pui , pvi , palb , & 404 & p_taui, p_tauj, p_qns , p_qsr, & 405 & p_qla , p_dqns, p_dqla, & 406 & p_tpr , p_spr , & 407 & p_fr1 , p_fr2 , cd_grid, pdim ) 408 !!--------------------------------------------------------------------- 409 !! *** ROUTINE blk_ice_core *** 423 #if defined key_lim2 || defined key_lim3 424 SUBROUTINE blk_ice_core_tau 425 !!--------------------------------------------------------------------- 426 !! *** ROUTINE blk_ice_core_tau *** 410 427 !! 411 428 !! ** Purpose : provide the surface boundary condition over sea-ice 412 429 !! 413 !! ** Method : compute momentum, heat and freshwater exchanged 414 !! between atmosphere and sea-ice using CORE bulk 415 !! formulea, ice variables and read atmmospheric fields. 430 !! ** Method : compute momentum using CORE bulk 431 !! formulea, ice variables and read atmospheric fields. 416 432 !! NB: ice drag coefficient is assumed to be a constant 417 !! 418 !! caution : the net upward water flux has with mm/day unit 419 !!--------------------------------------------------------------------- 420 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pst ! ice surface temperature (>0, =rt0 over land) [Kelvin] 421 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pui ! ice surface velocity (i- and i- components [m/s] 422 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvi ! at I-point (B-grid) or U & V-point (C-grid) 423 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (all skies) [%] 424 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_taui ! i- & j-components of surface ice stress [N/m2] 425 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 426 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 427 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 428 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 429 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 430 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 431 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 432 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 433 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%] 434 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%] 435 CHARACTER(len=1) , INTENT(in ) :: cd_grid ! ice grid ( C or B-grid) 436 INTEGER , INTENT(in ) :: pdim ! number of ice categories 437 !! 438 INTEGER :: ji, jj, jl ! dummy loop indices 439 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 440 REAL(wp) :: zst2, zst3 441 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 442 REAL(wp) :: zztmp ! temporary variable 443 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 444 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 445 !! 446 REAL(wp), DIMENSION(:,:) , POINTER :: z_wnds_t ! wind speed ( = | U10m - U_ice | ) at T-point 447 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice 448 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice 449 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice 450 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice 451 !!--------------------------------------------------------------------- 452 ! 453 IF( nn_timing == 1 ) CALL timing_start('blk_ice_core') 454 ! 455 CALL wrk_alloc( jpi,jpj, z_wnds_t ) 456 CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 457 458 ijpl = pdim ! number of ice categories 459 433 !!--------------------------------------------------------------------- 434 INTEGER :: ji, jj ! dummy loop indices 435 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2 436 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 437 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 438 !!--------------------------------------------------------------------- 439 ! 440 IF( nn_timing == 1 ) CALL timing_start('blk_ice_core_tau') 441 ! 460 442 ! local scalars ( place there for vector optimisation purposes) 461 443 zcoef_wnorm = rhoa * Cice 462 444 zcoef_wnorm2 = rhoa * Cice * 0.5 463 zcoef_dqlw = 4.0 * 0.95 * Stef464 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8)465 zcoef_dqsb = rhoa * cpa * Cice466 445 467 446 !!gm brutal.... 468 z_wnds_t(:,:) = 0.e0469 p_taui (:,:) = 0.e0470 p_tauj (:,:) = 0.e0447 utau_ice (:,:) = 0._wp 448 vtau_ice (:,:) = 0._wp 449 wndm_ice (:,:) = 0._wp 471 450 !!gm end 472 451 473 #if defined key_lim3474 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init475 #endif476 452 ! ----------------------------------------------------------------------------- ! 477 453 ! Wind components and module relative to the moving ocean ( U10m - U_ice ) ! 478 454 ! ----------------------------------------------------------------------------- ! 479 SELECT CASE( c d_grid)455 SELECT CASE( cp_ice_msh ) 480 456 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 481 457 ! and scalar wind at T-point ( = | U10m - U_ice | ) (masked) … … 484 460 ! ... scalar wind at I-point (fld being at T-point) 485 461 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) & 486 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * pui(ji,jj)462 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * u_ice(ji,jj) 487 463 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 488 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * pvi(ji,jj)464 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * v_ice(ji,jj) 489 465 zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 490 466 ! ... ice stress at I-point 491 p_taui(ji,jj) = zwnorm_f * zwndi_f492 p_tauj(ji,jj) = zwnorm_f * zwndj_f467 utau_ice(ji,jj) = zwnorm_f * zwndi_f 468 vtau_ice(ji,jj) = zwnorm_f * zwndj_f 493 469 ! ... scalar wind at T-point (fld being at T-point) 494 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) &495 & + pui(ji,jj ) + pui(ji+1,jj ) )496 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) &497 & + pvi(ji,jj ) + pvi(ji+1,jj ) )498 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)470 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( u_ice(ji,jj+1) + u_ice(ji+1,jj+1) & 471 & + u_ice(ji,jj ) + u_ice(ji+1,jj ) ) 472 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( v_ice(ji,jj+1) + v_ice(ji+1,jj+1) & 473 & + v_ice(ji,jj ) + v_ice(ji+1,jj ) ) 474 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 499 475 END DO 500 476 END DO 501 CALL lbc_lnk( p_taui, 'I', -1. )502 CALL lbc_lnk( p_tauj, 'I', -1. )503 CALL lbc_lnk( z_wnds_t, 'T', 1. )477 CALL lbc_lnk( utau_ice, 'I', -1. ) 478 CALL lbc_lnk( vtau_ice, 'I', -1. ) 479 CALL lbc_lnk( wndm_ice, 'T', 1. ) 504 480 ! 505 481 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 506 482 DO jj = 2, jpj 507 483 DO ji = fs_2, jpi ! vect. opt. 508 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) )509 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) )510 z_wnds_t(ji,jj)= SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)484 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) ) 485 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) ) 486 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 511 487 END DO 512 488 END DO 513 489 DO jj = 2, jpjm1 514 490 DO ji = fs_2, fs_jpim1 ! vect. opt. 515 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) &516 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * pui(ji,jj) )517 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) &518 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * pvi(ji,jj) )491 utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) & 492 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 493 vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) & 494 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 519 495 END DO 520 496 END DO 521 CALL lbc_lnk( p_taui, 'U', -1. )522 CALL lbc_lnk( p_tauj, 'V', -1. )523 CALL lbc_lnk( z_wnds_t, 'T', 1. )497 CALL lbc_lnk( utau_ice, 'U', -1. ) 498 CALL lbc_lnk( vtau_ice, 'V', -1. ) 499 CALL lbc_lnk( wndm_ice, 'T', 1. ) 524 500 ! 525 501 END SELECT 502 503 IF(ln_ctl) THEN 504 CALL prt_ctl(tab2d_1=utau_ice , clinfo1=' blk_ice_core: utau_ice : ', tab2d_2=vtau_ice , clinfo2=' vtau_ice : ') 505 CALL prt_ctl(tab2d_1=wndm_ice , clinfo1=' blk_ice_core: wndm_ice : ') 506 ENDIF 507 508 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_tau') 509 510 END SUBROUTINE blk_ice_core_tau 511 512 513 SUBROUTINE blk_ice_core_flx( ptsu, palb ) 514 !!--------------------------------------------------------------------- 515 !! *** ROUTINE blk_ice_core_flx *** 516 !! 517 !! ** Purpose : provide the surface boundary condition over sea-ice 518 !! 519 !! ** Method : compute heat and freshwater exchanged 520 !! between atmosphere and sea-ice using CORE bulk 521 !! formulea, ice variables and read atmmospheric fields. 522 !! 523 !! caution : the net upward water flux has with mm/day unit 524 !!--------------------------------------------------------------------- 525 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: ptsu ! sea ice surface temperature 526 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: palb ! ice albedo (all skies) 527 !! 528 INTEGER :: ji, jj, jl ! dummy loop indices 529 REAL(wp) :: zst2, zst3 530 REAL(wp) :: zcoef_dqlw, zcoef_dqla, zcoef_dqsb 531 REAL(wp) :: zztmp, z1_lsub ! temporary variable 532 !! 533 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qlw ! long wave heat flux over ice 534 REAL(wp), DIMENSION(:,:,:), POINTER :: z_qsb ! sensible heat flux over ice 535 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqlw ! long wave heat sensitivity over ice 536 REAL(wp), DIMENSION(:,:,:), POINTER :: z_dqsb ! sensible heat sensitivity over ice 537 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 538 !!--------------------------------------------------------------------- 539 ! 540 IF( nn_timing == 1 ) CALL timing_start('blk_ice_core_flx') 541 ! 542 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 543 544 ! local scalars ( place there for vector optimisation purposes) 545 zcoef_dqlw = 4.0 * 0.95 * Stef 546 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8) 547 zcoef_dqsb = rhoa * cpa * Cice 526 548 527 549 zztmp = 1. / ( 1. - albo ) 528 550 ! ! ========================== ! 529 DO jl = 1, ijpl! Loop over ice categories !551 DO jl = 1, jpl ! Loop over ice categories ! 530 552 ! ! ========================== ! 531 553 DO jj = 1 , jpj … … 534 556 ! I Radiative FLUXES ! 535 557 ! ----------------------------! 536 zst2 = p st(ji,jj,jl) * pst(ji,jj,jl)537 zst3 = p st(ji,jj,jl) * zst2558 zst2 = ptsu(ji,jj,jl) * ptsu(ji,jj,jl) 559 zst3 = ptsu(ji,jj,jl) * zst2 538 560 ! Short Wave (sw) 539 p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)561 qsr_ice(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 540 562 ! Long Wave (lw) 541 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * p st(ji,jj,jl) * zst3 ) * tmask(ji,jj,1)563 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * ptsu(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 542 564 ! lw sensitivity 543 565 z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 … … 549 571 ! ... turbulent heat fluxes 550 572 ! Sensible Heat 551 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )573 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 552 574 ! Latent Heat 553 p_qla(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) &554 & * ( 11637800. * EXP( -5897.8 / p st(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) )555 556 IF( p_qla(ji,jj,jl) > 0._wp ) THEN557 p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )575 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, rhoa * Ls * Cice * wndm_ice(ji,jj) & 576 & * ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 577 ! Latent heat sensitivity for ice (Dqla/Dt) 578 IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 579 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl) ) 558 580 ELSE 559 p_dqla(ji,jj,jl) = 0._wp581 dqla_ice(ji,jj,jl) = 0._wp 560 582 ENDIF 561 583 562 584 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 563 z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj)585 z_dqsb(ji,jj,jl) = zcoef_dqsb * wndm_ice(ji,jj) 564 586 565 587 ! ----------------------------! … … 567 589 ! ----------------------------! 568 590 ! Downward Non Solar flux 569 p_qns (ji,jj,jl) = z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla(ji,jj,jl)591 qns_ice (ji,jj,jl) = z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - qla_ice (ji,jj,jl) 570 592 ! Total non solar heat flux sensitivity for ice 571 p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )593 dqns_ice(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + dqla_ice(ji,jj,jl) ) 572 594 END DO 573 595 ! … … 576 598 END DO 577 599 ! 600 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 601 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 602 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow precipitation 603 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation 604 605 #if defined key_lim3 606 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 607 608 ! --- evaporation --- ! 609 z1_lsub = 1._wp / Lsub 610 evap_ice (:,:,:) = qla_ice (:,:,:) * z1_lsub ! sublimation 611 devap_ice(:,:,:) = dqla_ice(:,:,:) * z1_lsub 612 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean 613 614 ! --- evaporation minus precipitation --- ! 615 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing 616 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 617 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 618 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 619 620 ! --- heat flux associated with emp --- ! 621 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst 622 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 623 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) 624 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 625 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 626 & ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 627 628 ! --- total solar and non solar fluxes --- ! 629 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 630 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 631 632 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 633 qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 634 635 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 636 #endif 637 578 638 !-------------------------------------------------------------------- 579 639 ! FRACTIONs of net shortwave radiation which is not absorbed in the … … 581 641 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 582 642 ! 583 p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 584 p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 585 ! 586 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 587 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 588 CALL iom_put( 'snowpre', p_spr * 86400. ) ! Snow precipitation 589 CALL iom_put( 'precip' , p_tpr * 86400. ) ! Total precipitation 643 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 644 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 645 ! 590 646 ! 591 647 IF(ln_ctl) THEN 592 CALL prt_ctl(tab3d_1=p_qla , clinfo1=' blk_ice_core: p_qla : ', tab3d_2=z_qsb , clinfo2=' z_qsb : ', kdim=ijpl) 593 CALL prt_ctl(tab3d_1=z_qlw , clinfo1=' blk_ice_core: z_qlw : ', tab3d_2=p_dqla , clinfo2=' p_dqla : ', kdim=ijpl) 594 CALL prt_ctl(tab3d_1=z_dqsb , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw , clinfo2=' z_dqlw : ', kdim=ijpl) 595 CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr , clinfo2=' p_qsr : ', kdim=ijpl) 596 CALL prt_ctl(tab3d_1=pst , clinfo1=' blk_ice_core: pst : ', tab3d_2=p_qns , clinfo2=' p_qns : ', kdim=ijpl) 597 CALL prt_ctl(tab2d_1=p_tpr , clinfo1=' blk_ice_core: p_tpr : ', tab2d_2=p_spr , clinfo2=' p_spr : ') 598 CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ') 599 CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ') 600 ENDIF 601 602 CALL wrk_dealloc( jpi,jpj, z_wnds_t ) 603 CALL wrk_dealloc( jpi,jpj, pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 604 ! 605 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core') 606 ! 607 END SUBROUTINE blk_ice_core 648 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice_core: qla_ice : ', tab3d_2=z_qsb , clinfo2=' z_qsb : ', kdim=jpl) 649 CALL prt_ctl(tab3d_1=z_qlw , clinfo1=' blk_ice_core: z_qlw : ', tab3d_2=dqla_ice, clinfo2=' dqla_ice : ', kdim=jpl) 650 CALL prt_ctl(tab3d_1=z_dqsb , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw , clinfo2=' z_dqlw : ', kdim=jpl) 651 CALL prt_ctl(tab3d_1=dqns_ice, clinfo1=' blk_ice_core: dqns_ice : ', tab3d_2=qsr_ice , clinfo2=' qsr_ice : ', kdim=jpl) 652 CALL prt_ctl(tab3d_1=ptsu , clinfo1=' blk_ice_core: ptsu : ', tab3d_2=qns_ice , clinfo2=' qns_ice : ', kdim=jpl) 653 CALL prt_ctl(tab2d_1=tprecip , clinfo1=' blk_ice_core: tprecip : ', tab2d_2=sprecip , clinfo2=' sprecip : ') 654 ENDIF 655 656 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 657 ! 658 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_core_flx') 659 660 END SUBROUTINE blk_ice_core_flx 661 #endif 608 662 609 663 SUBROUTINE turb_core_2z( zt, zu, sst, T_zt, q_sat, q_zt, dU, & -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5363 r5407 21 21 USE sbc_oce ! Surface boundary condition: ocean fields 22 22 USE sbc_ice ! Surface boundary condition: ice fields 23 USE sbcapr 23 24 USE sbcdcy ! surface boundary condition: diurnal cycle 24 25 USE phycst ! physical constants … … 32 33 USE cpl_oasis3 ! OASIS3 coupling 33 34 USE geo2ocean ! 34 USE oce , ONLY : tsn, un, vn 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 35 36 USE albedo ! 36 37 USE in_out_manager ! I/O manager … … 40 41 USE timing ! Timing 41 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE eosbn2 44 USE sbcrnf , ONLY : l_rnfcpl 42 45 #if defined key_cpl_carbon_cycle 43 46 USE p4zflx, ONLY : oce_co2 … … 46 49 USE ice_domain_size, only: ncat 47 50 #endif 51 #if defined key_lim3 52 USE limthd_dh ! for CALL lim_thd_snwblow 53 #endif 54 48 55 IMPLICIT NONE 49 56 PRIVATE 50 !EM XIOS-OASIS-MCT compliance 57 51 58 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 52 59 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 … … 89 96 INTEGER, PARAMETER :: jpr_topm = 32 ! topmeltn 90 97 INTEGER, PARAMETER :: jpr_botm = 33 ! botmeltn 91 INTEGER, PARAMETER :: jprcv = 33 ! total number of fields received 92 93 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction 98 INTEGER, PARAMETER :: jpr_sflx = 34 ! salt flux 99 INTEGER, PARAMETER :: jpr_toce = 35 ! ocean temperature 100 INTEGER, PARAMETER :: jpr_soce = 36 ! ocean salinity 101 INTEGER, PARAMETER :: jpr_ocx1 = 37 ! ocean current on grid 1 102 INTEGER, PARAMETER :: jpr_ocy1 = 38 ! 103 INTEGER, PARAMETER :: jpr_ssh = 39 ! sea surface height 104 INTEGER, PARAMETER :: jpr_fice = 40 ! ice fraction 105 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 107 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 108 109 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere 94 110 INTEGER, PARAMETER :: jps_toce = 2 ! ocean temperature 95 111 INTEGER, PARAMETER :: jps_tice = 3 ! ice temperature … … 106 122 INTEGER, PARAMETER :: jps_ivz1 = 14 ! 107 123 INTEGER, PARAMETER :: jps_co2 = 15 108 INTEGER, PARAMETER :: jpsnd = 15 ! total number of fields sended 124 INTEGER, PARAMETER :: jps_soce = 16 ! ocean salinity 125 INTEGER, PARAMETER :: jps_ssh = 17 ! sea surface height 126 INTEGER, PARAMETER :: jps_qsroce = 18 ! Qsr above the ocean 127 INTEGER, PARAMETER :: jps_qnsoce = 19 ! Qns above the ocean 128 INTEGER, PARAMETER :: jps_oemp = 20 ! ocean freshwater budget (evap - precip) 129 INTEGER, PARAMETER :: jps_sflx = 21 ! salt flux 130 INTEGER, PARAMETER :: jps_otx1 = 22 ! 2 atmosphere-ocean stress components on grid 1 131 INTEGER, PARAMETER :: jps_oty1 = 23 ! 132 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 133 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 134 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 135 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 137 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 109 138 110 139 ! !!** namelist namsbc_cpl ** … … 125 154 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 126 155 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 127 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask129 130 156 TYPE :: DYNARR 131 157 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 139 165 140 166 !! Substitution 167 # include "domzgr_substitute.h90" 141 168 # include "vectopt_loop_substitute.h90" 142 169 !!---------------------------------------------------------------------- … … 161 188 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 162 189 #endif 163 ALLOCATE( xcplmask(jpi,jpj, nn_cplmodel) , STAT=ierr(3) )190 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 164 191 ! 165 192 sbc_cpl_alloc = MAXVAL( ierr ) … … 182 209 !! * initialise the OASIS coupler 183 210 !!---------------------------------------------------------------------- 184 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3)211 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 185 212 !! 186 213 INTEGER :: jn ! dummy loop index … … 216 243 WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 217 244 WRITE(numout,*)'~~~~~~~~~~~~' 245 ENDIF 246 IF( lwp .AND. ln_cpl ) THEN ! control print 218 247 WRITE(numout,*)' received fields (mutiple ice categogies)' 219 248 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 359 388 srcv(jpr_oemp)%clname = 'OOEvaMPr' ! ocean water budget = ocean Evap - ocean precip 360 389 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 390 CASE( 'none' ) ! nothing to do 361 391 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 362 392 CASE( 'conservative' ) … … 370 400 ! ! Runoffs & Calving ! 371 401 ! ! ------------------------- ! 372 srcv(jpr_rnf )%clname = 'O_Runoff' ; IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 373 ! This isn't right - really just want ln_rnf_emp changed 374 ! IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' ) THEN ; ln_rnf = .TRUE. 375 ! ELSE ; ln_rnf = .FALSE. 376 ! ENDIF 402 srcv(jpr_rnf )%clname = 'O_Runoff' 403 IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 404 srcv(jpr_rnf)%laction = .TRUE. 405 l_rnfcpl = .TRUE. ! -> no need to read runoffs in sbcrnf 406 ln_rnf = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 407 IF(lwp) WRITE(numout,*) 408 IF(lwp) WRITE(numout,*) ' runoffs received from oasis -> force ln_rnf = ', ln_rnf 409 ENDIF 410 ! 377 411 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 378 412 … … 384 418 srcv(jpr_qnsmix)%clname = 'O_QnsMix' 385 419 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) 420 CASE( 'none' ) ! nothing to do 386 421 CASE( 'oce only' ) ; srcv( jpr_qnsoce )%laction = .TRUE. 387 422 CASE( 'conservative' ) ; srcv( (/jpr_qnsice, jpr_qnsmix/) )%laction = .TRUE. … … 399 434 srcv(jpr_qsrmix)%clname = 'O_QsrMix' 400 435 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) 436 CASE( 'none' ) ! nothing to do 401 437 CASE( 'oce only' ) ; srcv( jpr_qsroce )%laction = .TRUE. 402 438 CASE( 'conservative' ) ; srcv( (/jpr_qsrice, jpr_qsrmix/) )%laction = .TRUE. … … 414 450 ! 415 451 ! non solar sensitivity mandatory for LIM ice model 416 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 ) &452 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 417 453 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 418 454 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 447 483 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 448 484 ENDIF 449 450 ! Allocate all parts of frcv used for received fields 485 ! ! ------------------------------- ! 486 ! ! OPA-SAS coupling - rcv by opa ! 487 ! ! ------------------------------- ! 488 srcv(jpr_sflx)%clname = 'O_SFLX' 489 srcv(jpr_fice)%clname = 'RIceFrc' 490 ! 491 IF( nn_components == jp_iam_opa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 492 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 493 srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 494 srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 495 srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 496 srcv(jpr_otx1)%clgrid = 'U' ! oce components given at U-point 497 srcv(jpr_oty1)%clgrid = 'V' ! and V-point 498 ! Vectors: change of sign at north fold ONLY if on the local grid 499 srcv( (/jpr_otx1,jpr_oty1/) )%nsgn = -1. 500 sn_rcv_tau%clvgrd = 'U,V' 501 sn_rcv_tau%clvor = 'local grid' 502 sn_rcv_tau%clvref = 'spherical' 503 sn_rcv_emp%cldes = 'oce only' 504 ! 505 IF(lwp) THEN ! control print 506 WRITE(numout,*) 507 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 508 WRITE(numout,*)' OPA component ' 509 WRITE(numout,*) 510 WRITE(numout,*)' received fields from SAS component ' 511 WRITE(numout,*)' ice cover ' 512 WRITE(numout,*)' oce only EMP ' 513 WRITE(numout,*)' salt flux ' 514 WRITE(numout,*)' mixed oce-ice solar flux ' 515 WRITE(numout,*)' mixed oce-ice non solar flux ' 516 WRITE(numout,*)' wind stress U,V on local grid and sperical coordinates ' 517 WRITE(numout,*)' wind stress module' 518 WRITE(numout,*) 519 ENDIF 520 ENDIF 521 ! ! -------------------------------- ! 522 ! ! OPA-SAS coupling - rcv by sas ! 523 ! ! -------------------------------- ! 524 srcv(jpr_toce )%clname = 'I_SSTSST' 525 srcv(jpr_soce )%clname = 'I_SSSal' 526 srcv(jpr_ocx1 )%clname = 'I_OCurx1' 527 srcv(jpr_ocy1 )%clname = 'I_OCury1' 528 srcv(jpr_ssh )%clname = 'I_SSHght' 529 srcv(jpr_e3t1st)%clname = 'I_E3T1st' 530 srcv(jpr_fraqsr)%clname = 'I_FraQsr' 531 ! 532 IF( nn_components == jp_iam_sas ) THEN 533 IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 534 IF( .NOT. ln_cpl ) srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling 535 IF( .NOT. ln_cpl ) srcv(:)%nsgn = 1. ! force default definition in case of opa <-> sas coupling 536 srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_fraqsr, jpr_ocx1, jpr_ocy1/) )%laction = .TRUE. 537 srcv( jpr_e3t1st )%laction = lk_vvl 538 srcv(jpr_ocx1)%clgrid = 'U' ! oce components given at U-point 539 srcv(jpr_ocy1)%clgrid = 'V' ! and V-point 540 ! Vectors: change of sign at north fold ONLY if on the local grid 541 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 542 ! Change first letter to couple with atmosphere if already coupled OPA 543 ! this is nedeed as each variable name used in the namcouple must be unique: 544 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 545 DO jn = 1, jprcv 546 IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 547 END DO 548 ! 549 IF(lwp) THEN ! control print 550 WRITE(numout,*) 551 WRITE(numout,*)' Special conditions for SAS-OPA coupling ' 552 WRITE(numout,*)' SAS component ' 553 WRITE(numout,*) 554 IF( .NOT. ln_cpl ) THEN 555 WRITE(numout,*)' received fields from OPA component ' 556 ELSE 557 WRITE(numout,*)' Additional received fields from OPA component : ' 558 ENDIF 559 WRITE(numout,*)' sea surface temperature (Celcius) ' 560 WRITE(numout,*)' sea surface salinity ' 561 WRITE(numout,*)' surface currents ' 562 WRITE(numout,*)' sea surface height ' 563 WRITE(numout,*)' thickness of first ocean T level ' 564 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 565 WRITE(numout,*) 566 ENDIF 567 ENDIF 568 569 ! =================================================== ! 570 ! Allocate all parts of frcv used for received fields ! 571 ! =================================================== ! 451 572 DO jn = 1, jprcv 452 573 IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) … … 454 575 ! Allocate taum part of frcv which is used even when not received as coupling field 455 576 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 577 ! Allocate w10m part of frcv which is used even when not received as coupling field 578 IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 579 ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 580 IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 581 IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 456 582 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 457 583 IF( k_ice /= 0 ) THEN … … 485 611 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 486 612 END SELECT 487 613 488 614 ! ! ------------------------- ! 489 615 ! ! Albedo ! … … 518 644 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 519 645 ENDIF 520 646 521 647 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 522 648 CASE( 'none' ) ! nothing to do … … 567 693 ! ! ------------------------- ! 568 694 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 695 696 ! ! ------------------------------- ! 697 ! ! OPA-SAS coupling - snd by opa ! 698 ! ! ------------------------------- ! 699 ssnd(jps_ssh )%clname = 'O_SSHght' 700 ssnd(jps_soce )%clname = 'O_SSSal' 701 ssnd(jps_e3t1st)%clname = 'O_E3T1st' 702 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 703 ! 704 IF( nn_components == jp_iam_opa ) THEN 705 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 706 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 707 ssnd( jps_e3t1st )%laction = lk_vvl 708 ! vector definition: not used but cleaner... 709 ssnd(jps_ocx1)%clgrid = 'U' ! oce components given at U-point 710 ssnd(jps_ocy1)%clgrid = 'V' ! and V-point 711 sn_snd_crt%clvgrd = 'U,V' 712 sn_snd_crt%clvor = 'local grid' 713 sn_snd_crt%clvref = 'spherical' 714 ! 715 IF(lwp) THEN ! control print 716 WRITE(numout,*) 717 WRITE(numout,*)' sent fields to SAS component ' 718 WRITE(numout,*)' sea surface temperature (T before, Celcius) ' 719 WRITE(numout,*)' sea surface salinity ' 720 WRITE(numout,*)' surface currents U,V on local grid and spherical coordinates' 721 WRITE(numout,*)' sea surface height ' 722 WRITE(numout,*)' thickness of first ocean T level ' 723 WRITE(numout,*)' fraction of solar net radiation absorbed in the first ocean level' 724 WRITE(numout,*) 725 ENDIF 726 ENDIF 727 ! ! ------------------------------- ! 728 ! ! OPA-SAS coupling - snd by sas ! 729 ! ! ------------------------------- ! 730 ssnd(jps_sflx )%clname = 'I_SFLX' 731 ssnd(jps_fice2 )%clname = 'IIceFrc' 732 ssnd(jps_qsroce)%clname = 'I_QsrOce' 733 ssnd(jps_qnsoce)%clname = 'I_QnsOce' 734 ssnd(jps_oemp )%clname = 'IOEvaMPr' 735 ssnd(jps_otx1 )%clname = 'I_OTaux1' 736 ssnd(jps_oty1 )%clname = 'I_OTauy1' 737 ssnd(jps_rnf )%clname = 'I_Runoff' 738 ssnd(jps_taum )%clname = 'I_TauMod' 739 ! 740 IF( nn_components == jp_iam_sas ) THEN 741 IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 742 ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 743 ! 744 ! Change first letter to couple with atmosphere if already coupled with sea_ice 745 ! this is nedeed as each variable name used in the namcouple must be unique: 746 ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 747 DO jn = 1, jpsnd 748 IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 749 END DO 750 ! 751 IF(lwp) THEN ! control print 752 WRITE(numout,*) 753 IF( .NOT. ln_cpl ) THEN 754 WRITE(numout,*)' sent fields to OPA component ' 755 ELSE 756 WRITE(numout,*)' Additional sent fields to OPA component : ' 757 ENDIF 758 WRITE(numout,*)' ice cover ' 759 WRITE(numout,*)' oce only EMP ' 760 WRITE(numout,*)' salt flux ' 761 WRITE(numout,*)' mixed oce-ice solar flux ' 762 WRITE(numout,*)' mixed oce-ice non solar flux ' 763 WRITE(numout,*)' wind stress U,V components' 764 WRITE(numout,*)' wind stress module' 765 ENDIF 766 ENDIF 767 569 768 ! 570 769 ! ================================ ! … … 572 771 ! ================================ ! 573 772 574 CALL cpl_define(jprcv, jpsnd,nn_cplmodel) 773 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 774 575 775 IF (ln_usecplmask) THEN 576 776 xcplmask(:,:,:) = 0. … … 582 782 xcplmask(:,:,:) = 1. 583 783 ENDIF 584 ! 585 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 784 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 785 ! 786 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'S_QsrOce' ) + cpl_freq( 'S_QsrMix' ) 787 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 586 788 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 789 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 587 790 588 791 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) … … 638 841 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 639 842 !!---------------------------------------------------------------------- 640 INTEGER, INTENT(in) :: kt ! ocean model time step index 641 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 642 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 643 !! 644 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 843 INTEGER, INTENT(in) :: kt ! ocean model time step index 844 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 845 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 846 847 !! 848 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 645 849 INTEGER :: ji, jj, jn ! dummy loop indices 646 850 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) … … 650 854 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 651 855 REAL(wp) :: zzx, zzy ! temporary variables 652 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty 856 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 653 857 !!---------------------------------------------------------------------- 654 858 ! 655 859 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 656 860 ! 657 CALL wrk_alloc( jpi,jpj, ztx, zty ) 658 ! ! Receive all the atmos. fields (including ice information) 659 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 660 DO jn = 1, jprcv ! received fields sent by the atmosphere 661 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 861 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 862 ! 863 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 864 ! 865 ! ! ======================================================= ! 866 ! ! Receive all the atmos. fields (including ice information) 867 ! ! ======================================================= ! 868 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 869 DO jn = 1, jprcv ! received fields sent by the atmosphere 870 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 662 871 END DO 663 872 … … 719 928 ! 720 929 ENDIF 721 722 930 ! ! ========================= ! 723 931 ! ! wind stress module ! (taum) … … 748 956 ENDIF 749 957 ENDIF 750 958 ! 751 959 ! ! ========================= ! 752 960 ! ! 10 m wind speed ! (wndm) … … 761 969 !CDIR NOVERRCHK 762 970 DO ji = 1, jpi 763 wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )971 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 764 972 END DO 765 973 END DO 766 974 ENDIF 767 ELSE768 IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)769 975 ENDIF 770 976 … … 773 979 IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 774 980 ! 775 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 776 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 777 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 981 IF( ln_mixcpl ) THEN 982 utau(:,:) = utau(:,:) * xcplmask(:,:,0) + frcv(jpr_otx1)%z3(:,:,1) * zmsk(:,:) 983 vtau(:,:) = vtau(:,:) * xcplmask(:,:,0) + frcv(jpr_oty1)%z3(:,:,1) * zmsk(:,:) 984 taum(:,:) = taum(:,:) * xcplmask(:,:,0) + frcv(jpr_taum)%z3(:,:,1) * zmsk(:,:) 985 wndm(:,:) = wndm(:,:) * xcplmask(:,:,0) + frcv(jpr_w10m)%z3(:,:,1) * zmsk(:,:) 986 ELSE 987 utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 988 vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 989 taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 990 wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 991 ENDIF 778 992 CALL iom_put( "taum_oce", taum ) ! output wind stress module 779 993 ! … … 781 995 782 996 #if defined key_cpl_carbon_cycle 783 ! ! atmosph. CO2 (ppm) 997 ! ! ================== ! 998 ! ! atmosph. CO2 (ppm) ! 999 ! ! ================== ! 784 1000 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 785 1001 #endif 786 1002 1003 ! Fields received by SAS when OASIS coupling 1004 ! (arrays no more filled at sbcssm stage) 1005 ! ! ================== ! 1006 ! ! SSS ! 1007 ! ! ================== ! 1008 IF( srcv(jpr_soce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1009 sss_m(:,:) = frcv(jpr_soce)%z3(:,:,1) 1010 CALL iom_put( 'sss_m', sss_m ) 1011 ENDIF 1012 ! 1013 ! ! ================== ! 1014 ! ! SST ! 1015 ! ! ================== ! 1016 IF( srcv(jpr_toce)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1017 sst_m(:,:) = frcv(jpr_toce)%z3(:,:,1) 1018 IF( srcv(jpr_soce)%laction .AND. ln_useCT ) THEN ! make sure that sst_m is the potential temperature 1019 sst_m(:,:) = eos_pt_from_ct( sst_m(:,:), sss_m(:,:) ) 1020 ENDIF 1021 ENDIF 1022 ! ! ================== ! 1023 ! ! SSH ! 1024 ! ! ================== ! 1025 IF( srcv(jpr_ssh )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1026 ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 1027 CALL iom_put( 'ssh_m', ssh_m ) 1028 ENDIF 1029 ! ! ================== ! 1030 ! ! surface currents ! 1031 ! ! ================== ! 1032 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1033 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1034 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1035 CALL iom_put( 'ssu_m', ssu_m ) 1036 ENDIF 1037 IF( srcv(jpr_ocy1)%laction ) THEN 1038 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1039 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1040 CALL iom_put( 'ssv_m', ssv_m ) 1041 ENDIF 1042 ! ! ======================== ! 1043 ! ! first T level thickness ! 1044 ! ! ======================== ! 1045 IF( srcv(jpr_e3t1st )%laction ) THEN ! received by sas in case of opa <-> sas coupling 1046 e3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 1047 CALL iom_put( 'e3t_m', e3t_m(:,:) ) 1048 ENDIF 1049 ! ! ================================ ! 1050 ! ! fraction of solar net radiation ! 1051 ! ! ================================ ! 1052 IF( srcv(jpr_fraqsr)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1053 frq_m(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 1054 CALL iom_put( 'frq_m', frq_m ) 1055 ENDIF 1056 787 1057 ! ! ========================= ! 788 IF( k_ice <= 1 ) THEN! heat & freshwater fluxes ! (Ocean only case)1058 IF( k_ice <= 1 .AND. MOD( kt-1, k_fsbc ) == 0 ) THEN ! heat & freshwater fluxes ! (Ocean only case) 789 1059 ! ! ========================= ! 790 1060 ! 791 1061 ! ! total freshwater fluxes over the ocean (emp) 792 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 793 CASE( 'conservative' ) 794 emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 795 CASE( 'oce only', 'oce and ice' ) 796 emp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 797 CASE default 798 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 799 END SELECT 1062 IF( srcv(jpr_oemp)%laction .OR. srcv(jpr_rain)%laction ) THEN 1063 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) ! evaporation - precipitation 1064 CASE( 'conservative' ) 1065 zemp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) 1066 CASE( 'oce only', 'oce and ice' ) 1067 zemp(:,:) = frcv(jpr_oemp)%z3(:,:,1) 1068 CASE default 1069 CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' ) 1070 END SELECT 1071 ELSE 1072 zemp(:,:) = 0._wp 1073 ENDIF 800 1074 ! 801 1075 ! ! runoffs and calving (added in emp) 802 IF( srcv(jpr_rnf)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 803 IF( srcv(jpr_cal)%laction ) emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1) 804 ! 805 !!gm : this seems to be internal cooking, not sure to need that in a generic interface 806 !!gm at least should be optional... 807 !! IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN ! add to the total freshwater budget 808 !! ! remove negative runoff 809 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 810 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 811 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos ) ! sum over the global domain 812 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg ) 813 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points 814 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos 815 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 816 !! ENDIF 817 !! ! add runoff to e-p 818 !! emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1) 819 !! ENDIF 820 !!gm end of internal cooking 1076 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1077 IF( srcv(jpr_cal)%laction ) zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 1078 1079 IF( ln_mixcpl ) THEN ; emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 1080 ELSE ; emp(:,:) = zemp(:,:) 1081 ENDIF 821 1082 ! 822 1083 ! ! non solar heat flux over the ocean (qns) 823 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 824 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1084 IF( srcv(jpr_qnsoce)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1085 ELSE IF( srcv(jpr_qnsmix)%laction ) THEN ; zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1086 ELSE ; zqns(:,:) = 0._wp 1087 END IF 825 1088 ! update qns over the free ocean with: 826 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 827 IF( srcv(jpr_snow )%laction ) THEN 828 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1089 IF( nn_components /= jp_iam_opa ) THEN 1090 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1091 IF( srcv(jpr_snow )%laction ) THEN 1092 zqns(:,:) = zqns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 1093 ENDIF 1094 ENDIF 1095 IF( ln_mixcpl ) THEN ; qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 1096 ELSE ; qns(:,:) = zqns(:,:) 829 1097 ENDIF 830 1098 831 1099 ! ! solar flux over the ocean (qsr) 832 IF( srcv(jpr_qsroce)%laction ) qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 833 IF( srcv(jpr_qsrmix)%laction ) qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 834 IF( ln_dm2dc ) qsr(:,:) = sbc_dcy( qsr ) ! modify qsr to include the diurnal cycle 1100 IF ( srcv(jpr_qsroce)%laction ) THEN ; zqsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1) 1101 ELSE IF( srcv(jpr_qsrmix)%laction ) then ; zqsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1) 1102 ELSE ; zqsr(:,:) = 0._wp 1103 ENDIF 1104 IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle 1105 IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 1106 ELSE ; qsr(:,:) = zqsr(:,:) 1107 ENDIF 835 1108 ! 836 837 ENDIF 838 ! 839 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1109 ! salt flux over the ocean (received by opa in case of opa <-> sas coupling) 1110 IF( srcv(jpr_sflx )%laction ) sfx(:,:) = frcv(jpr_sflx )%z3(:,:,1) 1111 ! Ice cover (received by opa in case of opa <-> sas coupling) 1112 IF( srcv(jpr_fice )%laction ) fr_i(:,:) = frcv(jpr_fice )%z3(:,:,1) 1113 ! 1114 1115 ENDIF 1116 ! 1117 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 840 1118 ! 841 1119 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 934 1212 ! 935 1213 ENDIF 936 937 1214 ! ! ======================= ! 938 1215 ! ! put on ice grid ! … … 1056 1333 1057 1334 1058 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist)1335 SUBROUTINE sbc_cpl_ice_flx( p_frld, palbi, psst, pist ) 1059 1336 !!---------------------------------------------------------------------- 1060 1337 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1098 1375 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1099 1376 ! optional arguments, used only in 'mixed oce-ice' case 1100 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1101 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1102 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1103 ! 1104 INTEGER :: jl ! dummy loop index 1105 REAL(wp), POINTER, DIMENSION(:,:) :: zcptn, ztmp, zicefr 1377 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1378 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1379 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1380 ! 1381 INTEGER :: jl ! dummy loop index 1382 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk 1383 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot 1384 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice 1385 REAL(wp), POINTER, DIMENSION(:,: ) :: zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ! for LIM3 1106 1386 !!---------------------------------------------------------------------- 1107 1387 ! 1108 1388 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1109 1389 ! 1110 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 1111 1390 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1391 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1392 1393 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1112 1394 zicefr(:,:) = 1.- p_frld(:,:) 1113 1395 zcptn(:,:) = rcp * sst_m(:,:) … … 1117 1399 ! ! ========================= ! 1118 1400 ! 1119 ! ! total Precipitations - total Evaporation (emp_tot) 1120 ! ! solid precipitation - sublimation (emp_ice) 1121 ! ! solid Precipitation (sprecip) 1401 ! ! total Precipitation - total Evaporation (emp_tot) 1402 ! ! solid precipitation - sublimation (emp_ice) 1403 ! ! solid Precipitation (sprecip) 1404 ! ! liquid + solid Precipitation (tprecip) 1122 1405 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1123 1406 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1124 sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)! May need to ensure positive here1125 tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:)! May need to ensure positive here1126 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) -tprecip(:,:)1127 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)1407 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1408 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1409 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1410 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1128 1411 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1129 1412 IF( iom_use('hflx_rain_cea') ) & … … 1136 1419 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1137 1420 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1138 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1139 emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1140 sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 1421 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1422 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1423 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1424 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1141 1425 END SELECT 1426 1427 IF( iom_use('subl_ai_cea') ) & 1428 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1429 ! 1430 ! ! runoffs and calving (put in emp_tot) 1431 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1432 IF( srcv(jpr_cal)%laction ) THEN 1433 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1434 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1435 ENDIF 1436 1437 IF( ln_mixcpl ) THEN 1438 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1439 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1440 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1441 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1442 ELSE 1443 emp_tot(:,:) = zemp_tot(:,:) 1444 emp_ice(:,:) = zemp_ice(:,:) 1445 sprecip(:,:) = zsprecip(:,:) 1446 tprecip(:,:) = ztprecip(:,:) 1447 ENDIF 1142 1448 1143 1449 CALL iom_put( 'snowpre' , sprecip ) ! Snow … … 1146 1452 IF( iom_use('snow_ai_cea') ) & 1147 1453 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1148 IF( iom_use('subl_ai_cea') ) &1149 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average)1150 !1151 ! ! runoffs and calving (put in emp_tot)1152 IF( srcv(jpr_rnf)%laction ) THEN1153 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)1154 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers1155 IF( iom_use('hflx_rnf_cea') ) &1156 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers1157 ENDIF1158 IF( srcv(jpr_cal)%laction ) THEN1159 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)1160 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) )1161 ENDIF1162 !1163 !!gm : this seems to be internal cooking, not sure to need that in a generic interface1164 !!gm at least should be optional...1165 !! ! remove negative runoff ! sum over the global domain1166 !! zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1167 !! zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )1168 !! IF( lk_mpp ) CALL mpp_sum( zcumulpos )1169 !! IF( lk_mpp ) CALL mpp_sum( zcumulneg )1170 !! IF( zcumulpos /= 0. ) THEN ! distribute negative runoff on positive runoff grid points1171 !! zcumulneg = 1.e0 + zcumulneg / zcumulpos1172 !! frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg1173 !! ENDIF1174 !! emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) ! add runoff to e-p1175 !!1176 !!gm end of internal cooking1177 1454 1178 1455 ! ! ========================= ! … … 1180 1457 ! ! ========================= ! 1181 1458 CASE( 'oce only' ) ! the required field is directly provided 1182 qns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1)1459 zqns_tot(:,: ) = frcv(jpr_qnsoce)%z3(:,:,1) 1183 1460 CASE( 'conservative' ) ! the required fields are directly provided 1184 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1461 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1185 1462 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1186 qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)1463 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1187 1464 ELSE 1188 1465 ! Set all category values equal for the moment 1189 1466 DO jl=1,jpl 1190 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)1467 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1191 1468 ENDDO 1192 1469 ENDIF 1193 1470 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1194 qns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1471 zqns_tot(:,: ) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1195 1472 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1196 1473 DO jl=1,jpl 1197 qns_tot(:,: ) =qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)1198 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)1474 zqns_tot(:,: ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl) 1475 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 1199 1476 ENDDO 1200 1477 ELSE 1201 1478 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1202 1479 DO jl=1,jpl 1203 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1480 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1481 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1204 1482 ENDDO 1205 1483 ENDIF 1206 1484 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1207 1485 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1208 qns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1)1209 qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) &1486 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1487 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1210 1488 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1211 1489 & + pist(:,:,1) * zicefr(:,:) ) ) 1212 1490 END SELECT 1213 ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus1214 qns_tot(:,:) = qns_tot(:,:) & ! qns_tot update over free ocean with:1215 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting1216 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST)1217 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:)1218 IF( iom_use('hflx_snow_cea') ) &1219 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average)1220 1491 !!gm 1221 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in1492 !! currently it is taken into account in leads budget but not in the zqns_tot, and thus not in 1222 1493 !! the flux that enter the ocean.... 1223 1494 !! moreover 1 - it is not diagnose anywhere.... … … 1228 1499 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1229 1500 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1230 qns_tot(:,:) =qns_tot(:,:) - ztmp(:,:)1501 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1231 1502 IF( iom_use('hflx_cal_cea') ) & 1232 1503 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1233 1504 ENDIF 1505 1506 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1507 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1508 1509 #if defined key_lim3 1510 CALL wrk_alloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1511 1512 ! --- evaporation --- ! 1513 ! clem: evap_ice is set to 0 for LIM3 since we still do not know what to do with sublimation 1514 ! the problem is: the atm. imposes both mass evaporation and heat removed from the snow/ice 1515 ! but it is incoherent WITH the ice model 1516 DO jl=1,jpl 1517 evap_ice(:,:,jl) = 0._wp ! should be: frcv(jpr_ievp)%z3(:,:,1) 1518 ENDDO 1519 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean 1520 1521 ! --- evaporation minus precipitation --- ! 1522 emp_oce(:,:) = emp_tot(:,:) - emp_ice(:,:) 1523 1524 ! --- non solar flux over ocean --- ! 1525 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax 1526 zqns_oce = 0._wp 1527 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 1528 1529 ! --- heat flux associated with emp --- ! 1530 CALL lim_thd_snwblow( p_frld, zsnw ) ! snow distribution over ice after wind blowing 1531 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) & ! evap 1532 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1533 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean 1534 qemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1535 & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1536 1537 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1538 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1539 1540 ! --- total non solar flux --- ! 1541 zqns_tot(:,:) = zqns_tot(:,:) + qemp_ice(:,:) + zqemp_oce(:,:) 1542 1543 ! --- in case both coupled/forced are active, we must mix values --- ! 1544 IF( ln_mixcpl ) THEN 1545 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1546 qns_oce(:,:) = qns_oce(:,:) * xcplmask(:,:,0) + zqns_oce(:,:)* zmsk(:,:) 1547 DO jl=1,jpl 1548 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1549 ENDDO 1550 qprec_ice(:,:) = qprec_ice(:,:) * xcplmask(:,:,0) + zqprec_ice(:,:)* zmsk(:,:) 1551 qemp_oce (:,:) = qemp_oce(:,:) * xcplmask(:,:,0) + zqemp_oce(:,:)* zmsk(:,:) 1552 !!clem evap_ice(:,:) = evap_ice(:,:) * xcplmask(:,:,0) 1553 ELSE 1554 qns_tot (:,: ) = zqns_tot (:,: ) 1555 qns_oce (:,: ) = zqns_oce (:,: ) 1556 qns_ice (:,:,:) = zqns_ice (:,:,:) 1557 qprec_ice(:,:) = zqprec_ice(:,:) 1558 qemp_oce (:,:) = zqemp_oce (:,:) 1559 ENDIF 1560 1561 CALL wrk_dealloc( jpi,jpj, zevap, zsnw, zqns_oce, zqprec_ice, zqemp_oce ) 1562 1563 #else 1564 1565 ! clem: this formulation is certainly wrong... but better than it was... 1566 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1567 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1568 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1569 & - zemp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1570 1571 IF( ln_mixcpl ) THEN 1572 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1573 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1574 DO jl=1,jpl 1575 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 1576 ENDDO 1577 ELSE 1578 qns_tot(:,: ) = zqns_tot(:,: ) 1579 qns_ice(:,:,:) = zqns_ice(:,:,:) 1580 ENDIF 1581 1582 #endif 1234 1583 1235 1584 ! ! ========================= ! … … 1237 1586 ! ! ========================= ! 1238 1587 CASE( 'oce only' ) 1239 qsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) )1588 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1240 1589 CASE( 'conservative' ) 1241 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1590 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1242 1591 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1243 qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)1592 zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 1244 1593 ELSE 1245 1594 ! Set all category values equal for the moment 1246 1595 DO jl=1,jpl 1247 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)1596 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1248 1597 ENDDO 1249 1598 ENDIF 1250 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1251 qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1599 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1600 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1252 1601 CASE( 'oce and ice' ) 1253 qsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1602 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1254 1603 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1255 1604 DO jl=1,jpl 1256 qsr_tot(:,: ) =qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)1257 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)1605 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1606 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1258 1607 ENDDO 1259 1608 ELSE 1260 1609 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1261 1610 DO jl=1,jpl 1262 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1611 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1612 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1263 1613 ENDDO 1264 1614 ENDIF 1265 1615 CASE( 'mixed oce-ice' ) 1266 qsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1616 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) 1267 1617 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1268 1618 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1269 1619 ! ( see OASIS3 user guide, 5th edition, p39 ) 1270 qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) &1620 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1271 1621 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) & 1272 1622 & + palbi (:,:,1) * zicefr(:,:) ) ) 1273 1623 END SELECT 1274 IF( ln_dm2dc ) THEN ! modify qsr to include the diurnal cycle1275 qsr_tot(:,: ) = sbc_dcy(qsr_tot(:,: ) )1624 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1625 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1276 1626 DO jl=1,jpl 1277 qsr_ice(:,:,jl) = sbc_dcy(qsr_ice(:,:,jl) )1627 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1278 1628 ENDDO 1629 ENDIF 1630 1631 IF( ln_mixcpl ) THEN 1632 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1633 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1634 DO jl=1,jpl 1635 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1636 ENDDO 1637 ELSE 1638 qsr_tot(:,: ) = zqsr_tot(:,: ) 1639 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 1279 1640 ENDIF 1280 1641 … … 1284 1645 CASE ('coupled') 1285 1646 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 1286 dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)1647 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 1287 1648 ELSE 1288 1649 ! Set all category values equal for the moment 1289 1650 DO jl=1,jpl 1290 dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)1651 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 1291 1652 ENDDO 1292 1653 ENDIF 1293 1654 END SELECT 1294 1655 1656 IF( ln_mixcpl ) THEN 1657 DO jl=1,jpl 1658 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 1659 ENDDO 1660 ELSE 1661 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 1662 ENDIF 1663 1295 1664 ! ! ========================= ! 1296 1665 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! … … 1308 1677 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1309 1678 1310 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 1679 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zemp_tot, zemp_ice, zsprecip, ztprecip, zqns_tot, zqsr_tot ) 1680 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice ) 1311 1681 ! 1312 1682 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 1328 1698 INTEGER :: ji, jj, jl ! dummy loop indices 1329 1699 INTEGER :: isec, info ! local integer 1700 REAL(wp) :: zumax, zvmax 1330 1701 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1331 1702 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 … … 1344 1715 ! ! ------------------------- ! 1345 1716 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1346 SELECT CASE( sn_snd_temp%cldes) 1347 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1348 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1349 SELECT CASE( sn_snd_temp%clcat ) 1350 CASE( 'yes' ) 1351 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1352 CASE( 'no' ) 1353 ztmp3(:,:,:) = 0.0 1717 1718 IF ( nn_components == jp_iam_opa ) THEN 1719 ztmp1(:,:) = tsn(:,:,1,jp_tem) ! send temperature as it is (potential or conservative) -> use of ln_useCT on the received part 1720 ELSE 1721 ! we must send the surface potential temperature 1722 IF( ln_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 1723 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 1724 ENDIF 1725 ! 1726 SELECT CASE( sn_snd_temp%cldes) 1727 CASE( 'oce only' ) ; ztmp1(:,:) = ztmp1(:,:) + rt0 1728 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1729 SELECT CASE( sn_snd_temp%clcat ) 1730 CASE( 'yes' ) 1731 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1732 CASE( 'no' ) 1733 ztmp3(:,:,:) = 0.0 1734 DO jl=1,jpl 1735 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1736 ENDDO 1737 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1738 END SELECT 1739 CASE( 'mixed oce-ice' ) 1740 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) 1354 1741 DO jl=1,jpl 1355 ztmp 3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)1742 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1356 1743 ENDDO 1357 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )1744 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1358 1745 END SELECT 1359 CASE( 'mixed oce-ice' ) 1360 ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1361 DO jl=1,jpl 1362 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1363 ENDDO 1364 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1365 END SELECT 1746 ENDIF 1366 1747 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1367 1748 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) … … 1385 1766 ! ! Ice fraction & Thickness ! 1386 1767 ! ! ------------------------- ! 1387 ! Send ice fraction field 1768 ! Send ice fraction field to atmosphere 1388 1769 IF( ssnd(jps_fice)%laction ) THEN 1389 1770 SELECT CASE( sn_snd_thick%clcat ) … … 1392 1773 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1393 1774 END SELECT 1394 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1775 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1776 ENDIF 1777 1778 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 1779 IF( ssnd(jps_fice2)%laction ) THEN 1780 ztmp3(:,:,1) = fr_i(:,:) 1781 IF( ssnd(jps_fice2)%laction ) CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 1395 1782 ENDIF 1396 1783 … … 1440 1827 ! i-1 i i 1441 1828 ! i i+1 (for I) 1442 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1443 CASE( 'oce only' ) ! C-grid ==> T 1444 DO jj = 2, jpjm1 1445 DO ji = fs_2, fs_jpim1 ! vector opt. 1446 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1447 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1448 END DO 1449 END DO 1450 CASE( 'weighted oce and ice' ) 1451 SELECT CASE ( cp_ice_msh ) 1452 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1829 IF( nn_components == jp_iam_opa ) THEN 1830 zotx1(:,:) = un(:,:,1) 1831 zoty1(:,:) = vn(:,:,1) 1832 ELSE 1833 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 1834 CASE( 'oce only' ) ! C-grid ==> T 1453 1835 DO jj = 2, jpjm1 1454 1836 DO ji = fs_2, fs_jpim1 ! vector opt. 1455 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1456 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1457 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1458 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1837 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 1838 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 1459 1839 END DO 1460 1840 END DO 1461 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1462 DO jj = 2, jpjm1 1463 DO ji = 2, jpim1 ! NO vector opt. 1464 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1465 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1466 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1467 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1468 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1469 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1841 CASE( 'weighted oce and ice' ) 1842 SELECT CASE ( cp_ice_msh ) 1843 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1844 DO jj = 2, jpjm1 1845 DO ji = fs_2, fs_jpim1 ! vector opt. 1846 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) 1847 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) 1848 zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1849 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1850 END DO 1470 1851 END DO 1471 END DO1472 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T1473 DO jj = 2, jpjm11474 DO ji = 2, jpim1 ! NO vector opt.1475 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj)1476 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj)1477 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) &1478 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj)1479 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) &1480 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj)1852 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1853 DO jj = 2, jpjm1 1854 DO ji = 2, jpim1 ! NO vector opt. 1855 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1856 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1857 zitx1(ji,jj) = 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1858 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1859 zity1(ji,jj) = 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1860 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1861 END DO 1481 1862 END DO 1482 END DO 1863 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1864 DO jj = 2, jpjm1 1865 DO ji = 2, jpim1 ! NO vector opt. 1866 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) 1867 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) 1868 zitx1(ji,jj) = 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1869 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1870 zity1(ji,jj) = 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1871 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1872 END DO 1873 END DO 1874 END SELECT 1875 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1876 CASE( 'mixed oce-ice' ) 1877 SELECT CASE ( cp_ice_msh ) 1878 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1879 DO jj = 2, jpjm1 1880 DO ji = fs_2, fs_jpim1 ! vector opt. 1881 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1882 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1883 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1884 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1885 END DO 1886 END DO 1887 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1888 DO jj = 2, jpjm1 1889 DO ji = 2, jpim1 ! NO vector opt. 1890 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1891 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1892 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1893 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1894 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1895 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1896 END DO 1897 END DO 1898 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1899 DO jj = 2, jpjm1 1900 DO ji = 2, jpim1 ! NO vector opt. 1901 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1902 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1903 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1904 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1905 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1906 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1907 END DO 1908 END DO 1909 END SELECT 1483 1910 END SELECT 1484 CALL lbc_lnk( zitx1, 'T', -1. ) ; CALL lbc_lnk( zity1, 'T', -1. ) 1485 CASE( 'mixed oce-ice' ) 1486 SELECT CASE ( cp_ice_msh ) 1487 CASE( 'C' ) ! Ocean and Ice on C-grid ==> T 1488 DO jj = 2, jpjm1 1489 DO ji = fs_2, fs_jpim1 ! vector opt. 1490 zotx1(ji,jj) = 0.5 * ( un (ji,jj,1) + un (ji-1,jj ,1) ) * zfr_l(ji,jj) & 1491 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) 1492 zoty1(ji,jj) = 0.5 * ( vn (ji,jj,1) + vn (ji ,jj-1,1) ) * zfr_l(ji,jj) & 1493 & + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 1494 END DO 1495 END DO 1496 CASE( 'I' ) ! Ocean on C grid, Ice on I-point (B-grid) ==> T 1497 DO jj = 2, jpjm1 1498 DO ji = 2, jpim1 ! NO vector opt. 1499 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1500 & + 0.25 * ( u_ice(ji+1,jj+1) + u_ice(ji,jj+1) & 1501 & + u_ice(ji+1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1502 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1503 & + 0.25 * ( v_ice(ji+1,jj+1) + v_ice(ji,jj+1) & 1504 & + v_ice(ji+1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1505 END DO 1506 END DO 1507 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 1508 DO jj = 2, jpjm1 1509 DO ji = 2, jpim1 ! NO vector opt. 1510 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 1511 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 1512 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 1513 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 1514 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1515 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1516 END DO 1517 END DO 1518 END SELECT 1519 END SELECT 1520 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1911 CALL lbc_lnk( zotx1, ssnd(jps_ocx1)%clgrid, -1. ) ; CALL lbc_lnk( zoty1, ssnd(jps_ocy1)%clgrid, -1. ) 1912 ! 1913 ENDIF 1521 1914 ! 1522 1915 ! … … 1558 1951 ENDIF 1559 1952 ! 1953 ! 1954 ! Fields sent by OPA to SAS when doing OPA<->SAS coupling 1955 ! ! SSH 1956 IF( ssnd(jps_ssh )%laction ) THEN 1957 ! ! removed inverse barometer ssh when Patm 1958 ! forcing is used (for sea-ice dynamics) 1959 IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 1960 ELSE ; ztmp1(:,:) = sshn(:,:) 1961 ENDIF 1962 CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info ) 1963 1964 ENDIF 1965 ! ! SSS 1966 IF( ssnd(jps_soce )%laction ) THEN 1967 CALL cpl_snd( jps_soce , isec, RESHAPE ( tsn(:,:,1,jp_sal), (/jpi,jpj,1/) ), info ) 1968 ENDIF 1969 ! ! first T level thickness 1970 IF( ssnd(jps_e3t1st )%laction ) THEN 1971 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( fse3t_n(:,:,1) , (/jpi,jpj,1/) ), info ) 1972 ENDIF 1973 ! ! Qsr fraction 1974 IF( ssnd(jps_fraqsr)%laction ) THEN 1975 CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info ) 1976 ENDIF 1977 ! 1978 ! Fields sent by SAS to OPA when OASIS coupling 1979 ! ! Solar heat flux 1980 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) 1981 IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info ) 1982 IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info ) 1983 IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info ) 1984 IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info ) 1985 IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info ) 1986 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 1987 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 1988 1560 1989 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 1561 1990 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r5215 r5407 138 138 IF ( ksbc == jp_flx ) THEN 139 139 CALL cice_sbc_force(kt) 140 ELSE IF ( ksbc == jp_ cpl ) THEN140 ELSE IF ( ksbc == jp_purecpl ) THEN 141 141 CALL sbc_cpl_ice_flx( 1.0-fr_i ) 142 142 ENDIF … … 146 146 CALL cice_sbc_out ( kt, ksbc ) 147 147 148 IF ( ksbc == jp_ cpl ) CALL cice_sbc_hadgam(kt+1)148 IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1) 149 149 150 150 ENDIF ! End sea-ice time step only … … 187 187 188 188 ! Do some CICE consistency checks 189 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_ cpl) ) THEN189 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 190 190 IF ( calc_strair .OR. calc_Tsfc ) THEN 191 191 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) … … 212 212 213 213 CALL cice2nemo(aice,fr_i, 'T', 1. ) 214 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_ cpl) ) THEN214 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 215 215 DO jl=1,ncat 216 216 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 319 319 ! forced and coupled case 320 320 321 IF ( (ksbc == jp_flx).OR.(ksbc == jp_ cpl) ) THEN321 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 322 322 323 323 ztmpn(:,:,:)=0.0 … … 587 587 ELSE IF (ksbc == jp_core) THEN 588 588 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 589 ELSE IF (ksbc == jp_ cpl) THEN589 ELSE IF (ksbc == jp_purecpl) THEN 590 590 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 591 591 ! This is currently as required with the coupling fields from the UM atmosphere … … 623 623 ENDIF 624 624 ! Take into account snow melting except for fully coupled when already in qns_tot 625 IF (ksbc == jp_ cpl) THEN625 IF (ksbc == jp_purecpl) THEN 626 626 qsr(:,:)= qsr_tot(:,:) 627 627 qns(:,:)= qns_tot(:,:) … … 658 658 659 659 CALL cice2nemo(aice,fr_i,'T', 1. ) 660 IF ( (ksbc == jp_flx).OR.(ksbc == jp_ cpl) ) THEN660 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 661 661 DO jl=1,ncat 662 662 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4990 r5407 105 105 fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 106 106 107 IF( l k_cpl ) a_i(:,:,1) = fr_i(:,:)107 IF( ln_cpl ) a_i(:,:,1) = fr_i(:,:) 108 108 109 109 ! Flux and ice fraction computation -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5341 r5407 110 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_os, zalb_cs ! ice albedo under overcast/clear sky 111 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_ice ! mean ice albedo (for coupled) 112 REAL(wp), POINTER, DIMENSION(:,: ) :: zutau_ice, zvtau_ice 112 113 !!---------------------------------------------------------------------- 113 114 … … 115 116 116 117 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only 118 117 119 !-----------------------! 118 120 ! --- Bulk Formulae --- ! … … 124 126 t_bo(:,:) = ( eos_fzp( sss_m ) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 125 127 ! 126 ! Ice albedo 127 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 128 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 129 130 ! CORE and COUPLED bulk formulations 131 SELECT CASE( kblk ) 132 CASE( jp_core , jp_cpl ) 133 134 ! albedo depends on cloud fraction because of non-linear spectral effects 135 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 136 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 137 ! (zalb_ice) is computed within the bulk routine 138 139 END SELECT 128 !!clem ! Ice albedo 129 !!clem CALL wrk_@lloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 130 !!clem CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 131 !! 132 !! ! CORE and COUPLED bulk formulations 133 !! SELECT CASE( kblk ) 134 !! CASE( jp_core , jp_purecpl ) 135 !! ! albedo depends on cloud fraction because of non-linear spectral effects 136 !! zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 137 !! ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 138 !! ! (zalb_ice) is computed within the bulk routine 139 !!clem END SELECT 140 140 141 141 ! Mask sea ice surface temperature (set to rt0 over land) … … 154 154 SELECT CASE( kblk ) 155 155 CASE( jp_clio ) ! CLIO bulk formulation 156 CALL blk_ice_clio( t_su , zalb_cs , zalb_os , zalb_ice , & 157 & utau_ice , vtau_ice , qns_ice , qsr_ice , & 158 & qla_ice , dqns_ice , dqla_ice , & 159 & tprecip , sprecip , & 160 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 161 ! 162 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 163 & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 156 !!clem CALL blk_ice_clio( t_su , zalb_cs , zalb_os , zalb_ice , & 157 !! & utau_ice , vtau_ice , qns_ice , qsr_ice , & 158 !! & qla_ice , dqns_ice , dqla_ice , & 159 !! & tprecip , sprecip , & 160 !! & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 161 !! ! 162 !! IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 163 !! & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 164 CALL blk_ice_clio_tau 164 165 165 166 CASE( jp_core ) ! CORE bulk formulation 166 CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , &167 & utau_ice , vtau_ice , qns_ice , qsr_ice , &168 & qla_ice , dqns_ice , dqla_ice , &169 & tprecip , sprecip , &170 & fr1_i0 , fr2_i0 , cp_ice_msh, jpl )171 ! 172 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 173 & dqns_ice, qla_ice, dqla_ice, nn_limflx )167 !!clem CALL blk_ice_core( t_su , u_ice , v_ice , zalb_ice , & 168 !!clem & utau_ice , vtau_ice , qns_ice , qsr_ice , & 169 !!clem & qla_ice , dqns_ice , dqla_ice , & 170 !!clem & tprecip , sprecip , & 171 !!clem & fr1_i0 , fr2_i0 , cp_ice_msh, jpl ) 172 !!clem IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 173 !!clem & dqns_ice, qla_ice, dqla_ice, nn_limflx ) 174 CALL blk_ice_core_tau 174 175 ! 175 CASE ( jp_ cpl )176 CASE ( jp_purecpl ) 176 177 177 178 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) … … 179 180 END SELECT 180 181 181 !------------------------------! 182 ! --- LIM-3 main time-step --- ! 183 !------------------------------! 182 IF( ln_mixcpl) THEN 183 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 184 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 185 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 186 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 187 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 188 ENDIF 189 190 ! !----------------------! 191 ! ! LIM-3 time-stepping ! 192 ! !----------------------! 193 ! 184 194 numit = numit + nn_fsbc ! Ice model time step 185 195 ! … … 220 230 phicif(:,:) = vt_i(:,:) 221 231 232 ! Ice albedo 233 CALL wrk_alloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 234 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 235 222 236 SELECT CASE( kblk ) 223 CASE ( jp_cpl ) 224 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 237 CASE( jp_clio ) ! CLIO bulk formulation 238 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 239 ! (zalb_ice) is computed within the bulk routine 240 ! CALL blk_ice_clio_flx( t_su , zalb_cs, zalb_os , zalb_ice, qns_ice , qsr_ice , & 241 ! & qla_ice, dqns_ice , dqla_ice , tprecip, sprecip , & 242 ! & fr1_i0 , fr2_i0 , jpl ) 243 ! ! 244 CALL blk_ice_clio_flx( t_su, zalb_cs, zalb_os, zalb_ice ) 245 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 246 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 247 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 248 249 CASE( jp_core ) ! CORE bulk formulation 250 ! albedo depends on cloud fraction because of non-linear spectral effects 251 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 252 CALL blk_ice_core_flx( t_su, zalb_ice ) 253 IF( ln_mixcpl ) CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 254 IF( nn_limflx /= 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 255 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 256 257 CASE ( jp_purecpl ) 258 ! albedo depends on cloud fraction because of non-linear spectral effects 259 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 260 CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=zalb_ice, psst=sst_m, pist=t_su ) 225 261 IF( nn_limflx == 2 ) CALL ice_lim_flx( t_su, zalb_ice, qns_ice, qsr_ice , & 226 & dqns_ice, qla_ice, dqla_ice, nn_limflx )262 & dqns_ice, evap_ice, devap_ice, nn_limflx ) 227 263 ! Latent heat flux is forced to 0 in coupled: it is included in qns (non-solar heat flux) 228 qla_ice (:,:,:) = 0._wp 229 dqla_ice (:,:,:) = 0._wp 264 evap_ice (:,:,:) = 0._wp 265 devap_ice (:,:,:) = 0._wp 266 230 267 END SELECT 268 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) 269 231 270 ! 232 271 CALL lim_thd( kt ) ! Ice thermodynamics … … 247 286 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 248 287 ! 249 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice )250 288 ! 251 289 ENDIF ! End sea-ice time step only … … 476 514 477 515 SUBROUTINE ice_lim_flx( ptn_ice, palb_ice, pqns_ice, pqsr_ice, & 478 & pdqn_ice, p qla_ice, pdql_ice, k_limflx )516 & pdqn_ice, pevap_ice, pdevap_ice, k_limflx ) 479 517 !!--------------------------------------------------------------------- 480 518 !! *** ROUTINE ice_lim_flx *** … …