Changeset 10179 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/BENCH/MY_SRC/usrdef_sbc.F90
- Timestamp:
- 2018-10-08T14:47:55+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/BENCH/MY_SRC/usrdef_sbc.F90
r9762 r10179 13 13 !! usr_def_sbc : user defined surface bounday conditions in BENCH case 14 14 !!---------------------------------------------------------------------- 15 USE par_oce ! ocean space and time domain 16 USE dom_oce 17 USE oce ! ocean dynamics and tracers 15 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbc_ice ! Surface boundary condition: ocean fields 16 20 USE in_out_manager ! I/O manager 21 USE phycst ! physical constants 22 USE lib_mpp ! MPP library 23 USE lbclnk ! lateral boundary conditions - mpp exchanges 24 25 #if defined key_si3 26 USE ice, ONLY : at_i_b, a_i_b 27 #endif 17 28 18 29 IMPLICIT NONE … … 61 72 qns (:,:) = 0._wp 62 73 qsr (:,:) = 0._wp 63 ! 74 ! 75 utau_b(:,:) = 0._wp 76 vtau_b(:,:) = 0._wp 77 emp_b (:,:) = 0._wp 78 sfx_b (:,:) = 0._wp 79 qns_b (:,:) = 0._wp 80 ! 64 81 ENDIF 65 82 … … 67 84 END SUBROUTINE usrdef_sbc_oce 68 85 86 69 87 SUBROUTINE usrdef_sbc_ice_tau( kt ) 88 !!--------------------------------------------------------------------- 89 !! *** ROUTINE usrdef_sbc_ice_tau *** 90 !! 91 !! ** Purpose : provide the surface boundary (momentum) condition over 92 !sea-ice 93 !!--------------------------------------------------------------------- 70 94 INTEGER, INTENT(in) :: kt ! ocean time step 95 ! 96 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 97 INTEGER :: ji, jj 98 !!--------------------------------------------------------------------- 99 #if defined key_si3 100 IF( kt==nit000 .AND. lwp) WRITE(numout,*)' usrdef_sbc_ice : BENCH case: constant stress forcing' 101 ! 102 ! define unique value on each point. z2d ranging from 0.05 to -0.05 103 DO jj = 1, jpj 104 DO ji = 1, jpi 105 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 106 ENDDO 107 ENDDO 108 utau_ice(:,:) = 0.1_wp + z2d(:,:) 109 vtau_ice(:,:) = 0.1_wp + z2d(:,:) 110 111 CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 112 #endif 113 ! 71 114 END SUBROUTINE usrdef_sbc_ice_tau 72 115 73 SUBROUTINE usrdef_sbc_ice_flx( kt ) 116 117 SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi ) 118 !!--------------------------------------------------------------------- 119 !! *** ROUTINE usrdef_sbc_ice_flx *** 120 !! 121 !! ** Purpose : provide the surface boundary (flux) condition over 122 !sea-ice 123 !!--------------------------------------------------------------------- 74 124 INTEGER, INTENT(in) :: kt ! ocean time step 125 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phs ! snow thickness 126 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: phi ! ice thickness 127 !! 128 REAL(wp) :: zfr1, zfr2 ! local variables 129 REAL(wp), DIMENSION(jpi,jpj) :: zsnw ! snw distribution after wind blowing 130 !!--------------------------------------------------------------------- 131 ! 132 #if defined key_si3 133 IF( kt==nit000 .AND. lwp) WRITE(numout,*)' usrdef_sbc_ice : BENCH case: NO flux forcing' 134 ! 135 ! ocean variables (renaming) 136 emp_oce (:,:) = 0._wp ! uniform value for freshwater budget (E-P) 137 qsr_oce (:,:) = 0._wp ! uniform value for solar radiation 138 qns_oce (:,:) = 0._wp ! uniform value for non-solar radiation 139 140 ! ice variables 141 alb_ice (:,:,:) = 0.7_wp ! useless 142 qsr_ice (:,:,:) = 0._wp ! uniform value for solar radiation 143 qns_ice (:,:,:) = 0._wp ! uniform value for non-solar radiation 144 sprecip (:,:) = 0._wp ! uniform value for snow precip 145 evap_ice(:,:,:) = 0._wp ! uniform value for sublimation 146 147 ! ice fields deduced from above 148 zsnw(:,:) = 1._wp 149 !!CALL lim_thd_snwblow( at_i_b, zsnw ) ! snow distribution over ice after 150 !wind blowing 151 emp_ice (:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:) 152 emp_oce (:,:) = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) ) 153 qevap_ice(:,:,:) = 0._wp 154 qprec_ice(:,:) = rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! in J/m3 155 qemp_oce (:,:) = - emp_oce(:,:) * sst_m(:,:) * rcp 156 qemp_ice (:,:) = sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only) 157 158 ! total fluxes 159 emp_tot (:,:) = emp_ice + emp_oce 160 qns_tot (:,:) = at_i_b(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 161 qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 162 163 ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- ! 164 zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) ! transmission when hi>10cm 165 zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) ! zfr2 such that zfr1 + zfr2 to equal 1 166 ! 167 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 168 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) ) 169 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (zfr1) when hi>10cm 170 qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1 171 ELSEWHERE ! zero when hs>0 172 qtr_ice_top(:,:,:) = 0._wp 173 END WHERE 174 #endif 175 75 176 END SUBROUTINE usrdef_sbc_ice_flx 76 177
Note: See TracChangeset
for help on using the changeset viewer.