- Timestamp:
- 2010-05-06T10:40:07+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1837_mass_heat_salt_fluxes/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r1730 r1859 12 12 !! 3.0 ! 2006-06 (G. Madec) sbc rewritting 13 13 !! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put 14 !! 3.3 ! 2010-05 (Y. Aksenov G. Madec) salt flux + heat associated with emp 14 15 !!---------------------------------------------------------------------- 15 16 … … 45 46 INTEGER , PARAMETER :: jp_wndi = 1 ! index of 10m wind velocity (i-component) (m/s) at T-point 46 47 INTEGER , PARAMETER :: jp_wndj = 2 ! index of 10m wind velocity (j-component) (m/s) at T-point 47 INTEGER , PARAMETER :: jp_humi = 3 ! index of specific humidity ( -)48 INTEGER , PARAMETER :: jp_humi = 3 ! index of specific humidity ( % ) 48 49 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat (W/m2) 49 50 INTEGER , PARAMETER :: jp_qlw = 5 ! index of Long wave (W/m2) … … 62 63 REAL(wp), PARAMETER :: Cice = 1.63e-3 ! transfer coefficient over ice 63 64 64 ! !!* Namelist namsbc_core : CORE bulk parameters65 LOGICAL :: ln_2m = .FALSE. ! logical flag for height of air temp. and hum66 LOGICAL :: ln_taudif = .FALSE. ! logical flag to use the "mean of stress module - module of mean stress" data67 REAL(wp) :: rn_pfac = 1. ! multiplicati onfactor for precipitation65 ! !!* Namelist namsbc_core : CORE bulk parameters 66 LOGICAL :: ln_2m = .FALSE. ! air temperature and humidity given at 2m (T) or 10m (F) 67 LOGICAL :: ln_taudif = .FALSE. ! (T) use the "mean of stress module - module of mean stress" data or (F) not 68 REAL(wp) :: rn_pfac = 1. ! multiplicative factor for precipitation 68 69 69 70 !! * Substitutions … … 71 72 # include "vectopt_loop_substitute.h90" 72 73 !!---------------------------------------------------------------------- 73 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)74 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 74 75 !! $Id$ 75 76 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 88 89 !! the 10m wind velocity (i-component) (m/s) at T-point 89 90 !! the 10m wind velocity (j-component) (m/s) at T-point 90 !! the specific humidity ( -)91 !! the 10m or 2m specific humidity ( % ) 91 92 !! the solar heat (W/m2) 92 93 !! the Long wave (W/m2) 93 !! the 10m air temperature(Kelvin)94 !! the 10m or 2m air temperature (Kelvin) 94 95 !! the total precipitation (rain+snow) (Kg/m2/s) 95 96 !! the snow (solid prcipitation) (kg/m2/s) 96 !! OPTIONAL parameter (see ln_taudif namelist flag): 97 !! the tau diff associated to HF tau (N/m2) at T-point 97 !! the tau diff associated to HF tau (N/m2) at T-point (ln_taudif=T) 98 98 !! (2) CALL blk_oce_core 99 99 !! 100 100 !! C A U T I O N : never mask the surface stress fields 101 !! the stress is assumed to be in the mesh referential 102 !! i.e. the (i,j) referential 101 !! the stress is assumed to be in the (i,j) mesh referential 103 102 !! 104 103 !! ** Action : defined at each time-step at the air-sea interface 105 104 !! - utau, vtau i- and j-component of the wind stress 106 !! - taum wind stress module at T-point 107 !! - wndm 10m wind module at T-point 108 !! - qns, qsr non-slor and solar heat flux 109 !! - emp, emps evaporation minus precipitation 105 !! - taum, wndm wind stress and 10m wind modules at T-point 106 !! - qns, qsr non-solar and solar heat flux 107 !! - emp upward mass flux (evapo. - precip.) 110 108 !!---------------------------------------------------------------------- 111 109 INTEGER, INTENT( in ) :: kt ! ocean time step 112 110 !! 111 INTEGER :: jf ! dummy loop indice 112 INTEGER :: ifld ! number of files to be read 113 113 INTEGER :: ierror ! return error code 114 INTEGER :: ifpr ! dummy loop indice115 INTEGER :: jfld ! dummy loop arguments116 114 !! 117 115 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 118 116 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 119 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 120 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow ! " " 121 TYPE(FLD_N) :: sn_tdif ! " " 117 TYPE(FLD_N) :: sn_wndi, sn_wndj, sn_humi, sn_qsr ! informations about the fields to be read 118 TYPE(FLD_N) :: sn_qlw , sn_tair, sn_prec, sn_snow, sn_tdif ! - - 122 119 NAMELIST/namsbc_core/ cn_dir , ln_2m , ln_taudif, rn_pfac, & 123 120 & sn_wndi, sn_wndj, sn_humi , sn_qsr , & … … 156 153 ! do we use HF tau information? 157 154 lhftau = ln_taudif 158 jfld = jpfld - COUNT( (/.NOT. lhftau/) )155 ifld = jpfld - COUNT( (/.NOT. lhftau/) ) 159 156 ! 160 157 ! set sf structure 161 ALLOCATE( sf( jfld), STAT=ierror )158 ALLOCATE( sf(ifld), STAT=ierror ) 162 159 IF( ierror > 0 ) THEN 163 160 CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' ) ; RETURN 164 161 ENDIF 165 DO ifpr= 1, jfld166 ALLOCATE( sf( ifpr)%fnow(jpi,jpj) )167 ALLOCATE( sf( ifpr)%fdta(jpi,jpj,2) )162 DO jf = 1, ifld 163 ALLOCATE( sf(jf)%fnow(jpi,jpj) ) 164 ALLOCATE( sf(jf)%fdta(jpi,jpj,2) ) 168 165 END DO 169 166 ! … … 173 170 ENDIF 174 171 172 !!gm all the below lines should be executed only at nn_fbc frequency, no??? check fldread capability 173 175 174 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 176 175 ! 177 176 #if defined key_lim3 178 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:) 177 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:) ! air temperature over ice (LIM3 only) 179 178 #endif 180 181 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 182 CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) ! compute the surface ocean fluxes using CLIO bulk formulea 183 ENDIF 184 ! ! using CORE bulk formulea 179 ! ! surface ocean fluxes using CORE bulk formulea 180 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 181 ! 185 182 END SUBROUTINE sbc_blk_core 186 183 … … 196 193 !! fields read in sbc_read 197 194 !! 198 !! ** Outputs : - utau : i-component of the stress at U-point (N/m2) 199 !! - vtau : j-component of the stress at V-point (N/m2) 200 !! - taum : Wind stress module at T-point (N/m2) 201 !! - wndm : Wind speed module at T-point (m/s) 202 !! - qsr : Solar heat flux over the ocean (W/m2) 203 !! - qns : Non Solar heat flux over the ocean (W/m2) 204 !! - evap : Evaporation over the ocean (kg/m2/s) 205 !! - emp(s) : evaporation minus precipitation (kg/m2/s) 195 !! ** Action : - utau : i-component of the stress at U-point (N/m2) 196 !! - vtau : j-component of the stress at V-point (N/m2) 197 !! - taum : Wind stress module at T-point (N/m2) 198 !! - wndm : 10m Wind speed module at T-point (m/s) 199 !! - qsr : Solar heat flux over the ocean (W/m2) 200 !! - qns : Non Solar heat flux over the ocean (W/m2) 201 !! including the latent heat of solid 202 !! precip. melting and emp heat content 203 !! - emp : upward mass flux (evap. - precip.) (kg/m2/s) 206 204 !! 207 205 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC 208 206 !!--------------------------------------------------------------------- 209 TYPE(fld), INTENT(in), DIMENSION(:) :: sf ! input data 210 REAL(wp) ,INTENT(in), DIMENSION(jpi,jpj) :: pst ! surface temperature [Celcius]211 REAL(wp) ,INTENT(in), DIMENSION(jpi,jpj) :: pu ! surface current at U-point (i-component) [m/s]212 REAL(wp) ,INTENT(in), DIMENSION(jpi,jpj) :: pv ! surface current at V-point (j-component) [m/s]213 207 TYPE(fld), INTENT(in), DIMENSION(:) :: sf ! input data (forcing field structure) 208 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pst ! surface temperature [Celcius] 209 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pu ! surface current at U-point (i-component) [m/s] 210 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pv ! surface current at V-point (j-component) [m/s] 211 !! 214 212 INTEGER :: ji, jj ! dummy loop indices 215 REAL(wp) :: zcoef_qsatw 216 REAL(wp) :: zztmp ! temporary variable 213 REAL(wp) :: zcoef_qsatw, zztmp ! temporary scalar 217 214 REAL(wp), DIMENSION(jpi,jpj) :: zwnd_i, zwnd_j ! wind speed components at T-point 218 215 REAL(wp), DIMENSION(jpi,jpj) :: zqsatw ! specific humidity at pst … … 230 227 zcoef_qsatw = 0.98 * 640380. / rhoa 231 228 232 zst(:,:) = pst(:,:) + rt0 ! converte Celcius to Kelvin (and set minimum value far above 0 K)229 zst(:,:) = pst(:,:) + rt0 ! converte SST from Celcius to Kelvin (and set minimum value far above 0 K) 233 230 234 231 ! ----------------------------------------------------------------------------- ! … … 262 259 ! ocean albedo assumed to be 0.066 263 260 !CDIR COLLAPSE 264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:) * tmask(:,:,1) ! Short Wave261 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:) * tmask(:,:,1) ! Short Wave 265 262 !CDIR COLLAPSE 266 263 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave … … 353 350 354 351 !CDIR COLLAPSE 355 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! Downward Non Solar flux 356 !CDIR COLLAPSE 357 emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * rn_pfac * tmask(:,:,1) 358 !CDIR COLLAPSE 359 emps(:,:) = emp(:,:) 352 emp (:,:) = ( zevap(:,:) & ! mass flux (evap. - precip.) 353 & - sf(jp_prec)%fnow(:,:) * rn_pfac ) * tmask(:,:,1) 354 !CDIR COLLAPSE 355 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) & ! Downward Non Solar flux 356 & - sf(jp_snow)%fnow(:,:) * lfus & ! remove latent melting heat for solid precip 357 & - zevap(:,:) * pst(ji,jj) * rcp & ! remove evap heat content at SST 358 & + ( sf(jp_prec)%fnow(:,:) - sf(jp_snow)%fnow(:,:) ) & ! add liquid precip heat content at Tair 359 & * ( sf(jp_tair)%fnow(:,:) - rt0 ) * rcp & 360 & + sf(jp_snow)%fnow(:,:) & ! add solid precip heat content at min(Tair,Tsnow) 361 & * ( MIN( sf(jp_tair)%fnow(:,:), rt0_snow ) - rt0 ) * cpic 360 362 ! 361 363 CALL iom_put( "qlw_oce", zqlw ) ! output downward longwave heat over the ocean … … 392 394 !! caution : the net upward water flux has with mm/day unit 393 395 !!--------------------------------------------------------------------- 394 REAL(wp), INTENT(in ), DIMENSION(:,:,:) 395 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) 396 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) 397 REAL(wp), INTENT(in ), DIMENSION(:,:,:) 398 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) 399 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) 400 REAL(wp), INTENT( out), DIMENSION(:,:,:) 401 REAL(wp), INTENT( out), DIMENSION(:,:,:) 402 REAL(wp), INTENT( out), DIMENSION(:,:,:) 403 REAL(wp), INTENT( out), DIMENSION(:,:,:) 404 REAL(wp), INTENT( out), DIMENSION(:,:,:) 405 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) 406 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) 407 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) 408 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) 409 CHARACTER(len=1), INTENT(in ) 410 INTEGER, INTENT(in ) 396 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature (>0, =rt0 over land) [Kelvin] 397 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pui ! ice surface velocity (i- and i- components [m/s] 398 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pvi ! at I-point (B-grid) or U & V-point (C-grid) 399 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%] 400 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! i- & j-components of surface ice stress [N/m2] 401 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 402 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 403 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 404 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 405 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 406 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 407 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 408 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 409 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%] 410 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%] 411 CHARACTER(len=1), INTENT(in ) :: cd_grid ! ice grid ( C or B-grid) 412 INTEGER, INTENT(in ) :: pdim ! number of ice categories 411 413 !! 412 414 INTEGER :: ji, jj, jl ! dummy loop indices 413 415 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 414 REAL(wp) :: zst2, z st3415 REAL(wp) :: z coef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb416 REAL(wp) :: zcoef_frca 417 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f 418 REAL(wp) :: zwndi_t , zwndj_t 419 REAL(wp), DIMENSION(jpi,jpj) :: z_wnds_t! wind speed ( = | U10m - U_ice | ) at T-point420 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_qlw 421 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_qsb 422 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_dqlw 423 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_dqsb 416 REAL(wp) :: zst2, zcoef_wnorm , zcoef_dqlw ! 417 REAL(wp) :: zst3, zcoef_wnorm2, zcoef_dqla, zcoef_dqsb ! 418 REAL(wp) :: zcoef_frca ! fractional cloud amount 419 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 420 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 421 REAL(wp), DIMENSION(jpi,jpj) :: z_wnds_t ! wind speed ( = | U10m - U_ice | ) at T-point 422 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_qlw ! long wave heat flux over ice 423 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_qsb ! sensible heat flux over ice 424 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_dqlw ! long wave heat sensitivity over ice 425 REAL(wp), DIMENSION(jpi,jpj,pdim) :: z_dqsb ! sensible heat sensitivity over ice 424 426 !!--------------------------------------------------------------------- 425 427 … … 576 578 CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ') 577 579 ENDIF 578 580 ! 579 581 END SUBROUTINE blk_ice_core 580 582 581 583 582 584 SUBROUTINE TURB_CORE_1Z(zu, sst, T_a, q_sat, q_a, & 583 & dU , Cd, Ch, Ce )585 & dU , Cd , Ch , Ce ) 584 586 !!---------------------------------------------------------------------- 585 587 !! *** ROUTINE turb_core *** … … 704 706 705 707 706 SUBROUTINE TURB_CORE_2Z(zt, zu, sst, T_zt, q_sat, q_zt, dU, Cd, Ch, Ce, T_zu, q_zu) 708 SUBROUTINE TURB_CORE_2Z( zt , zu, sst, T_zt, q_sat, & 709 & q_zt, dU, Cd , Ch , Ce , T_zu, q_zu) 707 710 !!---------------------------------------------------------------------- 708 711 !! *** ROUTINE turb_core *** … … 838 841 Ce = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct 839 842 !! 840 !!841 843 END DO 842 ! !844 ! 843 845 END SUBROUTINE TURB_CORE_2Z 844 846
Note: See TracChangeset
for help on using the changeset viewer.
