- Timestamp:
- 2021-05-07T13:44:43+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/SBC/sbcblk.F90
r14574 r14806 892 892 REAL(wp) :: zztmp,zz1,zz2,zz3 ! local variable 893 893 REAL(wp), DIMENSION(jpi,jpj) :: zqlw ! net long wave radiative heat flux 894 !!--------------------------------------------------------------------- 895 ! 896 ! local scalars ( place there for vector optimisation purposes) 897 894 REAL(wp), DIMENSION(jpi,jpj) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg) 895 !!--------------------------------------------------------------------- 896 ! 897 ! Heat content per unit mass (J/kg) 898 zcptrain(:,:) = ( ptair - rt0 ) * rcp * tmask(:,:,1) 899 zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1) 900 zcptn (:,:) = ptsk * rcp * tmask(:,:,1) 901 ! 898 902 ! ----------------------------------------------------------------------------- ! 899 903 ! III Net longwave radiative FLUX ! … … 907 911 ! ----------------------------------------------------------------------------- ! 908 912 ! 909 emp (:,:) = ( pevp(:,:) & ! mass flux (evap. - precip.) 910 & - pprec(:,:) * rn_pfac ) * tmask(:,:,1) 911 ! 912 qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:) & ! Downward Non Solar 913 & - psnow(:,:) * rn_pfac * rLfus & ! remove latent melting heat for solid precip 914 & - pevp(:,:) * ptsk(:,:) * rcp & ! remove evap heat content at SST 915 & + ( pprec(:,:) - psnow(:,:) ) * rn_pfac & ! add liquid precip heat content at Tair 916 & * ( ptair(:,:) - rt0 ) * rcp & 917 & + psnow(:,:) * rn_pfac & ! add solid precip heat content at min(Tair,Tsnow) 918 & * ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi 913 emp (:,:) = ( pevp(:,:) - pprec(:,:) * rn_pfac ) * tmask(:,:,1) ! mass flux (evap. - precip.) 914 ! 915 qns(:,:) = zqlw(:,:) + psen(:,:) + plat(:,:) & ! Downward Non Solar 916 & - psnow(:,:) * rn_pfac * rLfus & ! remove latent melting heat for solid precip 917 & - pevp(:,:) * zcptn(:,:) & ! remove evap heat content at SST 918 & + ( pprec(:,:) - psnow(:,:) ) * rn_pfac * zcptrain(:,:) & ! add liquid precip heat content at Tair 919 & + psnow(:,:) * rn_pfac * zcptsnw(:,:) ! add solid precip heat content at min(Tair,Tsnow) 919 920 qns(:,:) = qns(:,:) * tmask(:,:,1) 920 921 ! … … 1000 1001 ! C-grid ice dynamics : U & V-points (same as ocean) 1001 1002 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 1002 wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) )1003 wndm_ice(ji,jj) = SQRT( pwndi(ji,jj) * pwndi(ji,jj) + pwndj(ji,jj) * pwndj(ji,jj) ) 1003 1004 END_2D 1004 1005 ! … … 1120 1121 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z_dqsb ! sensible heat sensitivity over ice 1121 1122 REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3) 1122 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp21123 1123 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1124 REAL(wp), DIMENSION(jpi,jpj) :: zcptrain, zcptsnw, zcptn ! Heat content per unit mass (J/kg) 1124 1125 !!--------------------------------------------------------------------- 1125 1126 ! … … 1130 1131 dqla_ice(:,:,:) = 0._wp 1131 1132 1133 ! Heat content per unit mass (J/kg) 1134 zcptrain(:,:) = ( ptair - rt0 ) * rcp * tmask(:,:,1) 1135 zcptsnw (:,:) = ( MIN( ptair, rt0 ) - rt0 ) * rcpi * tmask(:,:,1) 1136 zcptn (:,:) = sst_m * rcp * tmask(:,:,1) 1137 ! 1132 1138 ! ! ========================== ! 1133 1139 DO jl = 1, jpl ! Loop over ice categories ! … … 1205 1211 1206 1212 ! --- heat flux associated with emp --- ! 1207 qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst 1208 & + ( tprecip(:,:) - sprecip(:,:) ) * ( ptair(:,:) - rt0 ) * rcp & ! liquid precip at Tair 1209 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) 1210 & ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 1211 qemp_ice(:,:) = sprecip(:,:) * zsnw * & ! solid precip (only) 1212 & ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus ) 1213 qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * zcptn(:,:) & ! evap at sst 1214 & + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) & ! liquid precip at Tair 1215 & + sprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip at min(Tair,Tsnow) 1216 qemp_ice(:,:) = sprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip (only) 1213 1217 1214 1218 ! --- total solar and non solar fluxes --- ! … … 1218 1222 1219 1223 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1220 qprec_ice(:,:) = rhos * ( ( MIN( ptair(:,:), rt0 ) - rt0 ) * rcpi * tmask(:,:,1) - rLfus )1224 qprec_ice(:,:) = rhos * ( zcptsnw(:,:) - rLfus ) 1221 1225 1222 1226 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- … … 1250 1254 ! 1251 1255 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN 1252 ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) 1253 IF( iom_use('evap_ao_cea' ) ) CALL iom_put( 'evap_ao_cea' , ztmp(:,:) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1254 IF( iom_use('hflx_evap_cea') ) CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) ) ! heat flux from evap (cell average) 1255 ENDIF 1256 IF( iom_use('hflx_rain_cea') ) THEN 1257 ztmp(:,:) = rcp * ( SUM( (ptsu-rt0) * a_i_b, dim=3 ) + sst_m(:,:) * ( 1._wp - at_i_b(:,:) ) ) 1258 IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) ) ! heat flux from rain (cell average) 1259 ENDIF 1260 IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea') ) THEN 1261 WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 ) 1262 ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 1263 ELSEWHERE 1264 ztmp(:,:) = rcp * sst_m(:,:) 1265 ENDWHERE 1266 ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus ) 1267 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , ztmp2(:,:) ) ! heat flux from snow (cell average) 1268 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1269 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) * zsnw(:,:) ) ! heat flux from snow (over ice) 1256 CALL iom_put( 'evap_ao_cea' , zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1257 CALL iom_put( 'hflx_evap_cea', zevap(:,:) * ( 1._wp - at_i_b(:,:) ) * tmask(:,:,1) * zcptn(:,:) ) ! heat flux from evap (cell average) 1258 ENDIF 1259 IF( iom_use('rain') .OR. iom_use('rain_ao_cea') .OR. iom_use('hflx_rain_cea') ) THEN 1260 CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1261 CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * ( 1._wp - at_i_b(:,:) ) ) ! liquid precipitation over ocean (cell average) 1262 CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1263 ENDIF 1264 IF( iom_use('snow_ao_cea') .OR. iom_use('snow_ai_cea') .OR. & 1265 & iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea') ) THEN 1266 CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1267 CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1268 CALL iom_put( 'hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1269 CALL iom_put( 'hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1270 CALL iom_put( 'hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) * zsnw(:,:) ) ! heat flux from snow (over ice) 1271 ENDIF 1272 IF( iom_use('hflx_prec_cea') ) THEN ! heat flux from precip (cell average) 1273 CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw (:,:) - rLfus ) & 1274 & + ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) 1275 ENDIF 1276 IF( iom_use('subl_ai_cea') .OR. iom_use('hflx_subl_cea') ) THEN 1277 CALL iom_put( 'subl_ai_cea' , SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1278 CALL iom_put( 'hflx_subl_cea', SUM( a_i_b(:,:,:) * qevap_ice(:,:,:), dim=3 ) * tmask(:,:,1) ) ! Heat flux from sublimation (cell average) 1270 1279 ENDIF 1271 1280 !
Note: See TracChangeset
for help on using the changeset viewer.
