Changeset 11309
- Timestamp:
- 2019-07-19T15:53:01+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11265_ASINTER-01_Guillaume_ABL1D/src/OCE/SBC/sbcblk.F90
r11304 r11309 77 77 #endif 78 78 79 INTERFACE cp_air 80 MODULE PROCEDURE cp_air_0d, cp_air_2d 81 END INTERFACE 82 83 !!Lolo: should ultimately be moved in the module with all physical constants ? 84 !!gm : In principle, yes. 85 REAL(wp) , PARAMETER :: Cp_dry = 1005.0 !: Specic heat of dry air, constant pressure [J/K/kg] 86 REAL(wp) , PARAMETER :: Cp_vap = 1860.0 !: Specic heat of water vapor, constant pressure [J/K/kg] 87 REAL(wp), PUBLIC, PARAMETER :: R_dry = 287.05_wp !: Specific gas constant for dry air [J/K/kg] 88 REAL(wp) , PARAMETER :: R_vap = 461.495_wp !: Specific gas constant for water vapor [J/K/kg] 89 REAL(wp) , PARAMETER :: reps0 = R_dry/R_vap !: ratio of gas constant for dry air and water vapor => ~ 0.622 90 REAL(wp), PUBLIC, PARAMETER :: rctv0 = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 79 INTERFACE cp_air 80 MODULE PROCEDURE cp_air_0d, cp_air_2d 81 END INTERFACE 82 83 ! !!* Namelist namsbc_blk : bulk parameters 84 LOGICAL :: ln_NCAR ! "NCAR" algorithm (Large and Yeager 2008) 85 LOGICAL :: ln_COARE_3p0 ! "COARE 3.0" algorithm (Fairall et al. 2003) 86 LOGICAL :: ln_COARE_3p5 ! "COARE 3.5" algorithm (Edson et al. 2013) 87 LOGICAL :: ln_ECMWF ! "ECMWF" algorithm (IFS cycle 31) 88 ! ! 89 REAL(wp) :: rn_pfac ! multiplication factor for precipitation 90 REAL(wp), PUBLIC :: rn_efac !: multiplication factor for evaporation 91 REAL(wp), PUBLIC :: rn_vfac !: multiplication factor for ice/ocean velocity in the calculation of wind stress 92 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 93 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 94 ! ! 95 LOGICAL :: ln_Cd_L12 ! ice-atm drag = F( ice concentration ) (Lupkes et al. JGR2012) 96 LOGICAL :: ln_Cd_L15 ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 97 98 INTEGER :: nblk ! choice of the bulk algorithm 99 ! ! associated indices: 100 INTEGER, PARAMETER :: np_NCAR = 1 ! "NCAR" algorithm (Large and Yeager 2008) 101 INTEGER, PARAMETER :: np_COARE_3p0 = 2 ! "COARE 3.0" algorithm (Fairall et al. 2003) 102 INTEGER, PARAMETER :: np_COARE_3p5 = 3 ! "COARE 3.5" algorithm (Edson et al. 2013) 103 INTEGER, PARAMETER :: np_ECMWF = 4 ! "ECMWF" algorithm (IFS cycle 31) 104 105 ! !!! air parameters 106 REAL(wp) , PARAMETER :: Cp_dry = 1005.0 ! Specic heat of dry air, constant pressure [J/K/kg] 107 REAL(wp) , PARAMETER :: Cp_vap = 1860.0 ! Specic heat of water vapor, constant pressure [J/K/kg] 108 REAL(wp), PUBLIC, PARAMETER :: R_dry = 287.05_wp !: Specific gas constant for dry air [J/K/kg] 109 REAL(wp) , PARAMETER :: R_vap = 461.495_wp ! Specific gas constant for water vapor [J/K/kg] 110 REAL(wp) , PARAMETER :: reps0 = R_dry/R_vap ! ratio of gas constant for dry air and water vapor => ~ 0.622 111 REAL(wp), PUBLIC, PARAMETER :: rctv0 = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 112 ! !!! Bulk parameters 113 REAL(wp) , PARAMETER :: cpa = 1000.5 ! specific heat of air (only used for ice fluxes now...) 114 REAL(wp) , PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 115 REAL(wp) , PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 116 REAL(wp) , PARAMETER :: Cd_ice = 1.4e-3 ! transfer coefficient over ice 117 REAL(wp) , PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 118 ! 119 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cd_atm , Ch_atm , Ce_atm ! transfer coeffs. for momentum, sensible heat, and evaporation 120 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cdn_oce, Chn_oce, Cen_oce ! neutral coeffs (needed for Lupkes et al. 2015 bulk scheme) 121 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_zu, q_zu ! air temp. and spec. hum. at wind speed height (needed for Lupkes 2015 bulk scheme) 91 122 92 123 INTEGER , PUBLIC, PARAMETER :: jpfld =11 !: maximum number of files to read … … 103 134 INTEGER , PUBLIC, PARAMETER :: jp_hpgj =11 !: index of ABL geostrophic wind or hpg (j-component) (m/s) at T-point 104 135 105 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 106 107 ! !!! Bulk parameters 108 REAL(wp), PARAMETER :: cpa = 1000.5 ! specific heat of air (only used for ice fluxes now...) 109 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 110 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 111 REAL(wp), PARAMETER :: Cd_ice = 1.4e-3 ! transfer coefficient over ice 112 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 113 ! 114 ! !!* Namelist namsbc_blk : bulk parameters 115 LOGICAL :: ln_NCAR ! "NCAR" algorithm (Large and Yeager 2008) 116 LOGICAL :: ln_COARE_3p0 ! "COARE 3.0" algorithm (Fairall et al. 2003) 117 LOGICAL :: ln_COARE_3p5 ! "COARE 3.5" algorithm (Edson et al. 2013) 118 LOGICAL :: ln_ECMWF ! "ECMWF" algorithm (IFS cycle 31) 119 ! 120 REAL(wp) :: rn_pfac ! multiplication factor for precipitation 121 REAL(wp), PUBLIC :: rn_efac !: multiplication factor for evaporation 122 REAL(wp), PUBLIC :: rn_vfac !: multiplication factor for ice/ocean velocity in the calculation of wind stress 123 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 124 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 125 !!gm ref namelist initialize it so remove the setting to false below 126 LOGICAL :: ln_Cd_L12 = .FALSE. ! Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012) 127 LOGICAL :: ln_Cd_L15 = .FALSE. ! Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015) 128 ! 129 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cd_atm ! transfer coefficient for momentum (tau) 130 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Ch_atm ! transfer coefficient for sensible heat (Q_sens) 131 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Ce_atm ! tansfert coefficient for evaporation (Q_lat) 132 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_zu ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme) 133 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_zu ! air spec. hum. at wind speed height (needed by Lupkes 2015 bulk scheme) 134 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme 135 136 INTEGER :: nblk ! choice of the bulk algorithm 137 ! ! associated indices: 138 INTEGER, PARAMETER :: np_NCAR = 1 ! "NCAR" algorithm (Large and Yeager 2008) 139 INTEGER, PARAMETER :: np_COARE_3p0 = 2 ! "COARE 3.0" algorithm (Fairall et al. 2003) 140 INTEGER, PARAMETER :: np_COARE_3p5 = 3 ! "COARE 3.5" algorithm (Edson et al. 2013) 141 INTEGER, PARAMETER :: np_ECMWF = 4 ! "ECMWF" algorithm (IFS cycle 31) 136 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf ! structure of input atmospheric fields (file informations, fields read) 142 137 143 138 !! * Substitutions … … 155 150 !!------------------------------------------------------------------- 156 151 ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 157 & cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc )152 & Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 158 153 ! 159 154 CALL mpp_sum ( 'sbcblk', sbc_blk_alloc ) … … 171 166 !! 172 167 !!---------------------------------------------------------------------- 173 INTEGER :: ifpr ! dummy loop indice and argument168 INTEGER :: jfpr ! dummy loop indice and argument 174 169 INTEGER :: ios, ierror, ioptio ! Local integer 175 170 !! … … 233 228 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 234 229 ! 235 DO ifpr= 1, jpfld230 DO jfpr= 1, jpfld 236 231 ! 237 IF( TRIM(sf(ifpr)%clrootname) /= 'NOT USED' ) THEN 238 IF( ln_abl .AND. ( ifpr == jp_wndi .OR. ifpr == jp_wndj .OR. ifpr == jp_humi & 239 & .OR. ifpr == jp_hpgi .OR. ifpr == jp_hpgj .OR. ifpr == jp_tair ) ) THEN 240 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,jpka) ) 241 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,jpka,2) ) 242 ELSE 243 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 244 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 232 IF( TRIM(sf(jfpr)%clrootname) == 'NOT USED' ) THEN !-- not used field --! (only now allocated and set to zero) 233 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 234 sf(jfpr)%fnow(:,:,1) = 0._wp 235 ELSE !-- used field --! 236 IF( ln_abl .AND. & 237 & ( jfpr == jp_wndi .OR. jfpr == jp_wndj .OR. jfpr == jp_humi .OR. & 238 & jfpr == jp_hpgi .OR. jfpr == jp_hpgj .OR. jfpr == jp_tair ) ) THEN ! ABL: some fields are 3D input 239 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,jpka) ) 240 IF( slf_i(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,jpka,2) ) 241 ELSE ! others or Bulk fields are 2D fiels 242 ALLOCATE( sf(jfpr)%fnow(jpi,jpj,1) ) 243 IF( slf_i(jfpr)%ln_tint ) ALLOCATE( sf(jfpr)%fdta(jpi,jpj,1,2) ) 245 244 ENDIF 246 245 ! 247 IF( slf_i( ifpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(ifpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 ) &246 IF( slf_i(jfpr)%freqh > 0. .AND. MOD( NINT(3600. * slf_i(jfpr)%freqh), nn_fsbc * NINT(rdt) ) /= 0 ) & 248 247 & CALL ctl_warn( 'sbc_blk_init: sbcmod timestep rdt*nn_fsbc is NOT a submultiple of atmospheric forcing frequency.', & 249 248 & ' This is not ideal. You should consider changing either rdt or nn_fsbc value...' ) … … 251 250 END DO 252 251 ! 253 IF ( ln_wave ) THEN 254 !Activated wave module but neither drag nor stokes drift activated 255 IF ( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) ) THEN 256 CALL ctl_stop( 'STOP', 'Ask for wave coupling but ln_cdgw=F, ln_sdw=F, ln_tauwoc=F, ln_stcor=F' ) 257 !drag coefficient read from wave model definable only with mfs bulk formulae and core 258 ELSEIF (ln_cdgw .AND. .NOT. ln_NCAR ) THEN 259 CALL ctl_stop( 'drag coefficient read from wave model definable only with NCAR and CORE bulk formulae') 260 ELSEIF (ln_stcor .AND. .NOT. ln_sdw) THEN 261 CALL ctl_stop( 'Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 252 IF( ln_wave ) THEN ! surface waves 253 IF( .NOT.(ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) ) & ! Activated wave module but neither drag nor stokes drift activated 254 & CALL ctl_stop( 'sbc_blk_init: Ask for wave coupling but ln_cdgw=ln_sdw=ln_tauwoc=ln_stcor=F' ) 255 IF( ln_cdgw .AND. .NOT.ln_NCAR ) & ! drag coefficient read from wave model only with NCAR bulk formulae 256 & CALL ctl_stop( 'sbc_blk_init: drag coefficient read from wave model need NCAR bulk formulae') 257 IF( ln_stcor .AND. .NOT.ln_sdw ) & 258 CALL ctl_stop( 'sbc_blk_init: Stokes-Coriolis term calculated only if activated Stokes Drift ln_sdw=T') 259 ELSE 260 IF( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) THEN 261 CALL ctl_warn( 'sbc_blk_init: ln_wave=F, set all wave-related namelist parameter to FALSE') 262 ln_cdgw =.FALSE. ; ln_sdw =.FALSE. ; ln_tauwoc =.FALSE. ; ln_stcor =.FALSE. 262 263 ENDIF 263 ELSE264 IF ( ln_cdgw .OR. ln_sdw .OR. ln_tauwoc .OR. ln_stcor ) &265 & CALL ctl_stop( 'Not Activated Wave Module (ln_wave=F) but asked coupling ', &266 & 'with drag coefficient (ln_cdgw =T) ' , &267 & 'or Stokes Drift (ln_sdw=T) ' , &268 & 'or ocean stress modification due to waves (ln_tauwoc=T) ', &269 & 'or Stokes-Coriolis term (ln_stcori=T)' )270 264 ENDIF 271 265 ! 272 IF( ln_abl ) THEN ! ABL: read 3D fields for wind, temperature and humidity266 IF( ln_abl ) THEN ! ABL: read 3D fields for wind, temperature, humidity and pressure gradient 273 267 rn_zqt = ght_abl(2) ! set the bulk altitude to ABL first level 274 268 rn_zu = ght_abl(2) 275 269 IF(lwp) WRITE(numout,*) 276 IF(lwp) WRITE(numout,*) ' ABL formulation:overwrite rn_zqt & rn_zu with ABL first level altitude'270 IF(lwp) WRITE(numout,*) ' ABL formulation: overwrite rn_zqt & rn_zu with ABL first level altitude' 277 271 ENDIF 278 272 ! … … 348 342 ! 349 343 ! ! compute the surface ocean fluxes using bulk formulea 350 IF( MOD( kt -1, nn_fsbc ) == 0 ) THEN344 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 351 345 ! 352 346 CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1), & ! <<= in … … 359 353 & sf(jp_snow)%fnow(:,:,1), sst_m, & ! <<= in 360 354 & zsen, zevp ) ! <=> in out 361 362 355 ENDIF 363 356 364 357 #if defined key_cice 365 IF( MOD( kt -1, nn_fsbc ) == 0 ) THEN358 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 366 359 qlw_ice(:,:,1) = sf(jp_qlw )%fnow(:,:,1) 367 360 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) … … 468 461 ! 469 462 CASE( np_NCAR ) ; CALL turb_ncar ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! NCAR-COREv2 470 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )463 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 471 464 CASE( np_COARE_3p0 ) ; CALL turb_coare ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! COARE v3.0 472 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )465 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 473 466 CASE( np_COARE_3p5 ) ; CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! COARE v3.5 474 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )467 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 475 468 CASE( np_ECMWF ) ; CALL turb_ecmwf ( rn_zqt, rn_zu, zst, ztpot, pssq, phumi, wndm, & ! ECMWF 476 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce )469 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, Cdn_oce, Chn_oce, Cen_oce ) 477 470 CASE DEFAULT 478 471 CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' )
Note: See TracChangeset
for help on using the changeset viewer.