Changeset 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
- Timestamp:
- 2015-04-13T15:08:59+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4688 r5208 32 32 USE sbc_oce ! Surface boundary condition: ocean fields 33 33 USE sbccpl 34 USE cpl_oasis3, ONLY : lk_cpl 35 USE oce , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 34 USE oce , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 36 35 USE albedo ! albedo parameters 37 36 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 51 50 PUBLIC lim_sbc_flx ! called by sbc_ice_lim 52 51 PUBLIC lim_sbc_tau ! called by sbc_ice_lim 53 54 REAL(wp) :: epsi10 = 1.e-10 !55 REAL(wp) :: epsi20 = 1.e-20 !56 52 57 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2] … … 98 94 !! - fr_i : ice fraction 99 95 !! - tn_ice : sea-ice surface temperature 100 !! - alb_ice : sea-ice albe rdo (lk_cpl=T)96 !! - alb_ice : sea-ice albedo (lk_cpl=T) 101 97 !! 102 98 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 103 99 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 100 !! These refs are now obsolete since everything has been revised 101 !! The ref should be Rousset et al., 2015? 104 102 !!--------------------------------------------------------------------- 105 INTEGER, INTENT(in) :: kt ! number of iteration 106 ! 107 INTEGER :: ji, jj, jl, jk ! dummy loop indices 108 REAL(wp) :: zinda, zemp ! local scalars 109 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 110 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 103 INTEGER, INTENT(in) :: kt ! number of iteration 104 ! 105 INTEGER :: ji, jj, jl, jk ! dummy loop indices 106 ! 107 REAL(wp) :: zemp ! local scalars 108 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 109 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 110 ! 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace 112 112 !!--------------------------------------------------------------------- 113 114 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp )115 113 116 114 ! make calls for heat fluxes before it is modified 117 CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface118 CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface119 CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )! solar flux at ice surface120 CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )! non-solar flux at ice surface121 CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * old_a_i(:,:,:), dim=3 ) )! solar flux transmitted thru ice122 CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )123 CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * old_a_i(:,:,:), dim=3 ) )115 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 116 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 117 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 118 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 119 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 120 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 121 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 124 122 125 123 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) … … 130 128 ! heat flux at the ocean surface ! 131 129 !------------------------------------------! 132 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( 1._wp - pfrld(ji,jj) ) ) ) ! 1 if ice133 134 130 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 135 131 !--------------------------------------------------- 136 IF( lk_cpl ) THEN ! be carfeful: not been tested yet137 ! original line132 IF( lk_cpl ) THEN 133 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 138 134 zfcm1 = qsr_tot(ji,jj) 139 !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) )140 135 DO jl = 1, jpl 141 zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl)136 zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * a_i_b(ji,jj,jl) 142 137 END DO 143 138 ELSE 144 !!!zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 145 !!! & ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 139 !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 146 140 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 147 141 DO jl = 1, jpl 148 zfcm1 = zfcm1 + old_a_i(ji,jj,jl) * ftr_ice(ji,jj,jl)142 zfcm1 = zfcm1 + a_i_b(ji,jj,jl) * ftr_ice(ji,jj,jl) 149 143 END DO 150 144 ENDIF … … 182 176 183 177 ! mass flux from ice/ocean 184 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 178 wfx_ice(ji,jj) = wfx_bog(ji,jj) + wfx_bom(ji,jj) + wfx_sum(ji,jj) + wfx_sni(ji,jj) & 179 + wfx_opw(ji,jj) + wfx_dyn(ji,jj) + wfx_res(ji,jj) 185 180 186 181 ! mass flux at the ocean/ice interface 187 fmmflx(ji,jj) = - wfx_ice(ji,jj) * r dt_ice! F/M mass flux save at least for biogeochemical model188 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) - wfx_sub(ji,jj)! mass flux + F/M mass flux (always ice/ocean mass exchange)182 fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice ! F/M mass flux save at least for biogeochemical model 183 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 189 184 190 185 END DO … … 194 189 ! salt flux at the ocean surface ! 195 190 !------------------------------------------! 196 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 191 sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:) & 192 & + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) 197 193 198 194 !-------------------------------------------------------------! … … 215 211 216 212 !------------------------------------------------! 217 ! Computation of snow/ice and ocean albedo!213 ! Snow/ice albedo (only if sent to coupler) ! 218 214 !------------------------------------------------! 219 215 IF( lk_cpl ) THEN ! coupled case 220 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 221 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 216 217 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 218 219 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 220 221 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 222 223 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 224 222 225 ENDIF 223 226 … … 229 232 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 230 233 ENDIF 231 ! 232 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 233 ! 234 234 235 END SUBROUTINE lim_sbc_flx 235 236 … … 344 345 ! clem modif 345 346 IF( .NOT. ln_rstart ) THEN 346 iatte(:,:) = 1._wp 347 oatte(:,:) = 1._wp 347 fraqsr_1lev(:,:) = 1._wp 348 348 ENDIF 349 349 !
Note: See TracChangeset
for help on using the changeset viewer.
