Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r2419 r2528 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-10 (S. Masson) add diurnal cycle 14 15 !!---------------------------------------------------------------------- 15 16 … … 26 27 USE fldread ! read input fields 27 28 USE sbc_oce ! Surface boundary condition: ocean fields 29 USE sbcdcy ! surface boundary condition: diurnal cycle 28 30 USE iom ! I/O manager library 29 31 USE in_out_manager ! I/O manager … … 34 36 USE sbc_ice ! Surface boundary condition: ice fields 35 37 #endif 36 37 38 38 39 IMPLICIT NONE … … 61 62 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 62 63 REAL(wp), PARAMETER :: Cice = 1.63e-3 ! transfer coefficient over ice 63 64 ! !!* Namelist namsbc_core : CORE bulk parameters 65 LOGICAL :: ln_2m = .FALSE. ! logical flag for height of air temp. and hum 66 LOGICAL :: ln_taudif = .FALSE. ! logical flag to use the "mean of stress module - module of mean stress" data 67 REAL(wp) :: rn_pfac = 1. ! multiplication factor for precipitation 64 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be contant 65 66 ! !!* Namelist namsbc_core : CORE bulk parameters 67 LOGICAL :: ln_2m = .FALSE. ! logical flag for height of air temp. and hum 68 LOGICAL :: ln_taudif = .FALSE. ! logical flag to use the "mean of stress module - module of mean stress" data 69 REAL(wp) :: rn_pfac = 1. ! multiplication factor for precipitation 68 70 69 71 !! * Substitutions … … 71 73 # include "vectopt_loop_substitute.h90" 72 74 !!---------------------------------------------------------------------- 73 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)75 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 74 76 !! $Id$ 75 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)77 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 76 78 !!---------------------------------------------------------------------- 77 78 79 CONTAINS 79 80 … … 132 133 ! 133 134 ! (NB: frequency positive => hours, negative => months) 134 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation!135 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs!136 sn_wndi = FLD_N( 'uwnd10m' , 24 , 'u_10' , .false. , .false. , 'yearly' , '' , '')137 sn_wndj = FLD_N( 'vwnd10m' , 24 , 'v_10' , .false. , .false. , 'yearly' , '' , '')138 sn_qsr = FLD_N( 'qsw' , 24 , 'qsw' , .false. , .false. , 'yearly' , '' , '')139 sn_qlw = FLD_N( 'qlw' , 24 , 'qlw' , .false. , .false. , 'yearly' , '' , '')140 sn_tair = FLD_N( 'tair10m' , 24 , 't_10' , .false. , .false. , 'yearly' , '' , '')141 sn_humi = FLD_N( 'humi10m' , 24 , 'q_10' , .false. , .false. , 'yearly' , '' , '')142 sn_prec = FLD_N( 'precip' , -1 , 'precip' , .true. , .false. , 'yearly' , '' , '')143 sn_snow = FLD_N( 'snow' , -1 , 'snow' , .true. , .false. , 'yearly' , '' , '')144 sn_tdif = FLD_N( 'taudif' , 24 , 'taudif' , .true. , .false. , 'yearly' , '' , '')135 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 136 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 137 sn_wndi = FLD_N( 'uwnd10m', 24 , 'u_10' , .false. , .false. , 'yearly' , '' , '' ) 138 sn_wndj = FLD_N( 'vwnd10m', 24 , 'v_10' , .false. , .false. , 'yearly' , '' , '' ) 139 sn_qsr = FLD_N( 'qsw' , 24 , 'qsw' , .false. , .false. , 'yearly' , '' , '' ) 140 sn_qlw = FLD_N( 'qlw' , 24 , 'qlw' , .false. , .false. , 'yearly' , '' , '' ) 141 sn_tair = FLD_N( 'tair10m', 24 , 't_10' , .false. , .false. , 'yearly' , '' , '' ) 142 sn_humi = FLD_N( 'humi10m', 24 , 'q_10' , .false. , .false. , 'yearly' , '' , '' ) 143 sn_prec = FLD_N( 'precip' , -1 , 'precip' , .true. , .false. , 'yearly' , '' , '' ) 144 sn_snow = FLD_N( 'snow' , -1 , 'snow' , .true. , .false. , 'yearly' , '' , '' ) 145 sn_tdif = FLD_N( 'taudif' , 24 , 'taudif' , .true. , .false. , 'yearly' , '' , '' ) 145 146 ! 146 REWIND( numnam ) ! ...read in namlist namsbc_core147 REWIND( numnam ) ! read in namlist namsbc_core 147 148 READ ( numnam, namsbc_core ) 148 ! 149 ! store namelist information in an array 149 ! ! check: do we plan to use ln_dm2dc with non-daily forcing? 150 IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 ) & 151 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 152 IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN 153 CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr', & 154 & ' ==> We force time interpolation = .false. for qsr' ) 155 sn_qsr%ln_tint = .false. 156 ENDIF 157 ! ! store namelist information in an array 150 158 slf_i(jp_wndi) = sn_wndi ; slf_i(jp_wndj) = sn_wndj 151 159 slf_i(jp_qsr ) = sn_qsr ; slf_i(jp_qlw ) = sn_qlw … … 153 161 slf_i(jp_prec) = sn_prec ; slf_i(jp_snow) = sn_snow 154 162 slf_i(jp_tdif) = sn_tdif 155 ! 156 ! do we use HF tau information? 157 lhftau = ln_taudif 163 ! 164 lhftau = ln_taudif ! do we use HF tau information? 158 165 jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 159 166 ! 160 ! set sf structure 161 ALLOCATE( sf(jfld), STAT=ierror ) 167 ALLOCATE( sf(jfld), STAT=ierror ) ! set sf structure 162 168 IF( ierror > 0 ) THEN 163 169 CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' ) ; RETURN 164 170 ENDIF 165 171 DO ifpr= 1, jfld 166 ALLOCATE( sf(ifpr)%fnow(jpi,jpj ) )167 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) )172 ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 173 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 168 174 END DO 169 ! 170 ! fill sf with slf_i and control print 171 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulattion for ocean surface boundary condition', 'namsbc_core' ) 175 ! ! fill sf with slf_i and control print 176 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' ) 172 177 ! 173 178 ENDIF 174 179 175 CALL fld_read( kt, nn_fsbc, sf ) 180 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 176 181 177 182 #if defined key_lim3 178 tatm_ice(:,:) = sf(jp_tair)%fnow(:,: )183 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) ! LIM3: make Tair available in sea-ice 179 184 #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 185 ! ! surface ocean fluxes computed with CLIO bulk formulea 186 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 187 ! 185 188 END SUBROUTINE sbc_blk_core 186 189 … … 244 247 DO jj = 2, jpjm1 245 248 DO ji = fs_2, fs_jpim1 ! vect. opt. 246 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj ) - 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) )247 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj ) - 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) )249 zwnd_i(ji,jj) = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj ) + pu(ji,jj) ) ) 250 zwnd_j(ji,jj) = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji ,jj-1) + pv(ji,jj) ) ) 248 251 END DO 249 252 END DO … … 260 263 ! ----------------------------------------------------------------------------- ! 261 264 262 ! ocean albedo assumed to be 0.066 263 !CDIR COLLAPSE 264 qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:) * tmask(:,:,1) ! Short Wave 265 !CDIR COLLAPSE 266 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 267 265 ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle ! Short Wave 266 zztmp = 1. - albo 267 IF( ln_dm2dc ) THEN ; qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 268 ELSE ; qsr(:,:) = zztmp * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 269 ENDIF 270 !CDIR COLLAPSE 271 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 268 272 ! ----------------------------------------------------------------------------- ! 269 273 ! II Turbulent FLUXES ! … … 307 311 IF( lhftau ) THEN 308 312 !CDIR COLLAPSE 309 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,: )313 taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 310 314 ENDIF 311 315 CALL iom_put( "taum_oce", taum ) ! output wind stress module … … 330 334 ELSE 331 335 !CDIR COLLAPSE 332 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,: ) ) * wndm(:,:) ) ! Evaporation333 !CDIR COLLAPSE 334 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,: ) ) * wndm(:,:) ! Sensible Heat336 zevap(:,:) = MAX( 0.e0, rhoa *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) ) ! Evaporation 337 !CDIR COLLAPSE 338 zqsb (:,:) = rhoa*cpa*Ch(:,:)*( zst (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:) ! Sensible Heat 335 339 ENDIF 336 340 !CDIR COLLAPSE … … 355 359 qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:) ! Downward Non Solar flux 356 360 !CDIR COLLAPSE 357 emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * rn_pfac * tmask(:,:,1)361 emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 358 362 !CDIR COLLAPSE 359 363 emps(:,:) = emp(:,:) … … 392 396 !! caution : the net upward water flux has with mm/day unit 393 397 !!--------------------------------------------------------------------- 394 REAL(wp), INTENT(in ), DIMENSION(:,:,:):: pst ! ice surface temperature (>0, =rt0 over land) [Kelvin]395 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj):: pui ! ice surface velocity (i- and i- components [m/s]396 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj):: pvi ! at I-point (B-grid) or U & V-point (C-grid)397 REAL(wp), INTENT(in ), DIMENSION(:,:,:):: palb ! ice albedo (clear sky) (alb_ice_cs) [%]398 REAL(wp), INTENT( out), DIMENSION(jpi,jpj):: p_taui ! i- & j-components of surface ice stress [N/m2]399 REAL(wp), INTENT( out), DIMENSION(jpi,jpj):: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)400 REAL(wp), INTENT( out), DIMENSION(:,:,:):: p_qns ! non solar heat flux over ice (T-point) [W/m2]401 REAL(wp), INTENT( out), DIMENSION(:,:,:):: p_qsr ! solar heat flux over ice (T-point) [W/m2]402 REAL(wp), INTENT( out), DIMENSION(:,:,:):: p_qla ! latent heat flux over ice (T-point) [W/m2]403 REAL(wp), INTENT( out), DIMENSION(:,:,:):: p_dqns ! non solar heat sensistivity (T-point) [W/m2]404 REAL(wp), INTENT( out), DIMENSION(:,:,:):: p_dqla ! latent heat sensistivity (T-point) [W/m2]405 REAL(wp), INTENT( out), DIMENSION(jpi,jpj):: p_tpr ! total precipitation (T-point) [Kg/m2/s]406 REAL(wp), INTENT( out), DIMENSION(jpi,jpj):: p_spr ! solid precipitation (T-point) [Kg/m2/s]407 REAL(wp), INTENT( out), DIMENSION(jpi,jpj):: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%]408 REAL(wp), INTENT( out), DIMENSION(jpi,jpj):: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%]409 CHARACTER(len=1) , INTENT(in ):: cd_grid ! ice grid ( C or B-grid)410 INTEGER , INTENT(in ):: pdim ! number of ice categories398 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pst ! ice surface temperature (>0, =rt0 over land) [Kelvin] 399 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pui ! ice surface velocity (i- and i- components [m/s] 400 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pvi ! at I-point (B-grid) or U & V-point (C-grid) 401 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%] 402 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: p_taui ! i- & j-components of surface ice stress [N/m2] 403 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 404 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_qns ! non solar heat flux over ice (T-point) [W/m2] 405 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_qsr ! solar heat flux over ice (T-point) [W/m2] 406 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_qla ! latent heat flux over ice (T-point) [W/m2] 407 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_dqns ! non solar heat sensistivity (T-point) [W/m2] 408 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_dqla ! latent heat sensistivity (T-point) [W/m2] 409 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 410 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 411 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: p_fr1 ! 1sr fraction of qsr penetration in ice (T-point) [%] 412 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: p_fr2 ! 2nd fraction of qsr penetration in ice (T-point) [%] 413 CHARACTER(len=1) , INTENT(in ) :: cd_grid ! ice grid ( C or B-grid) 414 INTEGER , INTENT(in ) :: pdim ! number of ice categories 411 415 !! 412 416 INTEGER :: ji, jj, jl ! dummy loop indices … … 414 418 REAL(wp) :: zst2, zst3 415 419 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 420 REAL(wp) :: zztmp ! temporary variable 416 421 REAL(wp) :: zcoef_frca ! fractional cloud amount 417 422 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point … … 427 432 428 433 ! local scalars ( place there for vector optimisation purposes) 429 zcoef_wnorm = rhoa * Cice434 zcoef_wnorm = rhoa * Cice 430 435 zcoef_wnorm2 = rhoa * Cice * 0.5 431 zcoef_dqlw = 4.0 * 0.95 * Stef432 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8)433 zcoef_dqsb = rhoa * cpa * Cice434 zcoef_frca = 1.0 - 0.3436 zcoef_dqlw = 4.0 * 0.95 * Stef 437 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8) 438 zcoef_dqsb = rhoa * cpa * Cice 439 zcoef_frca = 1.0 - 0.3 435 440 436 441 !!gm brutal.... … … 444 449 ! ----------------------------------------------------------------------------- ! 445 450 SELECT CASE( cd_grid ) 446 CASE( ' B' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation)451 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 447 452 ! and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 448 453 !CDIR NOVERRCHK 449 454 DO jj = 2, jpjm1 450 DO ji = 2, jpim1 ! B grid : novector opt455 DO ji = 2, jpim1 ! B grid : NO vector opt 451 456 ! ... scalar wind at I-point (fld being at T-point) 452 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ) + sf(jp_wndi)%fnow(ji ,jj) &453 & + sf(jp_wndi)%fnow(ji-1,jj-1 ) + sf(jp_wndi)%fnow(ji ,jj-1) ) - pui(ji,jj)454 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ) + sf(jp_wndj)%fnow(ji ,jj) &455 & + sf(jp_wndj)%fnow(ji-1,jj-1 ) + sf(jp_wndj)%fnow(ji ,jj-1) ) - pvi(ji,jj)457 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) & 458 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - pui(ji,jj) 459 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 460 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - pvi(ji,jj) 456 461 zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 457 462 ! ... ice stress at I-point … … 459 464 p_tauj(ji,jj) = zwnorm_f * zwndj_f 460 465 ! ... scalar wind at T-point (fld being at T-point) 461 zwndi_t = sf(jp_wndi)%fnow(ji,jj ) - 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) &462 & + pui(ji,jj ) + pui(ji+1,jj ) )463 zwndj_t = sf(jp_wndj)%fnow(ji,jj ) - 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) &464 & + pvi(ji,jj ) + pvi(ji+1,jj ) )466 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * ( pui(ji,jj+1) + pui(ji+1,jj+1) & 467 & + pui(ji,jj ) + pui(ji+1,jj ) ) 468 zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * ( pvi(ji,jj+1) + pvi(ji+1,jj+1) & 469 & + pvi(ji,jj ) + pvi(ji+1,jj ) ) 465 470 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 466 471 END DO … … 476 481 DO jj = 2, jpj 477 482 DO ji = fs_2, jpi ! vect. opt. 478 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj ) - 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) )479 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj ) - 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) )483 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj ) + pui(ji,jj) ) ) 484 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji ,jj-1) + pvi(ji,jj) ) ) 480 485 z_wnds_t(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 481 486 END DO … … 486 491 DO jj = 2, jpjm1 487 492 DO ji = fs_2, fs_jpim1 ! vect. opt. 488 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) &489 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj ) + sf(jp_wndi)%fnow(ji,jj) ) - pui(ji,jj) )490 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) &491 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1 ) + sf(jp_wndj)%fnow(ji,jj) ) - pvi(ji,jj) )493 p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj ) + z_wnds_t(ji,jj) ) & 494 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) ) 495 p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1 ) + z_wnds_t(ji,jj) ) & 496 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) ) 492 497 END DO 493 498 END DO … … 498 503 END SELECT 499 504 505 zztmp = 1. / ( 1. - albo ) 500 506 ! ! ========================== ! 501 507 DO jl = 1, ijpl ! Loop over ice categories ! … … 512 518 zst3 = pst(ji,jj,jl) * zst2 513 519 ! Short Wave (sw) 514 p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj) * tmask(ji,jj,1)520 p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 515 521 ! Long Wave (lw) 516 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj) & 517 & - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 522 z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 518 523 ! lw sensitivity 519 524 z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3 … … 525 530 ! ... turbulent heat fluxes 526 531 ! Sensible Heat 527 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj ) )532 z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 528 533 ! Latent Heat 529 534 p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls * Cice * z_wnds_t(ji,jj) & 530 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj ) ) )535 & * ( 11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1) ) ) 531 536 ! Latent heat sensitivity for ice (Dqla/Dt) 532 537 p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) … … 558 563 559 564 !CDIR COLLAPSE 560 p_tpr(:,:) = sf(jp_prec)%fnow(:,: ) * rn_pfac ! total precipitation [kg/m2/s]561 !CDIR COLLAPSE 562 p_spr(:,:) = sf(jp_snow)%fnow(:,: ) * rn_pfac ! solid precipitation [kg/m2/s]565 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] 566 !CDIR COLLAPSE 567 p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! solid precipitation [kg/m2/s] 563 568 CALL iom_put( 'snowpre', p_spr ) ! Snow precipitation 564 569 ! … … 597 602 !! 9.0 ! 05-08 (L. Brodeau) Rewriting and optimization 598 603 !!---------------------------------------------------------------------- 599 !! * Arguments600 601 604 REAL(wp), INTENT(in) :: zu ! altitude of wind measurement [m] 602 605 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: & … … 638 641 grav = 9.8, & ! gravity 639 642 kappa = 0.4 ! von Karman s constant 640 643 !!---------------------------------------------------------------------- 641 644 !! * Start 642 645 !! Air/sea differences … … 762 765 grav = 9.8, & ! gravity 763 766 kappa = 0.4 ! von Karman's constant 764 767 !!---------------------------------------------------------------------- 765 768 !! * Start 766 769
Note: See TracChangeset
for help on using the changeset viewer.
