Changeset 7077 for branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
- Timestamp:
- 2016-10-24T17:07:43+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
r4624 r7077 15 15 USE dom_oce ! ocean space and time domain 16 16 USE sbc_oce ! Surface boundary condition: ocean fields 17 USE sbc_ice ! Surface boundary condition: ice fields 17 18 USE phycst ! physical constants 18 19 USE in_out_manager ! I/O manager … … 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 22 USE lib_fortran 22 23 USE wrk_nemo 24 #if defined key_lim3 25 USE ice, ONLY : pfrld, a_i_b 26 USE limthd_dh ! for CALL lim_thd_snwblow 27 #endif 28 23 29 IMPLICIT NONE 24 30 PRIVATE 25 31 26 PUBLIC sbc_ana ! routine called in sbcmod module 27 PUBLIC sbc_gyre ! routine called in sbcmod module 32 PUBLIC sbc_ana ! routine called in sbcmod module 33 PUBLIC sbc_gyre ! routine called in sbcmod module 34 #if defined key_lim3 35 PUBLIC ana_ice_tau ! routine called in sbc_ice_lim module 36 PUBLIC ana_ice_flx ! routine called in sbc_ice_lim module 37 #endif 28 38 29 39 ! !!* Namelist namsbc_ana * 30 INTEGER :: nn_tau000 ! nb of time-step during which the surface stress 31 ! ! increase from 0 to its nominal value 32 REAL(wp) :: rn_utau0 ! constant wind stress value in i-direction 33 REAL(wp) :: rn_vtau0 ! constant wind stress value in j-direction 34 REAL(wp) :: rn_qns0 ! non solar heat flux 35 REAL(wp) :: rn_qsr0 ! solar heat flux 36 REAL(wp) :: rn_emp0 ! net freshwater flux 40 ! --- oce variables --- ! 41 INTEGER :: nn_tau000 ! nb of time-step during which the surface stress 42 ! ! increase from 0 to its nominal value 43 REAL(wp) :: rn_utau0 ! constant wind stress value in i-direction 44 REAL(wp) :: rn_vtau0 ! constant wind stress value in j-direction 45 REAL(wp) :: rn_qns0 ! non solar heat flux 46 REAL(wp) :: rn_qsr0 ! solar heat flux 47 REAL(wp) :: rn_emp0 ! net freshwater flux 48 ! --- ice variables --- ! 49 REAL(wp) :: rn_iutau0 ! constant wind stress value in i-direction over ice 50 REAL(wp) :: rn_ivtau0 ! constant wind stress value in j-direction over ice 51 REAL(wp) :: rn_iqns0 ! non solar heat flux over ice 52 REAL(wp) :: rn_iqsr0 ! solar heat flux over ice 53 REAL(wp) :: rn_sprec0 ! snow precip 54 REAL(wp) :: rn_ievap0 ! sublimation 37 55 38 56 !! * Substitutions … … 69 87 REAL(wp) :: zcoef, zty, zmod ! - - 70 88 !! 71 NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0 89 NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0, & 90 & rn_iutau0, rn_ivtau0, rn_iqsr0, rn_iqns0, rn_sprec0, rn_ievap0 72 91 !!--------------------------------------------------------------------- 73 92 ! … … 86 105 IF(lwp) WRITE(numout,*)' sbc_ana : Constant surface fluxes read in namsbc_ana namelist' 87 106 IF(lwp) WRITE(numout,*)' ~~~~~~~ ' 88 IF(lwp) WRITE(numout,*)' spin up of the stress nn_tau000 = ', nn_tau000, ' time-steps' 89 IF(lwp) WRITE(numout,*)' constant i-stress rn_utau0 = ', rn_utau0 , ' N/m2' 90 IF(lwp) WRITE(numout,*)' constant j-stress rn_vtau0 = ', rn_vtau0 , ' N/m2' 91 IF(lwp) WRITE(numout,*)' non solar heat flux rn_qns0 = ', rn_qns0 , ' W/m2' 92 IF(lwp) WRITE(numout,*)' solar heat flux rn_qsr0 = ', rn_qsr0 , ' W/m2' 93 IF(lwp) WRITE(numout,*)' net heat flux rn_emp0 = ', rn_emp0 , ' Kg/m2/s' 107 IF(lwp) WRITE(numout,*)' spin up of the stress nn_tau000 = ', nn_tau000 , ' time-steps' 108 IF(lwp) WRITE(numout,*)' constant i-stress rn_utau0 = ', rn_utau0 , ' N/m2' 109 IF(lwp) WRITE(numout,*)' constant j-stress rn_vtau0 = ', rn_vtau0 , ' N/m2' 110 IF(lwp) WRITE(numout,*)' non solar heat flux rn_qns0 = ', rn_qns0 , ' W/m2' 111 IF(lwp) WRITE(numout,*)' solar heat flux rn_qsr0 = ', rn_qsr0 , ' W/m2' 112 IF(lwp) WRITE(numout,*)' net freshwater flux rn_emp0 = ', rn_emp0 , ' Kg/m2/s' 113 IF(lwp) WRITE(numout,*)' constant ice-atm stress rn_iutau0 = ', rn_iutau0 , ' N/m2' 114 IF(lwp) WRITE(numout,*)' constant ice-atm stress rn_ivtau0 = ', rn_ivtau0 , ' N/m2' 115 IF(lwp) WRITE(numout,*)' solar heat flux over ice rn_iqsr0 = ', rn_iqsr0 , ' W/m2' 116 IF(lwp) WRITE(numout,*)' non solar heat flux over ice rn_iqns0 = ', rn_iqns0 , ' W/m2' 117 IF(lwp) WRITE(numout,*)' snow precip rn_sprec0 = ', rn_sprec0 , ' Kg/m2/s' 118 IF(lwp) WRITE(numout,*)' sublimation rn_ievap0 = ', rn_ievap0 , ' Kg/m2/s' 94 119 ! 95 120 nn_tau000 = MAX( nn_tau000, 1 ) ! must be >= 1 … … 133 158 END SUBROUTINE sbc_ana 134 159 135 160 #if defined key_lim3 161 SUBROUTINE ana_ice_tau 162 !!--------------------------------------------------------------------- 163 !! *** ROUTINE ana_ice_tau *** 164 !! 165 !! ** Purpose : provide the surface boundary (momentum) condition over sea-ice 166 !!--------------------------------------------------------------------- 167 utau_ice(:,:) = rn_iutau0 168 vtau_ice(:,:) = rn_ivtau0 169 170 END SUBROUTINE ana_ice_tau 171 172 SUBROUTINE ana_ice_flx 173 !!--------------------------------------------------------------------- 174 !! *** ROUTINE ana_ice_flx *** 175 !! 176 !! ** Purpose : provide the surface boundary (flux) condition over sea-ice 177 !!--------------------------------------------------------------------- 178 REAL(wp), DIMENSION(:,:), POINTER :: zsnw ! snw distribution after wind blowing 179 !!--------------------------------------------------------------------- 180 CALL wrk_alloc( jpi,jpj, zsnw ) 181 182 ! ocean variables (renaming) 183 emp_oce (:,:) = rn_emp0 184 qsr_oce (:,:) = rn_qsr0 185 qns_oce (:,:) = rn_qns0 186 187 ! ice variables 188 alb_ice (:,:,:) = 0.7_wp ! useless 189 qsr_ice (:,:,:) = rn_iqsr0 190 qns_ice (:,:,:) = rn_iqns0 191 sprecip (:,:) = rn_sprec0 192 evap_ice(:,:,:) = rn_ievap0 193 194 ! ice variables deduced from above 195 zsnw(:,:) = 0._wp 196 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing 197 emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 198 emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw ) 199 qevap_ice(:,:,:) = 0._wp 200 qprec_ice(:,:) = rhosn * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! in J/m3 201 qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp 202 qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! solid precip (only) 203 204 ! total fluxes 205 emp_tot (:,:) = emp_ice + emp_oce 206 qns_tot (:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 207 qsr_tot (:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 208 209 !-------------------------------------------------------------------- 210 ! FRACTIONs of net shortwave radiation which is not absorbed in the 211 ! thin surface layer and penetrates inside the ice cover 212 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 213 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 214 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 215 216 CALL wrk_dealloc( jpi,jpj, zsnw ) 217 218 END SUBROUTINE ana_ice_flx 219 #endif 220 221 136 222 SUBROUTINE sbc_gyre( kt ) 137 223 !!---------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
