Changeset 5407
- Timestamp:
- 2015-06-11T21:13:22+02:00 (9 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 *** … … 494 532 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pqsr_ice ! net solar flux 495 533 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdqn_ice ! non solar flux sensitivity 496 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p qla_ice ! latent heat flux497 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pd ql_ice ! latent heat fluxsensitivity534 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pevap_ice ! sublimation 535 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdevap_ice ! sublimation sensitivity 498 536 ! 499 537 INTEGER :: jl ! dummy loop index … … 504 542 REAL(wp), POINTER, DIMENSION(:,:) :: z_qsr_m ! Mean solar heat flux over all categories 505 543 REAL(wp), POINTER, DIMENSION(:,:) :: z_qns_m ! Mean non solar heat flux over all categories 506 REAL(wp), POINTER, DIMENSION(:,:) :: z_ qla_m ! Mean latent heat fluxover all categories544 REAL(wp), POINTER, DIMENSION(:,:) :: z_evap_m ! Mean sublimation over all categories 507 545 REAL(wp), POINTER, DIMENSION(:,:) :: z_dqn_m ! Mean d(qns)/dT over all categories 508 REAL(wp), POINTER, DIMENSION(:,:) :: z_d ql_m ! Mean d(qla)/dT over all categories546 REAL(wp), POINTER, DIMENSION(:,:) :: z_devap_m ! Mean d(evap)/dT over all categories 509 547 !!---------------------------------------------------------------------- 510 548 … … 514 552 SELECT CASE( k_limflx ) !== averaged on all ice categories ==! 515 553 CASE( 0 , 1 ) 516 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)554 CALL wrk_alloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 517 555 ! 518 556 z_qns_m(:,:) = fice_ice_ave ( pqns_ice (:,:,:) ) 519 557 z_qsr_m(:,:) = fice_ice_ave ( pqsr_ice (:,:,:) ) 520 558 z_dqn_m(:,:) = fice_ice_ave ( pdqn_ice (:,:,:) ) 521 z_ qla_m(:,:) = fice_ice_ave ( pqla_ice (:,:,:) )522 z_d ql_m(:,:) = fice_ice_ave ( pdql_ice (:,:,:) )559 z_evap_m(:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 560 z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 523 561 DO jl = 1, jpl 524 562 pdqn_ice(:,:,jl) = z_dqn_m(:,:) 525 pd ql_ice(:,:,jl) = z_dql_m(:,:)563 pdevap_ice(:,:,jl) = z_devap_m(:,:) 526 564 END DO 527 565 ! … … 529 567 pqns_ice(:,:,jl) = z_qns_m(:,:) 530 568 pqsr_ice(:,:,jl) = z_qsr_m(:,:) 531 p qla_ice(:,:,jl) = z_qla_m(:,:)569 pevap_ice(:,:,jl) = z_evap_m(:,:) 532 570 END DO 533 571 ! 534 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_ qla_m, z_dqn_m, z_dql_m)572 CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 535 573 END SELECT 536 574 … … 543 581 DO jl = 1, jpl 544 582 pqns_ice(:,:,jl) = pqns_ice(:,:,jl) + pdqn_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 545 p qla_ice(:,:,jl) = pqla_ice(:,:,jl) + pdql_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:))583 pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * (ptn_ice(:,:,jl) - ztem_m(:,:)) 546 584 pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 547 585 END DO … … 593 631 wfx_spr(:,:) = 0._wp ; 594 632 595 hfx_in (:,:) = 0._wp ; hfx_out(:,:) = 0._wp596 633 hfx_thd(:,:) = 0._wp ; 597 634 hfx_snw(:,:) = 0._wp ; hfx_opw(:,:) = 0._wp … … 610 647 611 648 END SUBROUTINE sbc_lim_diag0 612 649 650 613 651 FUNCTION fice_cell_ave ( ptab ) 614 652 !!-------------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r5385 r5407 101 101 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo 102 102 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K) 103 REAL(wp), DIMENSION(:,: ), POINTER :: zutau_ice, zvtau_ice 103 104 !!---------------------------------------------------------------------- 104 105 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )106 105 107 106 IF( kt == nit000 ) THEN … … 124 123 &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 125 124 # endif 125 126 CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice) 127 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 128 126 129 ! Bulk Formulea ! 127 130 !----------------! … … 132 135 DO ji = 2, jpi ! NO vector opt. possible 133 136 u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) * umask(ji-1,jj ,1) & 134 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)137 & + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj) 135 138 v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) * vmask(ji ,jj-1,1) & 136 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)139 & + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj) 137 140 END DO 138 141 END DO … … 158 161 159 162 SELECT CASE( ksbc ) 160 CASE( jp_core , jp_ cpl ) ! CORE and COUPLED bulk formulations163 CASE( jp_core , jp_purecpl ) ! CORE and COUPLED bulk formulations 161 164 162 165 ! albedo depends on cloud fraction because of non-linear spectral effects … … 182 185 SELECT CASE( ksbc ) 183 186 CASE( jp_clio ) ! CLIO bulk formulation 184 CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 185 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 186 & qla_ice , dqns_ice , dqla_ice , & 187 & tprecip , sprecip , & 188 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 187 ! CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 188 ! & utau_ice , vtau_ice , qns_ice , qsr_ice, & 189 ! & qla_ice , dqns_ice , dqla_ice , & 190 ! & tprecip , sprecip , & 191 ! & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 192 CALL blk_ice_clio_tau 193 CALL blk_ice_clio_flx( zsist, zalb_cs, zalb_os, zalb_ice ) 189 194 190 195 CASE( jp_core ) ! CORE bulk formulation 191 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice , & 192 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 193 & qla_ice , dqns_ice , dqla_ice , & 194 & tprecip , sprecip , & 195 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 196 197 CASE( jp_cpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 196 CALL blk_ice_core_tau 197 CALL blk_ice_core_flx( zsist, zalb_ice ) 198 199 CASE( jp_purecpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 198 200 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 199 201 END SELECT 202 203 IF( ln_mixcpl) THEN 204 CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 205 utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 206 vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 207 ENDIF 200 208 201 209 CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point … … 227 235 END IF 228 236 ! ! Ice surface fluxes in coupled mode 229 IF( ksbc == jp_cpl ) THEN237 IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations 230 238 a_i(:,:,1)=fr_i 231 239 CALL sbc_cpl_ice_flx( frld, & … … 249 257 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt ) 250 258 # endif 259 ! 260 CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice) 261 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 251 262 ! 252 263 ENDIF ! End sea-ice time step only … … 260 271 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 261 272 ! 262 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )263 !264 273 END SUBROUTINE sbc_ice_lim_2 265 274 -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5385 r5407 39 39 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 40 40 USE sbccpl ! surface boundary condition: coupled florulation 41 USE cpl_oasis3 ! OASIS routines for coupling 41 42 USE sbcssr ! surface boundary condition: sea surface restoring 42 43 USE sbcrnf ! surface boundary condition: runoffs … … 84 85 INTEGER :: icpt ! local integer 85 86 !! 86 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, & 87 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 88 & ln_ssr , nn_isf , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 87 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl, & 88 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf , & 89 & ln_ssr , nn_isf , nn_fwb, ln_cdgw , ln_wave , ln_sdw , & 90 & nn_lsm , nn_limflx , nn_components, ln_cpl 89 91 INTEGER :: ios 92 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3, jpm 93 LOGICAL :: ll_purecpl 90 94 !!---------------------------------------------------------------------- 91 95 … … 115 119 nn_ice = 0 116 120 ENDIF 117 121 118 122 IF(lwp) THEN ! Control print 119 123 WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)' … … 125 129 WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core 126 130 WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs 127 WRITE(numout,*) ' coupled formulation (T if key_oasis3) lk_cpl = ', lk_cpl 131 WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl 132 WRITE(numout,*) ' forced-coupled mixed formulation ln_mixcpl = ', ln_mixcpl 133 WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis 134 WRITE(numout,*) ' components of your executable nn_components = ', nn_components 128 135 WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx 129 136 WRITE(numout,*) ' Misc. options of sbc : ' … … 152 159 END SELECT 153 160 ! 161 IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis ) & 162 & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' ) 163 IF ( nn_components == jp_iam_opa .AND. ln_cpl ) & 164 & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' ) 165 IF ( nn_components == jp_iam_opa .AND. ln_mixcpl ) & 166 & CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' ) 167 IF ( ln_cpl .AND. .NOT. lk_oasis ) & 168 & CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' ) 169 IF( ln_mixcpl .AND. .NOT. lk_oasis ) & 170 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' ) 171 IF( ln_mixcpl .AND. .NOT. ln_cpl ) & 172 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' ) 173 IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo ) & 174 & CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' ) 175 154 176 ! ! allocate sbc arrays 155 177 IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' ) … … 170 192 fwfisf_b(:,:) = 0.0_wp 171 193 END IF 172 IF( nn_ice == 0 ) fr_i(:,:) = 0.e0! no ice in the domain, ice fraction is always zero194 IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero 173 195 174 196 sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) … … 180 202 181 203 ! ! restartability 182 IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. & 183 MOD( nstock , nn_fsbc) /= 0 ) THEN 184 WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, & 185 & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 186 CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 187 ENDIF 188 ! 189 IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) & 190 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 191 ! 192 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) ) & 204 IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) ) & 193 205 & CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' ) 194 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. l k_cpl ) ) &195 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or l k_cpl' )206 IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) ) & 207 & CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' ) 196 208 IF( nn_ice == 4 .AND. lk_agrif ) & 197 209 & CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' ) … … 200 212 IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) & 201 213 & WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 202 IF( ( nn_ice == 3 ) .AND. ( l k_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) &214 IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) & 203 215 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 204 IF( ( nn_ice == 3 ) .AND. ( .NOT. l k_cpl ) .AND. ( nn_limflx == 2 ) ) &216 IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) ) & 205 217 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 206 218 207 219 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag 208 220 209 IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) ) &221 IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa ) & 210 222 & CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' ) 211 223 212 IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) &213 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )214 215 224 IF ( ln_wave ) THEN 216 225 !Activated wave module but neither drag nor stokes drift activated … … 227 236 ENDIF 228 237 ! ! Choice of the Surface Boudary Condition (set nsbc) 238 ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl 239 ! 229 240 icpt = 0 230 IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation 231 IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation 232 IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation 233 IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation 234 IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation 235 IF( lk_cpl ) THEN ; nsbc = jp_cpl ; icpt = icpt + 1 ; ENDIF ! Coupled formulation 236 IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation 237 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 241 IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation 242 IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation 243 IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation 244 IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation 245 IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation 246 IF( ll_purecpl ) THEN ; nsbc = jp_purecpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation 247 IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation 248 IF( nn_components == jp_iam_opa ) & 249 & THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module 250 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 238 251 ! 239 252 IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN … … 246 259 IF(lwp) THEN 247 260 WRITE(numout,*) 248 IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 249 IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation' 250 IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation' 251 IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation' 252 IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation' 253 IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation' 254 IF( nsbc == jp_cpl ) WRITE(numout,*) ' coupled formulation' 255 IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation' 256 ENDIF 257 ! 261 IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 262 IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation' 263 IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation' 264 IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation' 265 IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation' 266 IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation' 267 IF( nsbc == jp_purecpl ) WRITE(numout,*) ' pure coupled formulation' 268 IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation' 269 IF( nsbc == jp_none ) WRITE(numout,*) ' OPA coupled to SAS via oasis' 270 IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation' 271 IF( nn_components/= jp_iam_nemo ) & 272 & WRITE(numout,*) ' + OASIS coupled SAS' 273 ENDIF 274 ! 275 IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step 276 ! ! (2) the use of nn_fsbc 277 278 ! nn_fsbc initialization if OPA-SAS coupling via OASIS 279 ! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 280 IF ( nn_components /= jp_iam_nemo ) THEN 281 282 IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt) 283 IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt) 284 ! 285 IF(lwp)THEN 286 WRITE(numout,*) 287 WRITE(numout,*)" OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 288 WRITE(numout,*) 289 ENDIF 290 ENDIF 291 292 IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR. & 293 MOD( nstock , nn_fsbc) /= 0 ) THEN 294 WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock, & 295 & ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')' 296 CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' ) 297 ENDIF 298 ! 299 IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) & 300 & CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' ) 301 ! 302 IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) ) < 8 ) ) & 303 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 304 258 305 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 259 306 ! … … 265 312 266 313 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 267 !268 IF( nsbc == jp_cpl ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step269 314 270 315 END SUBROUTINE sbc_init … … 310 355 ! (caution called before sbc_ssm) 311 356 ! 312 CALL sbc_ssm( kt )! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)313 ! ! averaged over nf_sbc time-step357 IF( nn_components /= jp_iam_sas ) CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 358 ! ! averaged over nf_sbc time-step 314 359 315 360 IF (ln_wave) CALL sbc_wave( kt ) … … 322 367 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 323 368 CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean 324 CASE( jp_core ) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 325 CASE( jp_cpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation 369 CASE( jp_core ) 370 IF( nn_components == jp_iam_sas ) & 371 & CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA 372 CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 373 ! from oce: sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 374 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation 375 ! 326 376 CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean 377 CASE( jp_none ) 378 IF( nn_components == jp_iam_opa ) & 379 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS 327 380 CASE( jp_esopa ) 328 381 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations … … 334 387 END SELECT 335 388 389 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing 390 391 336 392 ! !== Misc. Options ==! 337 393 … … 356 412 ! ! (update freshwater fluxes) 357 413 !RBbug do not understand why see ticket 667 358 !clem-bugsal CALL lbc_lnk( emp, 'T', 1. ) 414 !clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why. 415 CALL lbc_lnk( emp, 'T', 1. ) 359 416 ! 360 417 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! … … 397 454 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 398 455 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 399 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx)456 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 400 457 ENDIF 401 458 … … 412 469 CALL iom_put( "qns" , qns ) ! solar heat flux 413 470 CALL iom_put( "qsr" , qsr ) ! solar heat flux 414 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction471 IF( nn_ice > 0 .OR. nn_components == jp_iam_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 415 472 CALL iom_put( "taum" , taum ) ! wind stress module 416 473 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5385 r5407 32 32 33 33 PUBLIC sbc_rnf ! routine call in sbcmod module 34 PUBLIC sbc_rnf_div ! routine called in sshwzvmodule34 PUBLIC sbc_rnf_div ! routine called in divcurl module 35 35 PUBLIC sbc_rnf_alloc ! routine call in sbcmod module 36 36 PUBLIC sbc_rnf_init ! (PUBLIC for TAM) … … 44 44 LOGICAL , PUBLIC :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 45 45 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file 46 LOGICAL , PUBLIC :: ln_rnf_emp !: runoffs into a file to be read or already into precipitation47 46 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 48 47 TYPE(FLD_N) , PUBLIC :: sn_cnf !: information about the runoff mouth file to be read … … 54 53 REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s] 55 54 REAL(wp) , PUBLIC :: rn_rfact !: multiplicative factor for runoff 55 56 LOGICAL , PUBLIC :: l_rnfcpl = .false. ! runoffs recieved from oasis 56 57 57 58 INTEGER , PUBLIC :: nkrnf = 0 !: nb of levels over which Kz is increased at river mouths … … 117 118 ENDIF 118 119 119 ! !-------------------! 120 IF( .NOT. ln_rnf_emp ) THEN ! Update runoff ! 121 ! !-------------------! 122 ! 123 CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 124 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 125 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 126 ! 127 ! Runoff reduction only associated to the ORCA2_LIM configuration 128 ! when reading the NetCDF file runoff_1m_nomask.nc 129 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN 130 WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 131 sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 120 ! !-------------------! 121 ! ! Update runoff ! 122 ! !-------------------! 123 ! 124 IF( .NOT. l_rnfcpl ) CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 125 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 126 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 127 ! 128 ! Runoff reduction only associated to the ORCA2_LIM configuration 129 ! when reading the NetCDF file runoff_1m_nomask.nc 130 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl ) THEN 131 WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp ) 132 sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1) 133 END WHERE 134 ENDIF 135 ! 136 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 137 ! 138 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 139 ! 140 ! ! set temperature & salinity content of runoffs 141 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 142 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 143 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature 144 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 132 145 END WHERE 133 ENDIF 134 ! 135 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 136 ! 137 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) ! updated runoff value at time step kt 138 ! 139 ! ! set temperature & salinity content of runoffs 140 IF( ln_rnf_tem ) THEN ! use runoffs temperature data 141 rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 142 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp ) ! if missing data value use SST as runoffs temperature 143 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 144 END WHERE 145 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 146 ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 147 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 148 END WHERE 149 ELSE ! use SST as runoffs temperature 150 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 151 ENDIF 152 ! ! use runoffs salinity data 153 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 154 ! ! else use S=0 for runoffs (done one for all in the init) 155 IF ( ANY( rnf(:,:) < 0._wp ) ) z_err=1 156 IF(lk_mpp) CALL mpp_sum(z_err) 157 IF( z_err > 0 ) CALL ctl_stop( 'sbc_rnf : negative runnoff values exist' ) 158 ! 159 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 160 ENDIF 161 ! 162 ENDIF 163 ! 146 WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp ) ! where fwf comes from melting of ice shelves or iceberg 147 ztfrz(:,:) = -1.9 !tfreez( sss_m(:,:) ) !PM to be discuss (trouble if sensitivity study) 148 rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * lfusisf * r1_rau0_rcp 149 END WHERE 150 ELSE ! use SST as runoffs temperature 151 rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 152 ENDIF 153 ! ! use runoffs salinity data 154 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 155 ! ! else use S=0 for runoffs (done one for all in the init) 156 CALL iom_put( "runoffs", rnf ) ! output runoffs arrays 157 ENDIF 158 ! 159 ! ! ---------------------------------------- ! 164 160 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 165 161 ! ! ---------------------------------------- ! … … 172 168 ELSE !* no restart: set from nit000 values 173 169 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' 174 175 170 rnf_b (:,: ) = rnf (:,: ) 171 rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 176 172 ENDIF 177 173 ENDIF … … 187 183 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 188 184 ENDIF 185 ! 189 186 CALL wrk_dealloc( jpi,jpj, ztfrz) 190 187 ! … … 265 262 REAL(wp), DIMENSION(:,: ), ALLOCATABLE :: zrnf 266 263 ! 267 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, &264 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, & 268 265 & sn_rnf, sn_cnf , sn_s_rnf , sn_t_rnf , sn_dep_rnf, & 269 266 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, & … … 290 287 WRITE(numout,*) '~~~~~~~ ' 291 288 WRITE(numout,*) ' Namelist namsbc_rnf' 292 WRITE(numout,*) ' runoff in a file to be read ln_rnf_emp = ', ln_rnf_emp293 289 WRITE(numout,*) ' specific river mouths treatment ln_rnf_mouth = ', ln_rnf_mouth 294 290 WRITE(numout,*) ' river mouth additional Kz rn_avt_rnf = ', rn_avt_rnf … … 296 292 WRITE(numout,*) ' multiplicative factor for runoff rn_rfact = ', rn_rfact 297 293 ENDIF 298 !299 294 ! ! ================== 300 295 ! ! Type of runoff … … 303 298 IF( sbc_rnf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' ) 304 299 ! 305 IF( ln_rnf_emp ) THEN !== runoffs directly provided in the precipitations ==! 306 IF(lwp) WRITE(numout,*) 307 IF(lwp) WRITE(numout,*) ' runoffs directly provided in the precipitations' 308 IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal .OR. ln_rnf_depth_ini ) THEN 309 CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 310 ln_rnf_depth = .FALSE. ; ln_rnf_tem = .FALSE. ; ln_rnf_sal = .FALSE. ; ln_rnf_depth_ini = .FALSE. 311 ENDIF 312 ! 313 ELSE !== runoffs read in a file : set sf_rnf structure ==! 314 ! 300 IF( .NOT. l_rnfcpl ) THEN 315 301 ALLOCATE( sf_rnf(1), STAT=ierror ) ! Create sf_rnf structure (runoff inflow) 316 302 IF(lwp) WRITE(numout,*) … … 321 307 ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 322 308 IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 323 ! ! fill sf_rnf with the namelist (sn_rnf) and control print324 309 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' ) 325 ! 326 IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure 327 IF(lwp) WRITE(numout,*) 328 IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file' 329 ALLOCATE( sf_t_rnf(1), STAT=ierror ) 330 IF( ierror > 0 ) THEN 331 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' ) ; RETURN 332 ENDIF 333 ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1) ) 334 IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 335 CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 336 ENDIF 337 ! 338 IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures 339 IF(lwp) WRITE(numout,*) 340 IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file' 341 ALLOCATE( sf_s_rnf(1), STAT=ierror ) 342 IF( ierror > 0 ) THEN 343 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' ) ; RETURN 344 ENDIF 345 ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1) ) 346 IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 347 CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 348 ENDIF 349 ! 350 IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file 351 IF(lwp) WRITE(numout,*) 352 IF(lwp) WRITE(numout,*) ' runoffs depth read in a file' 353 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 354 IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year 355 IF( sn_dep_rnf%cltype == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month 356 ENDIF 357 CALL iom_open ( rn_dep_file, inum ) ! open file 358 CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array 359 CALL iom_close( inum ) ! close file 360 ! 361 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 362 DO jj = 1, jpj 363 DO ji = 1, jpi 364 IF( h_rnf(ji,jj) > 0._wp ) THEN 365 jk = 2 366 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 ; END DO 367 nk_rnf(ji,jj) = jk 368 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 369 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 370 ELSE 371 CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 372 WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 373 ENDIF 310 ENDIF 311 ! 312 IF( ln_rnf_tem ) THEN ! Create (if required) sf_t_rnf structure 313 IF(lwp) WRITE(numout,*) 314 IF(lwp) WRITE(numout,*) ' runoffs temperatures read in a file' 315 ALLOCATE( sf_t_rnf(1), STAT=ierror ) 316 IF( ierror > 0 ) THEN 317 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' ) ; RETURN 318 ENDIF 319 ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1) ) 320 IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) ) 321 CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' ) 322 ENDIF 323 ! 324 IF( ln_rnf_sal ) THEN ! Create (if required) sf_s_rnf and sf_t_rnf structures 325 IF(lwp) WRITE(numout,*) 326 IF(lwp) WRITE(numout,*) ' runoffs salinities read in a file' 327 ALLOCATE( sf_s_rnf(1), STAT=ierror ) 328 IF( ierror > 0 ) THEN 329 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' ) ; RETURN 330 ENDIF 331 ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1) ) 332 IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) ) 333 CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' ) 334 ENDIF 335 ! 336 IF( ln_rnf_depth ) THEN ! depth of runoffs set from a file 337 IF(lwp) WRITE(numout,*) 338 IF(lwp) WRITE(numout,*) ' runoffs depth read in a file' 339 rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 340 IF( .NOT. sn_dep_rnf%ln_clim ) THEN ; WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear ! add year 341 IF( sn_dep_rnf%cltype == 'monthly' ) WRITE(rn_dep_file, '(a,"m",i2)' ) TRIM( rn_dep_file ), nmonth ! add month 342 ENDIF 343 CALL iom_open ( rn_dep_file, inum ) ! open file 344 CALL iom_get ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf ) ! read the river mouth array 345 CALL iom_close( inum ) ! close file 346 ! 347 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 348 DO jj = 1, jpj 349 DO ji = 1, jpi 350 IF( h_rnf(ji,jj) > 0._wp ) THEN 351 jk = 2 352 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 353 END DO 354 nk_rnf(ji,jj) = jk 355 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 356 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 357 ELSE 358 CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 359 WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 360 ENDIF 361 END DO 362 END DO 363 DO jj = 1, jpj ! set the associated depth 364 DO ji = 1, jpi 365 h_rnf(ji,jj) = 0._wp 366 DO jk = 1, nk_rnf(ji,jj) 367 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 374 368 END DO 375 369 END DO 376 DO jj = 1, jpj ! set the associated depth 377 DO ji = 1, jpi 378 h_rnf(ji,jj) = 0._wp 379 DO jk = 1, nk_rnf(ji,jj) 380 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 370 END DO 371 ! 372 ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface 373 ! 374 IF(lwp) WRITE(numout,*) 375 IF(lwp) WRITE(numout,*) ' depth of runoff computed once from max value of runoff' 376 IF(lwp) WRITE(numout,*) ' max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 377 IF(lwp) WRITE(numout,*) ' depth over which runoffs is spread rn_dep_max = ', rn_dep_max 378 IF(lwp) WRITE(numout,*) ' create (=1) a runoff depth file or not (=0) nn_rnf_depth_file = ', nn_rnf_depth_file 379 380 CALL iom_open( TRIM( sn_rnf%clname ), inum ) ! open runoff file 381 CALL iom_gettime( inum, zrec, kntime=nbrec) 382 ALLOCATE( zrnfcl(jpi,jpj,nbrec) ) ; ALLOCATE( zrnf(jpi,jpj) ) 383 DO jm = 1, nbrec 384 CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm ) 385 END DO 386 CALL iom_close( inum ) 387 zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 ) ! maximum value in time 388 DEALLOCATE( zrnfcl ) 389 ! 390 h_rnf(:,:) = 1. 391 ! 392 zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff) 393 ! 394 WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs 395 ! 396 DO jj = 1, jpj ! take in account min depth of ocean rn_hmin 397 DO ji = 1, jpi 398 IF( zrnf(ji,jj) > 0._wp ) THEN 399 jk = mbkt(ji,jj) 400 h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) ) 401 ENDIF 402 END DO 403 END DO 404 ! 405 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 406 DO jj = 1, jpj 407 DO ji = 1, jpi 408 IF( zrnf(ji,jj) > 0._wp ) THEN 409 jk = 2 410 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 381 411 END DO 412 nk_rnf(ji,jj) = jk 413 ELSE 414 nk_rnf(ji,jj) = 1 415 ENDIF 416 END DO 417 END DO 418 ! 419 DEALLOCATE( zrnf ) 420 ! 421 DO jj = 1, jpj ! set the associated depth 422 DO ji = 1, jpi 423 h_rnf(ji,jj) = 0._wp 424 DO jk = 1, nk_rnf(ji,jj) 425 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 382 426 END DO 383 427 END DO 384 ! 385 ELSE IF( ln_rnf_depth_ini ) THEN ! runoffs applied at the surface 386 ! 387 IF(lwp) WRITE(numout,*) 388 IF(lwp) WRITE(numout,*) ' depth of runoff computed once from max value of runoff' 389 IF(lwp) WRITE(numout,*) ' max value of the runoff climatologie (over global domain) rn_rnf_max = ', rn_rnf_max 390 IF(lwp) WRITE(numout,*) ' depth over which runoffs is spread rn_dep_max = ', rn_dep_max 391 IF(lwp) WRITE(numout,*) ' create (=1) a runoff depth file or not (=0) nn_rnf_depth_file = ', nn_rnf_depth_file 392 393 CALL iom_open( TRIM( sn_rnf%clname ), inum ) ! open runoff file 394 CALL iom_gettime( inum, zrec, kntime=nbrec) 395 ALLOCATE( zrnfcl(jpi,jpj,nbrec) ) ; ALLOCATE( zrnf(jpi,jpj) ) 396 DO jm = 1, nbrec 397 CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,jm), jm ) 398 END DO 399 CALL iom_close( inum ) 400 zrnf(:,:) = MAXVAL( zrnfcl(:,:,:), DIM=3 ) ! maximum value in time 401 DEALLOCATE( zrnfcl ) 402 ! 403 h_rnf(:,:) = 1. 404 ! 405 zacoef = rn_dep_max / rn_rnf_max ! coef of linear relation between runoff and its depth (150m for max of runoff) 406 ! 407 WHERE( zrnf(:,:) > 0._wp ) h_rnf(:,:) = zacoef * zrnf(:,:) ! compute depth for all runoffs 408 ! 409 DO jj = 1, jpj ! take in account min depth of ocean rn_hmin 410 DO ji = 1, jpi 411 IF( zrnf(ji,jj) > 0._wp ) THEN 412 jk = mbkt(ji,jj) 413 h_rnf(ji,jj) = MIN( h_rnf(ji,jj), gdept_0(ji,jj,jk ) ) 414 ENDIF 415 END DO 416 END DO 417 ! 418 nk_rnf(:,:) = 0 ! number of levels on which runoffs are distributed 419 DO jj = 1, jpj 420 DO ji = 1, jpi 421 IF( zrnf(ji,jj) > 0._wp ) THEN 422 jk = 2 423 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 ; END DO 424 nk_rnf(ji,jj) = jk 425 ELSE 426 nk_rnf(ji,jj) = 1 427 ENDIF 428 END DO 429 END DO 430 ! 431 DEALLOCATE( zrnf ) 432 ! 433 DO jj = 1, jpj ! set the associated depth 434 DO ji = 1, jpi 435 h_rnf(ji,jj) = 0._wp 436 DO jk = 1, nk_rnf(ji,jj) 437 h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk) 438 END DO 439 END DO 440 END DO 441 ! 442 IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff 443 IF(lwp) WRITE(numout,*) ' create runoff depht file' 444 CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 445 CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 446 CALL iom_close ( inum ) 447 ENDIF 448 ELSE ! runoffs applied at the surface 449 nk_rnf(:,:) = 1 450 h_rnf (:,:) = fse3t(:,:,1) 451 ENDIF 452 ! 428 END DO 429 ! 430 IF( nn_rnf_depth_file == 1 ) THEN ! save output nb levels for runoff 431 IF(lwp) WRITE(numout,*) ' create runoff depht file' 432 CALL iom_open ( TRIM( sn_dep_rnf%clname ), inum, ldwrt = .TRUE., kiolib = jprstlib ) 433 CALL iom_rstput( 0, 0, inum, 'rodepth', h_rnf ) 434 CALL iom_close ( inum ) 435 ENDIF 436 ELSE ! runoffs applied at the surface 437 nk_rnf(:,:) = 1 438 h_rnf (:,:) = fse3t(:,:,1) 453 439 ENDIF 454 440 ! … … 471 457 IF( rn_hrnf > 0._wp ) THEN 472 458 nkrnf = 2 473 DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1 ; END DO 459 DO WHILE( nkrnf /= jpkm1 .AND. gdepw_1d(nkrnf+1) < rn_hrnf ) ; nkrnf = nkrnf + 1 460 END DO 474 461 IF( ln_sco ) CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' ) 475 462 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r5120 r5407 58 58 REAL(wp) :: zcoef, zf_sbc ! local scalar 59 59 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 60 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb,zdep61 60 !!--------------------------------------------------------------------- 62 61 63 62 ! !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 64 63 DO jj = 1, jpj … … 68 67 END DO 69 68 END DO 70 zub(:,:) = ub (:,:,1 ) 71 zvb(:,:) = vb (:,:,1 ) 72 ! 73 IF( lk_vvl ) THEN 74 zdep(:,:) = fse3t_n(:,:,1) 75 ENDIF 76 ! ! ---------------------------------------- ! 69 ! 77 70 IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields ! 78 71 ! ! ---------------------------------------- ! 79 ssu_m(:,:) = zub(:,:)80 ssv_m(:,:) = zvb(:,:)72 ssu_m(:,:) = ub(:,:,1) 73 ssv_m(:,:) = vb(:,:,1) 81 74 IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 82 75 ELSE ; sst_m(:,:) = zts(:,:,jp_tem) … … 88 81 ENDIF 89 82 ! 90 IF( lk_vvl ) fse3t_m(:,:) = zdep(:,:) 83 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1) 84 ! 85 frq_m(:,:) = fraqsr_1lev(:,:) 91 86 ! 92 87 ELSE … … 97 92 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields initialised to instantaneous values' 98 93 zcoef = REAL( nn_fsbc - 1, wp ) 99 ssu_m(:,:) = zcoef * zub(:,:)100 ssv_m(:,:) = zcoef * zvb(:,:)94 ssu_m(:,:) = zcoef * ub(:,:,1) 95 ssv_m(:,:) = zcoef * vb(:,:,1) 101 96 IF( ln_useCT ) THEN ; sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 102 97 ELSE ; sst_m(:,:) = zcoef * zts(:,:,jp_tem) … … 108 103 ENDIF 109 104 ! 110 IF( lk_vvl ) fse3t_m(:,:) = zcoef * zdep(:,:) 105 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_n(:,:,1) 106 ! 107 frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 111 108 ! ! ---------------------------------------- ! 112 109 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! … … 117 114 sss_m(:,:) = 0.e0 118 115 ssh_m(:,:) = 0.e0 119 IF( lk_vvl ) fse3t_m(:,:) = 0.e0 116 IF( lk_vvl ) e3t_m(:,:) = 0.e0 117 frq_m(:,:) = 0.e0 120 118 ENDIF 121 119 ! ! ---------------------------------------- ! 122 120 ! ! Cumulate at each time step ! 123 121 ! ! ---------------------------------------- ! 124 ssu_m(:,:) = ssu_m(:,:) + zub(:,:)125 ssv_m(:,:) = ssv_m(:,:) + zvb(:,:)122 ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 123 ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 126 124 IF( ln_useCT ) THEN ; sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 127 125 ELSE ; sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) … … 133 131 ENDIF 134 132 ! 135 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 133 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 134 ! 135 frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 136 136 137 137 ! ! ---------------------------------------- ! … … 144 144 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 145 145 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 146 IF( lk_vvl ) fse3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m] 146 IF( lk_vvl ) e3t_m(:,:) = fse3t_m(:,:) * zcoef ! mean vertical scale factor [m] 147 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] 147 148 ! 148 149 ENDIF … … 161 162 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m ) 162 163 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m ) 163 IF( lk_vvl ) THEN 164 CALL iom_rstput( kt, nitrst, numrow, 'fse3t_m' , fse3t_m(:,:) ) 165 END IF 166 ! 167 ENDIF 168 ! 164 IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m ) 165 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m ) 166 ! 167 ENDIF 168 ! 169 ENDIF 170 ! 171 IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN ! Mean value at each nn_fsbc time-step ! 172 CALL iom_put( 'ssu_m', ssu_m ) 173 CALL iom_put( 'ssv_m', ssv_m ) 174 CALL iom_put( 'sst_m', sst_m ) 175 CALL iom_put( 'sss_m', sss_m ) 176 CALL iom_put( 'ssh_m', ssh_m ) 177 IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m ) 178 CALL iom_put( 'frq_m', frq_m ) 169 179 ENDIF 170 180 ! … … 202 212 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point) 203 213 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point) 204 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_m', fse3t_m(:,:) ) 214 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m ) 215 ! fraction of solar net radiation absorbed in 1st T level 216 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 217 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m ) 218 ELSE 219 frq_m(:,:) = 1._wp ! default definition 220 ENDIF 205 221 ! 206 222 IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs … … 213 229 sss_m(:,:) = zcoef * sss_m(:,:) 214 230 ssh_m(:,:) = zcoef * ssh_m(:,:) 215 IF( lk_vvl ) fse3t_m(:,:) = zcoef * fse3t_m(:,:) 231 IF( lk_vvl ) e3t_m(:,:) = zcoef * fse3t_m(:,:) 232 frq_m(:,:) = zcoef * frq_m(:,:) 216 233 ELSE 217 234 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields read in the ocean restart file' … … 220 237 ENDIF 221 238 ! 239 IF( .NOT. l_ssm_mean ) THEN ! default initialisation. needed by lim_istate 240 ! 241 IF(lwp) WRITE(numout,*) ' default initialisation of ss?_m arrays' 242 ssu_m(:,:) = ub(:,:,1) 243 ssv_m(:,:) = vb(:,:,1) 244 IF( ln_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 245 ELSE ; sst_m(:,:) = tsn(:,:,1,jp_tem) 246 ENDIF 247 sss_m(:,:) = tsn(:,:,1,jp_sal) 248 ssh_m(:,:) = sshn(:,:) 249 IF( lk_vvl ) e3t_m(:,:) = fse3t_n(:,:,1) 250 frq_m(:,:) = 1._wp 251 ! 252 ENDIF 253 ! 222 254 END SUBROUTINE sbc_ssm_init 223 255 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r5329 r5407 74 74 PUBLIC eos_init ! called by istate module 75 75 76 ! 77 INTEGER , PUBLIC :: nn_eos = 0 !:= 0/1/2 type of eq. of state and Brunt-Vaisala frequ.78 LOGICAL , PUBLIC :: ln_useCT = .FALSE.! determine if eos_pt_from_ct is used to compute sst_m76 ! !!* Namelist (nameos) * 77 INTEGER , PUBLIC :: nn_eos ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 78 LOGICAL , PUBLIC :: ln_useCT ! determine if eos_pt_from_ct is used to compute sst_m 79 79 80 80 ! !!! simplified eos coefficients … … 1252 1252 WRITE(numout,*) ' model uses Conservative Temperature' 1253 1253 WRITE(numout,*) ' Important: model must be initialized with CT and SA fields' 1254 ELSE 1255 WRITE(numout,*) ' model does not use Conservative Temperature' 1254 1256 ENDIF 1255 1257 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r4990 r5407 32 32 USE wrk_nemo ! Memory Allocation 33 33 USE timing ! Timing 34 USE sbc_ice, ONLY : lk_lim335 34 36 35 IMPLICIT NONE … … 38 37 39 38 PUBLIC tra_qsr ! routine called by step.F90 (ln_traqsr=T) 40 PUBLIC tra_qsr_init ! routine called by opa.F9039 PUBLIC tra_qsr_init ! routine called by nemogcm.F90 41 40 42 41 ! !!* Namelist namtra_qsr: penetrative solar radiation … … 50 49 REAL(wp), PUBLIC :: rn_si0 !: very near surface depth of extinction (RGB & 2 bands) 51 50 REAL(wp), PUBLIC :: rn_si1 !: deepest depth of extinction (water type I) (2 bands) 52 51 53 52 ! Module variables 54 53 REAL(wp) :: xsi0r !: inverse of rn_si0 … … 165 164 CALL iom_put( 'qsr3d', etot3 ) ! Shortwave Radiation 3D distribution 166 165 ! clem: store attenuation coefficient of the first ocean level 167 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN166 IF ( ln_qsr_ice ) THEN 168 167 DO jj = 1, jpj 169 168 DO ji = 1, jpi 170 169 IF ( qsr(ji,jj) /= 0._wp ) THEN 171 170 fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 171 ELSE 172 fraqsr_1lev(ji,jj) = 1. 172 173 ENDIF 173 174 END DO … … 233 234 END DO 234 235 ! clem: store attenuation coefficient of the first ocean level 235 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN236 IF ( ln_qsr_ice ) THEN 236 237 DO jj = 1, jpj 237 238 DO ji = 1, jpi … … 256 257 END DO 257 258 ! clem: store attenuation coefficient of the first ocean level 258 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN259 IF ( ln_qsr_ice ) THEN 259 260 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 260 261 ENDIF … … 279 280 END DO 280 281 ! clem: store attenuation coefficient of the first ocean level 281 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN282 IF ( ln_qsr_ice ) THEN 282 283 DO jj = 1, jpj 283 284 DO ji = 1, jpi … … 298 299 END DO 299 300 ! clem: store attenuation coefficient of the first ocean level 300 IF ( l k_lim3 .AND. ln_qsr_ice ) THEN301 IF ( ln_qsr_ice ) THEN 301 302 fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 302 303 ENDIF … … 324 325 & 'at it= ', kt,' date= ', ndastp 325 326 IF(lwp) WRITE(numout,*) '~~~~' 326 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc ) 327 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc ) 328 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) ! default definition in sbcssm 327 329 ! 328 330 ENDIF … … 379 381 ! 380 382 IF( nn_timing == 1 ) CALL timing_start('tra_qsr_init') 381 !382 ! Default value for fraqsr_1lev383 IF( .NOT. ln_rstart ) THEN384 fraqsr_1lev(:,:) = 1._wp385 ENDIF386 383 ! 387 384 CALL wrk_alloc( jpi, jpj, zekb, zekg, zekr ) … … 412 409 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 413 410 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1 414 WRITE(numout,*) ' light penetration for ice-model LIM3 ln_qsr_ice = ', ln_qsr_ice415 411 ENDIF 416 412 … … 564 560 ENDIF 565 561 ! 562 ! initialisation of fraqsr_1lev used in sbcssm 563 IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 564 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 565 ELSE 566 fraqsr_1lev(:,:) = 1._wp ! default definition 567 ENDIF 568 ! 566 569 CALL wrk_dealloc( jpi, jpj, zekb, zekg, zekr ) 567 570 CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r5120 r5407 761 761 IF( nn_pdl < 0 .OR. nn_pdl > 1 ) CALL ctl_stop( 'bad flag: nn_pdl is 0 or 1 ' ) 762 762 IF( nn_htau < 0 .OR. nn_htau > 1 ) CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 763 IF( nn_etau == 3 .AND. .NOT. l k_cpl ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )763 IF( nn_etau == 3 .AND. .NOT. ln_cpl ) CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 764 764 765 765 IF( ln_mxl0 ) THEN -
trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5329 r5407 82 82 USE crsini ! initialise grid coarsening utility 83 83 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 84 USE sbc_oce, ONLY: lk_oasis 84 85 USE stopar 85 86 USE stopts … … 197 198 #if defined key_iomput 198 199 CALL xios_finalize ! end mpp communications with xios 199 IF( lk_ cpl) CALL cpl_finalize ! end coupling and mpp communications with OASIS200 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 200 201 #else 201 IF( lk_ cpl) THEN202 IF( lk_oasis ) THEN 202 203 CALL cpl_finalize ! end coupling and mpp communications with OASIS 203 204 ELSE … … 228 229 ! 229 230 cltxt = '' 231 cxios_context = 'nemo' 230 232 ! 231 233 ! ! Open reference namelist and configuration namelist files … … 274 276 #if defined key_iomput 275 277 IF( Agrif_Root() ) THEN 276 IF( lk_ cpl) THEN277 CALL cpl_init( ilocal_comm )! nemo local communicator given by oasis278 CALL xios_initialize( " oceanx",local_comm=ilocal_comm ) ! send nemo communicator to xios278 IF( lk_oasis ) THEN 279 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 280 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 279 281 ELSE 280 CALL xios_initialize( " nemo",return_comm=ilocal_comm ) ! nemo local communicator given by xios282 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 281 283 ENDIF 282 284 ENDIF 283 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 285 ! Nodes selection (control print return in cltxt) 286 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 284 287 #else 285 IF( lk_ cpl) THEN288 IF( lk_oasis ) THEN 286 289 IF( Agrif_Root() ) THEN 287 CALL cpl_init( ilocal_comm )! nemo local communicator given by oasis290 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 288 291 ENDIF 289 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 292 ! Nodes selection (control print return in cltxt) 293 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 290 294 ELSE 291 295 ilocal_comm = 0 292 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 296 ! Nodes selection (control print return in cltxt) 297 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 293 298 ENDIF 294 299 #endif -
trunk/NEMOGCM/NEMO/OPA_SRC/step.F90
r5329 r5407 83 83 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 84 84 # if defined key_iomput 85 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo")85 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 86 86 # endif 87 87 #endif 88 88 indic = 0 ! reset to no error condition 89 89 IF( kstp == nit000 ) THEN 90 CALL iom_init( "nemo" ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 91 IF( ln_crs ) CALL iom_init( "nemo_crs" ) ! initialize context for coarse grid 90 ! must be done after nemo_init for AGRIF+XIOS+OASIS 91 CALL iom_init( cxios_context ) ! iom_put initialization 92 IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" ) ! initialize context for coarse grid 92 93 ENDIF 93 94 94 95 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 95 CALL iom_setkt( kstp - nit000 + 1, "nemo" ) ! say to iom thatwe are at time step kstp96 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" ) ! say to iom thatwe are at time step kstp96 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 97 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp 97 98 98 99 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 168 169 IF( lk_traldf_eiv ) CALL ldf_eiv( kstp ) ! eddy induced velocity coefficient 169 170 #endif 170 #if defined key_traldf_c3d && key_traldf_smag171 #if defined key_traldf_c3d && defined key_traldf_smag 171 172 CALL ldf_tra_smag( kstp ) ! eddy induced velocity coefficient 172 173 # endif 173 #if defined key_dynldf_c3d && key_dynldf_smag174 #if defined key_dynldf_c3d && defined key_dynldf_smag 174 175 CALL ldf_dyn_smag( kstp ) ! eddy induced velocity coefficient 175 176 # endif … … 225 226 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 226 227 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 227 IF( .NOT. l k_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics228 IF( .NOT. ln_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 228 229 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 229 230 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag … … 355 356 ! Coupled mode 356 357 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 357 IF( lk_ cpl) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges358 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 358 359 ! 359 360 #if defined key_iomput 360 361 IF( kstp == nitend .OR. indic < 0 ) THEN 361 CALL iom_context_finalize( "nemo") ! needed for XIOS+AGRIF362 IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) !362 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 363 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 363 364 ENDIF 364 365 #endif -
trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r5215 r5407 131 131 132 132 ! control print 133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i 6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', &133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', & 134 134 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_week:', nsec_week 135 135 -
trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5215 r5407 42 42 USE step_oce ! module used in the ocean time stepping module 43 43 USE sbc_oce ! surface boundary condition: ocean 44 USE cla ! cross land advection (tra_cla routine)45 44 USE domcfg ! domain configuration (dom_cfg routine) 46 45 USE daymod ! calendar … … 50 49 USE step ! NEMO time-stepping (stp routine) 51 50 USE lib_mpp ! distributed memory computing 51 #if defined key_nosignedzero 52 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 53 #endif 52 54 #if defined key_iomput 53 55 USE xios 54 56 #endif 57 USE cpl_oasis3 55 58 USE sbcssm 56 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 59 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 60 USE icbstp ! handle bergs, calving, themodynamics and transport 57 61 58 62 IMPLICIT NONE … … 96 100 ! !-----------------------! 97 101 #if defined key_agrif 98 CALL Agrif_Declare_Var ! AGRIF: set the meshes 102 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 103 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 104 # if defined key_top 105 CALL Agrif_Declare_Var_top ! " " " " " TOP 106 # endif 107 # if defined key_lim2 108 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 109 # endif 99 110 #endif 100 111 ! check that all process are still there... If some process have an error, … … 118 129 IF( lk_mpp ) CALL mpp_max( nstop ) 119 130 END DO 131 ! 132 IF( ln_icebergs ) CALL icb_end( nitend ) 133 120 134 ! !------------------------! 121 135 ! !== finalize the run ==! … … 136 150 ! 137 151 CALL nemo_closefile 152 ! 138 153 #if defined key_iomput 139 154 CALL xios_finalize ! end mpp communications with xios 155 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 140 156 #else 141 IF( lk_mpp ) CALL mppstop ! end mpp communications 157 IF( lk_oasis ) THEN 158 CALL cpl_finalize ! end coupling and mpp communications with OASIS 159 ELSE 160 IF( lk_mpp ) CALL mppstop ! end mpp communications 161 ENDIF 142 162 #endif 143 163 ! … … 154 174 INTEGER :: ilocal_comm ! local integer 155 175 INTEGER :: ios 156 157 176 CHARACTER(len=80), DIMENSION(16) :: cltxt 158 !! 177 CHARACTER(len=80) :: clname 178 ! 159 179 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 160 180 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & … … 163 183 & jpizoom, jpjzoom, jperio, ln_use_jattr 164 184 !!---------------------------------------------------------------------- 185 ! 165 186 cltxt = '' 166 187 ! 167 188 ! ! Open reference namelist and configuration namelist files 168 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 169 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 189 IF( lk_oasis ) THEN 190 CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 191 CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 192 cxios_context = 'sas' 193 clname = 'output.namelist_sas.dyn' 194 ELSE 195 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 196 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 197 cxios_context = 'nemo' 198 clname = 'output.namelist.dyn' 199 ENDIF 170 200 ! 171 201 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark … … 186 216 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 187 217 218 ! Force values for AGRIF zoom (cf. agrif_user.F90) 219 #if defined key_agrif 220 IF( .NOT. Agrif_Root() ) THEN 221 jpiglo = nbcellsx + 2 + 2*nbghostcells 222 jpjglo = nbcellsy + 2 + 2*nbghostcells 223 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 224 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 225 jpidta = jpiglo 226 jpjdta = jpjglo 227 jpizoom = 1 228 jpjzoom = 1 229 nperio = 0 230 jperio = 0 231 ln_use_jattr = .false. 232 ENDIF 233 #endif 234 ! 188 235 ! !--------------------------------------------! 189 236 ! ! set communicator & select the local node ! … … 193 240 #if defined key_iomput 194 241 IF( Agrif_Root() ) THEN 195 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) 196 ENDIF 197 narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 242 IF( lk_oasis ) THEN 243 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 244 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 245 ELSE 246 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 247 ENDIF 248 ENDIF 249 narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 198 250 #else 199 ilocal_comm = 0 200 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 251 IF( lk_oasis ) THEN 252 IF( Agrif_Root() ) THEN 253 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 254 ENDIF 255 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 256 ELSE 257 ilocal_comm = 0 258 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 259 ENDIF 201 260 #endif 202 261 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) … … 229 288 ! than variables 230 289 IF( Agrif_Root() ) THEN 290 #if defined key_nemocice_decomp 291 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 292 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 293 #else 231 294 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 232 #if defined key_nemocice_decomp233 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.234 #else235 295 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 236 296 #endif 297 ENDIF 237 298 jpk = jpkdta ! third dim 238 299 jpim1 = jpi-1 ! inner domain indices … … 240 301 jpkm1 = jpk-1 ! " " 241 302 jpij = jpi*jpj ! jpi x j 242 ENDIF243 303 244 304 IF(lwp) THEN ! open listing units 245 305 ! 246 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 306 IF( lk_oasis ) THEN 307 CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 308 ELSE 309 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 310 ENDIF 247 311 ! 248 312 WRITE(numout,*) … … 287 351 288 352 IF( ln_ctl ) CALL prt_ctl_init ! Print control 289 CALL flush(numout)290 291 353 CALL day_init ! model calendar (using both namelist and restart infos) 292 354 … … 397 459 ENDIF 398 460 ! 461 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 462 & 'f2003 standard. ' , & 463 & 'Compile with key_nosignedzero enabled' ) 464 ! 399 465 END SUBROUTINE nemo_ctl 400 466 … … 438 504 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 439 505 ! 440 INTEGER :: ierr,ierr4 506 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 507 INTEGER :: jpm 441 508 !!---------------------------------------------------------------------- 442 509 ! … … 444 511 ierr = ierr + dom_oce_alloc () ! ocean domain 445 512 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 446 & snwice_fmass(jpi,jpj), STAT= ierr4 ) 447 ierr = ierr + ierr4 513 & snwice_fmass(jpi,jpj), STAT= ierr1 ) 514 ! 515 ! lim code currently uses surface temperature and salinity in tsn array for initialisation 516 ! and ub, vb arrays in ice dynamics 517 ! so allocate enough of arrays to use 518 ! 519 jpm = MAX(jp_tem, jp_sal) 520 ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 ) 521 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 ) 522 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 ) 523 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 524 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 525 526 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 448 527 ! 449 528 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 470 549 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 471 550 !!---------------------------------------------------------------------- 472 551 ! 473 552 ierr = 0 474 553 ! 475 554 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 476 555 ! 477 556 IF( nfact <= 1 ) THEN 478 557 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 516 595 INTEGER, PARAMETER :: ntest = 14 517 596 INTEGER :: ilfax(ntest) 518 597 ! 519 598 ! lfax contains the set of allowed factors. 520 599 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 601 680 !loop over the other north-fold processes to find the processes 602 681 !managing the points belonging to the sxT-dxT range 603 DO jn = jpnij - jpni +1, jpnij604 IF ( njmppt(jn) == njmppmax ) THEN682 683 DO jn = 1, jpni 605 684 !sxT is the first point (in the global domain) of the jn 606 685 !process 607 sxT = n imppt(jn)686 sxT = nfiimpp(jn, jpnj) 608 687 !dxT is the last point (in the global domain) of the jn 609 688 !process 610 dxT = n imppt(jn) + nlcit(jn) - 1689 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 611 690 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 612 691 nsndto = nsndto + 1 613 isendto(nsndto) = jn614 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN692 isendto(nsndto) = jn 693 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 615 694 nsndto = nsndto + 1 616 695 isendto(nsndto) = jn … … 619 698 isendto(nsndto) = jn 620 699 END IF 621 END IF622 700 END DO 701 nfsloop = 1 702 nfeloop = nlci 703 DO jn = 2,jpni-1 704 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 705 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 706 nfsloop = nldi 707 ENDIF 708 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 709 nfeloop = nlei 710 ENDIF 711 ENDIF 712 END DO 713 623 714 ENDIF 624 715 l_north_nogather = .TRUE. -
trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r5215 r5407 36 36 PUBLIC sbc_ssm ! called by sbc 37 37 38 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uv = .true. !: specify whether input velocity data is 3D 40 INTEGER , SAVE :: nfld_3d 41 INTEGER , SAVE :: nfld_2d 42 43 INTEGER , PARAMETER :: jpfld_3d = 4 ! maximum number of files to read 44 INTEGER , PARAMETER :: jpfld_2d = 1 ! maximum number of files to read 45 INTEGER , SAVE :: jf_tem ! index of temperature 46 INTEGER , SAVE :: jf_sal ! index of salinity 47 INTEGER , SAVE :: jf_usp ! index of u velocity component 48 INTEGER , SAVE :: jf_vsp ! index of v velocity component 49 INTEGER , SAVE :: jf_ssh ! index of sea surface height 38 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 40 LOGICAL :: ln_read_frq !: specify whether we must read frq or not 41 LOGICAL :: l_initdone = .false. 42 INTEGER :: nfld_3d 43 INTEGER :: nfld_2d 44 45 INTEGER :: jf_tem ! index of temperature 46 INTEGER :: jf_sal ! index of salinity 47 INTEGER :: jf_usp ! index of u velocity component 48 INTEGER :: jf_vsp ! index of v velocity component 49 INTEGER :: jf_ssh ! index of sea surface height 50 INTEGER :: jf_e3t ! index of first T level thickness 51 INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level 50 52 51 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read) 52 54 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d ! structure of input fields (file information, fields read) 53 55 54 !! * Substitutions55 # include "domzgr_substitute.h90"56 # include "vectopt_loop_substitute.h90"57 56 !!---------------------------------------------------------------------- 58 57 !! NEMO/OFF 3.3 , NEMO Consortium (2010) … … 86 85 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 87 86 ! 88 IF( ln_3d_uv ) THEN87 IF( ln_3d_uve ) THEN 89 88 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 90 89 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 90 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 91 91 ELSE 92 92 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 93 93 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 94 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 94 95 ENDIF 95 96 ! … … 97 98 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 98 99 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 99 ! 100 tsn(:,:,1,jp_tem) = sst_m(:,:) 101 tsn(:,:,1,jp_sal) = sss_m(:,:) 100 IF( ln_read_frq ) frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 101 ! 102 102 IF ( nn_ice == 1 ) THEN 103 tsn(:,:,1,jp_tem) = sst_m(:,:) 104 tsn(:,:,1,jp_sal) = sss_m(:,:) 103 105 tsb(:,:,1,jp_tem) = sst_m(:,:) 104 106 tsb(:,:,1,jp_sal) = sss_m(:,:) 105 107 ENDIF 106 ub (:,:,1 107 vb (:,:,1 108 ub (:,:,1) = ssu_m(:,:) 109 vb (:,:,1) = ssv_m(:,:) 108 110 109 111 IF(ln_ctl) THEN ! print control … … 113 115 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask, ovlap=1 ) 114 116 CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask, ovlap=1 ) 117 IF( lk_vvl ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask, ovlap=1 ) 118 IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask, ovlap=1 ) 119 ENDIF 120 ! 121 IF( l_initdone ) THEN ! Mean value at each nn_fsbc time-step ! 122 CALL iom_put( 'ssu_m', ssu_m ) 123 CALL iom_put( 'ssv_m', ssv_m ) 124 CALL iom_put( 'sst_m', sst_m ) 125 CALL iom_put( 'sss_m', sss_m ) 126 CALL iom_put( 'ssh_m', ssh_m ) 127 IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m ) 128 IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m ) 115 129 ENDIF 116 130 ! … … 138 152 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_2d ! array of namelist information on the fields to read 139 153 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 140 TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh 141 ! 142 NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh 143 !!---------------------------------------------------------------------- 154 TYPE(FLD_N) :: sn_usp, sn_vsp 155 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 156 ! 157 NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 158 !!---------------------------------------------------------------------- 159 160 IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 144 161 145 162 REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields … … 159 176 WRITE(numout,*) '~~~~~~~~~~~ ' 160 177 WRITE(numout,*) ' Namelist namsbc_sas' 178 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 179 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq 161 180 WRITE(numout,*) 162 181 ENDIF 163 164 182 ! 165 183 !! switch off stuff that isn't sensible with a standalone module … … 170 188 ln_apr_dyn = .FALSE. 171 189 ENDIF 172 IF( ln_dm2dc ) THEN173 IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'174 ln_dm2dc = .FALSE.175 ENDIF176 190 IF( ln_rnf ) THEN 177 191 IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' … … 190 204 nn_closea = 0 191 205 ENDIF 192 193 206 ! 194 207 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 195 208 !! when we have other 3d arrays that we need to read in 196 209 !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 197 !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,198 !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,210 !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 211 !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 199 212 !! and the rest of the logic should still work 200 213 ! 201 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 202 ! 203 IF( ln_3d_uv ) THEN204 jf_usp = 1 ; jf_vsp = 2 205 nfld_3d = 2 206 nfld_2d = 3 214 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4 ! default 2D fields index 215 ! 216 IF( ln_3d_uve ) THEN 217 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 218 nfld_3d = 2 + COUNT( (/lk_vvl/) ) ! number of 3D fields to read 219 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 207 220 ELSE 208 jf_usp = 4 ; jf_vsp = 5 209 nfld_3d = 0 210 nfld_2d = 5 221 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) ) ! update 2D fields index 222 nfld_3d = 0 ! no 3D fields to read 223 nfld_2d = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 211 224 ENDIF 212 225 … … 216 229 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN 217 230 ENDIF 218 IF( ln_3d_uv ) THEN 219 slf_3d(jf_usp) = sn_usp 220 slf_3d(jf_vsp) = sn_vsp 221 ENDIF 231 slf_3d(jf_usp) = sn_usp 232 slf_3d(jf_vsp) = sn_vsp 233 IF( lk_vvl ) slf_3d(jf_e3t) = sn_e3t 222 234 ENDIF 223 235 … … 228 240 ENDIF 229 241 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 230 IF( .NOT. ln_3d_uv ) THEN 242 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 243 IF( .NOT. ln_3d_uve ) THEN 231 244 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 232 ENDIF 233 ENDIF 234 ! 245 IF( lk_vvl ) slf_2d(jf_e3t) = sn_e3t 246 ENDIF 247 ENDIF 248 ! 249 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 235 250 IF( nfld_3d > 0 ) THEN 236 251 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 265 280 ENDIF 266 281 ! 267 ! lim code currently uses surface temperature and salinity in tsn array for initialisation268 ! and ub, vb arrays in ice dynamics269 ! so allocate enough of arrays to use270 !271 ierr3 = 0272 jpm = MAX(jp_tem, jp_sal)273 ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )274 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr1 )275 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr2 )276 IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )277 ierr = ierr0 + ierr1 + ierr2 + ierr3278 IF( ierr > 0 ) THEN279 CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')280 ENDIF281 !282 282 ! finally tidy up 283 283 284 284 IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 285 285 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 286 287 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 288 IF( .NOT. ln_read_frq ) frq_m(:,:) = 1. 289 l_initdone = .TRUE. 286 290 ! 287 291 END SUBROUTINE sbc_ssm_init -
trunk/NEMOGCM/NEMO/SAS_SRC/step.F90
r5215 r5407 17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE in_out_manager ! I/O manager 19 USE sbc_oce 20 USE sbccpl 19 21 USE iom ! 20 22 USE lbclnk … … 72 74 kstp = nit000 + Agrif_Nb_Step() 73 75 # if defined key_iomput 74 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo")76 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 75 77 # endif 76 78 #endif 77 IF( kstp == nit000 ) CALL iom_init( "nemo" )! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)79 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 78 80 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 79 CALL iom_setkt( kstp , "nemo" ) ! say to iom thatwe are at time step kstp81 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 80 82 81 83 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) … … 86 88 ! need to keep the same interface 87 89 CALL stp_ctl( kstp, indic ) 90 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 91 ! Coupled mode 92 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 93 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges if OASIS-coupled ice 94 88 95 #if defined key_iomput 89 IF( kstp == nitend ) CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 96 IF( kstp == nitend .OR. indic < 0 ) THEN 97 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 98 ENDIF 90 99 #endif 91 100 ! -
trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90
r4996 r5407 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && key_c14b && defined key_iomput8 #if defined key_top && defined key_c14b && defined key_iomput 9 9 !!---------------------------------------------------------------------- 10 10 !! 'key_c14b' c14b model -
trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90
r4996 r5407 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && key_cfc && defined key_iomput8 #if defined key_top && defined key_cfc && defined key_iomput 9 9 !!---------------------------------------------------------------------- 10 10 !! 'key_cfc' cfc model -
trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r4996 r5407 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 7 !!---------------------------------------------------------------------- 8 #if defined key_top && key_my_trc && defined key_iomput8 #if defined key_top && defined key_my_trc && defined key_iomput 9 9 !!---------------------------------------------------------------------- 10 10 !! 'key_my_trc' my_trc model -
trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r5385 r5407 72 72 CALL top_alloc() ! allocate TOP arrays 73 73 74 l_trcdm2dc = ln_dm2dc .OR. ( l k_cpl .AND. ncpl_qsr_freq /= 1 )74 l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 75 75 l_trcdm2dc = l_trcdm2dc .AND. .NOT. lk_offline 76 76 IF( l_trcdm2dc .AND. lwp ) & -
trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r5385 r5407 132 132 133 133 IF( kt == nittrc000 ) THEN 134 IF( l k_cpl ) THEN134 IF( ln_cpl ) THEN 135 135 rdt_sampl = 86400. / ncpl_qsr_freq 136 136 nb_rec_per_days = ncpl_qsr_freq -
trunk/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_CURIE
r4147 r5407 8 8 #MSUB -n NPROCS # Total number of mpi task to use 9 9 #### #MSUB -N 2 # number of nodes to use 10 #MSUB - A gen0826 # project name10 #MSUB -ra2286 # project name 11 11 #MSUB -q standard # (queue name) only for thin nodes 12 12 ########################################################################## … … 33 33 module unload netcdf 34 34 module unload hdf5 35 module load netcdf/4. 2_hdf5_parallel36 module load hdf5/1.8. 9_parallel35 module load netcdf/4.3.3.1_hdf5_parallel 36 module load hdf5/1.8.12_parallel 37 37 38 38 # Don't remove neither change the following line -
trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
r5302 r5407 32 32 # same story but for wrk_dealloc 33 33 nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" ) 34 [ $(( 2 * $nn1 )) -ne $nn2 ] && echo "problem with wrk_dealloc in $ff" 34 if [ $(( 2 * $nn1 )) -ne $nn2 ] 35 then 36 echo "problem with wrk_dealloc in $ff" 37 grep -i "call *wrk_alloc *(" $ff 38 grep -i "call *wrk_dealloc *(" $ff 39 echo 40 fi 35 41 fi 36 42 -
trunk/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh
r3294 r5407 1 1 #!/bin/bash 2 # 3 # rsync -av NEMO/ NEMO_no_wrkarrays/ 4 # cd NEMO_no_wrkarrays/ 5 # ../TOOLS/MISCELLANEOUS/rewrite_nemo.sh 6 # cd ../CONFIG 7 # ./makenemo -n ORCA2_LIM3 -s NEMO_no_wrkarrays 2 8 # 3 9 set -u 4 10 #set -xv 5 11 # 6 # for on each file containing a call to work alloc (exept BDY files that are too complicated...) 7 #for i in $( ack -il "^ *call *wrk_alloc *\(" | grep -v BDY ) 8 for i in $( egrep -iRl "^ *call *wrk_alloc *\(" * | grep "90$" | grep -v BDY ) 12 # for on each file containing a call to work alloc 13 for i in $( grep -iRl "^[^\!]*call *wrk_alloc *(" * | grep "90$" ) 9 14 do 10 15 # create a temporary file that will be easier to process... … … 28 33 # 29 34 # number of the lines containing wrk_alloc 30 cnt=$( grep -ci "^ 35 cnt=$( grep -ci "^[^\!]*call *wrk_alloc *(" tmp$$ ) 31 36 # for each of these lines 32 37 ll=1 … … 34 39 do 35 40 # get the line with its number 36 line=$( grep -in "^ 41 line=$( grep -in "^[^\!]*call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" ) 37 42 # get its number 38 43 lline=$( echo $line | sed -e "s/:.*//" ) 39 44 # keep only the arument of wrk_alloc between () 40 line=$( echo $line | sed -e "s/ [^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" )45 line=$( echo $line | sed -e "s/^.*[cC][aA][lL][lL] *[wW][rR][kK]_[aA][lL][lL][oO][cC]//" | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" ) 41 46 # find in which subroutine or function is located this call to wrk_alloc: l1 beginning l2: end 42 47 for lll in $linesbegin … … 132 137 # 133 138 # OPA_SRC/SBC/albedo.F90 134 sed -e "s/DIMENSION(jpi,jpj,ijpl )/DIMENSION(jpi,jpj,SIZE(pt_ice,3))/" OPA_SRC/SBC/albedo.F90 > tmp$$139 sed -e "s/DIMENSION(jpi,jpj,ijpl/DIMENSION(jpi,jpj,SIZE(pt_ice,3)/" OPA_SRC/SBC/albedo.F90 > tmp$$ 135 140 mv tmp$$ OPA_SRC/SBC/albedo.F90 141 # see result of 142 # grep -i "wrk_alloc" $( find . -name "*90" ) | grep "=" 143 # 136 144 # LIM_SRC_2/limrhg_2.F90 137 sed -e "s/DIMENSION(jpi,jpj+2)/DIMENSION(jpi,0:jpj+1)/" LIM_SRC_2/limrhg_2.F90 > tmp$$ 145 #./LIM_SRC_2/limrhg_2.F90: CALL wrk_alloc( jpi,jpj+2, zu0, zv0, zu_n, zv_n, zu_a, zv_a, zviszeta, zviseta, kjstart = 0 ) 146 #./LIM_SRC_2/limrhg_2.F90: CALL wrk_alloc( jpi,jpj+2, zzfrld, zztms, zi1, zi2, zmasst, zpresh, kjstart = 0 ) 147 sed -e "s/DIMENSION(jpi,jpj+2/DIMENSION(jpi,0:jpj+1/" LIM_SRC_2/limrhg_2.F90 > tmp$$ 138 148 mv tmp$$ LIM_SRC_2/limrhg_2.F90 149 139 150 # LIM_SRC_3/limitd_me.F90 151 #./LIM_SRC_3/limitd_me.F90: CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 140 152 sed -e "s/DIMENSION(jpi,jpj,jpl+2)/DIMENSION(jpi,jpj,-1:jpl)/" LIM_SRC_3/limitd_me.F90 > tmp$$ 141 153 mv tmp$$ LIM_SRC_3/limitd_me.F90 154 142 155 # LIM_SRC_3/limitd_th.F90 156 #./LIM_SRC_3/limitd_th.F90: CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 ) 143 157 sed -e "s/DIMENSION(jpi,jpj,jpl+1)/DIMENSION(jpi,jpj,0:jpl)/" LIM_SRC_3/limitd_th.F90 > tmp$$ 144 158 mv tmp$$ LIM_SRC_3/limitd_th.F90 159 145 160 # LIM_SRC_3/limthd_dif.F90 161 #./LIM_SRC_3/limthd_dif.F90: CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 ) 162 #./LIM_SRC_3/limthd_dif.F90: CALL wrk_alloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 ) 146 163 sed -e "s/DIMENSION(kiut,nlay_i+1)/DIMENSION(kiut,0:nlay_i)/" \ 147 164 -e "s/DIMENSION(kiut,nlay_s+1)/DIMENSION(kiut,0:nlay_s)/" LIM_SRC_3/limthd_dif.F90 > tmp$$ 148 165 mv tmp$$ LIM_SRC_3/limthd_dif.F90 166 149 167 # LIM_SRC_3/limthd_ent.F90 150 sed -e "s/DIMENSION(jpij,jkmax+4)/DIMENSION(jpij,0:jkmax+3)/" \ 151 -e "s/DIMENSION(jkmax+4,jkmax+4)/DIMENSION(0:jkmax+3,0:jkmax+3)/" LIM_SRC_3/limthd_ent.F90 > tmp$$ 168 #./LIM_SRC_3/limthd_ent.F90: CALL wrk_alloc( jpij, nlay_i+3, zqh_cum0, zh_cum0, kjstart = 0 ) 169 #./LIM_SRC_3/limthd_ent.F90: CALL wrk_alloc( jpij, nlay_i+1, zqh_cum1, zh_cum1, kjstart = 0 ) 170 sed -e "s/DIMENSION(jpij,nlay_i+3)/DIMENSION(jpij,0:nlay_i+2)/" \ 171 -e "s/DIMENSION(jpij,nlay_i+1)/DIMENSION(jpij,0:nlay_i)/" LIM_SRC_3/limthd_ent.F90 > tmp$$ 152 172 mv tmp$$ LIM_SRC_3/limthd_ent.F90 173 153 174 # OPA_SRC/DYN/divcur.F90 175 #./OPA_SRC/DYN/divcur.F90: CALL wrk_alloc( jpi+4, jpj , zwv, kjstart = -1 ) 154 176 sed -e "s/DIMENSION(jpi+4,jpj)/DIMENSION(-1:jpi+2,jpj)/" OPA_SRC/DYN/divcur.F90 > tmp$$ 155 177 mv tmp$$ OPA_SRC/DYN/divcur.F90 178 156 179 # OPA_SRC/LDF/ldfslp.F90 180 #./OPA_SRC/LDF/ldfslp.F90: CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 181 #./OPA_SRC/LDF/ldfslp.F90: CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) 157 182 sed -e "s/DIMENSION(jpi,jpj,jpk,2)/DIMENSION(jpi,jpj,jpk,0:1)/" \ 158 183 -e "s/DIMENSION(jpi,jpj,2,2)/DIMENSION(jpi,jpj,0:1,0:1)/" OPA_SRC/LDF/ldfslp.F90 > tmp$$ 159 184 mv tmp$$ OPA_SRC/LDF/ldfslp.F90 160 185 # OPA_SRC/ZDF/zdfkpp.F90 186 #./OPA_SRC/ZDF/zdfkpp.F90: CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 ) 161 187 sed -e "s/DIMENSION(jpi,3) *::* zmoek/DIMENSION(jpi,0:2) :: zmoek/" OPA_SRC/ZDF/zdfkpp.F90 > tmp$$ 162 188 mv tmp$$ OPA_SRC/ZDF/zdfkpp.F90 163 189 164 # link for limrhg.F90... 190 # links 191 # see result of 192 # find . -type l 193 # 194 # ./LIM_SRC_2/limrhg.F90 165 195 cd LIM_SRC_2 166 196 ln -sf ../LIM_SRC_3/limrhg.F90 . 197 cd .. 198 199 # ./OOO_SRC/dtadyn.F90 200 cd OOO_SRC 201 ln -sf ../OFF_SRC/dtadyn.F90 . 202 cd .. 203 204 # ./OOO_SRC/obs_fbm.F90 205 cd OOO_SRC 206 ln -sf ../OPA_SRC/OBS/obs_fbm.F90 . 207 cd ..
Note: See TracChangeset
for help on using the changeset viewer.