Changeset 4306 for branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2013-11-21T15:59:57+01:00 (10 years ago)
- Location:
- branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 4 edited
-
sbc_ice.F90 (modified) (5 diffs)
-
sbc_oce.F90 (modified) (3 diffs)
-
sbcblk_core.F90 (modified) (3 diffs)
-
sbcice_lim_2.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r3625 r4306 19 19 # if defined key_lim2 20 20 USE par_ice_2 ! LIM-2 parameters 21 USE ice_2 21 22 # endif 22 23 # if defined key_cice … … 55 56 56 57 #if defined key_lim3 || defined key_lim2 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux over ice (LW+SEN+LA) [W/m2/K] 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature [K] 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alb_ice !: albedo of ice 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: dauly mean solar heat flux over ice [W/m2] 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux over ice (LW+SEN+LA) [W/m2/K] 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature [K] 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alb_ice !: albedo of ice 64 66 65 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] … … 109 111 !! *** FUNCTION sbc_ice_alloc *** 110 112 !!---------------------------------------------------------------------- 113 INTEGER :: ierr(2) 114 !!---------------------------------------------------------------------- 115 ierr(:) = 0 116 111 117 #if defined key_lim3 || defined key_lim2 112 118 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & … … 117 123 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 118 124 #if defined key_lim3 119 & emp_ice(jpi,jpj) , tatm_ice(jpi,jpj) , STAT= sbc_ice_alloc)125 & emp_ice(jpi,jpj) , tatm_ice(jpi,jpj) , STAT= ierr(1) ) 120 126 #else 121 & emp_ice(jpi,jpj) , STAT= sbc_ice_alloc)127 & emp_ice(jpi,jpj) , STAT= ierr(1) ) 122 128 #endif 123 129 #elif defined key_cice … … 126 132 wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & 127 133 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 128 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= sbc_ice_alloc)134 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= ierr(1) ) 129 135 #endif 130 136 ! 137 #if defined key_lim2 138 IF( ltrcdm2dc_ice )THEN 139 ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) ) 140 ENDIF 141 #endif 142 ! 143 sbc_ice_alloc = MAXVAL( ierr ) 131 144 IF( lk_mpp ) CALL mpp_sum ( sbc_ice_alloc ) 132 145 IF( sbc_ice_alloc > 0 ) CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed') -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r4292 r4306 64 64 !!---------------------------------------------------------------------- 65 65 LOGICAL , PUBLIC :: lhftau = .FALSE. !: HF tau used in TKE: mean(stress module) - module(mean stress) 66 LOGICAL , PUBLIC :: ltrcdm2dc !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux 66 67 !! !! now ! before !! 67 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau , utau_b !: sea surface i-stress (ocean referential) [N/m2] … … 71 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm !: wind speed module at T-point (=|U10m-Uoce|) [m/s] 72 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr !: sea heat flux: solar [W/m2] 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_mean !: daily mean sea heat flux: solar [W/m2] 73 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qns , qns_b !: sea heat flux: non solar [W/m2] 74 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qsr_tot !: total solar heat flux (over sea and ice) [W/m2] … … 141 143 #endif 142 144 ! 145 IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) ) 146 ! 143 147 sbc_oce_alloc = MAXVAL( ierr ) 144 148 IF( lk_mpp ) CALL mpp_sum ( sbc_oce_alloc ) -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4245 r4306 49 49 PUBLIC sbc_blk_core ! routine called in sbcmod module 50 50 PUBLIC blk_ice_core ! routine called in sbc_ice_lim module 51 PUBLIC blk_ice_meanqsr ! routine called in sbc_ice_lim module 51 52 PUBLIC turb_core_2z ! routine calles in sbcblk_mfs module 52 53 … … 189 190 ! ! compute the surface ocean fluxes using CORE bulk formulea 190 191 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 192 193 ! If diurnal cycle is activated, compute a daily mean short waves flux for biogeochemistery 194 IF( ltrcdm2dc ) CALL blk_bio_meanqsr 191 195 192 196 #if defined key_cice … … 438 442 ! 439 443 END SUBROUTINE blk_oce_core 440 444 445 SUBROUTINE blk_bio_meanqsr 446 !!--------------------------------------------------------------------- 447 !! *** ROUTINE blk_bio_meanqsr 448 !! 449 !! ** Purpose : provide daily qsr_mean for PISCES when 450 !! analytic diurnal cycle is applied in physic 451 !! 452 !! ** Method : add part where there is no ice 453 !! 454 !!--------------------------------------------------------------------- 455 IF( nn_timing == 1 ) CALL timing_start('blk_bio_meanqsr') 456 457 qsr_mean(:,:) = (1. - albo ) * sf(jp_qsr)%fnow(:,:,1) 458 459 IF( nn_timing == 1 ) CALL timing_stop('blk_bio_meanqsr') 460 461 END SUBROUTINE blk_bio_meanqsr 462 463 464 SUBROUTINE blk_ice_meanqsr(palb,p_qsr_mean,pdim) 465 !!--------------------------------------------------------------------- 466 !! 467 !! ** Purpose : provide the daily qsr_mean over sea_ice for PISCES when 468 !! analytic diurnal cycle is applied in physic 469 !! 470 !! ** Method : compute qsr 471 !! 472 !!--------------------------------------------------------------------- 473 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (clear sky) (alb_ice_cs) [%] 474 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_qsr_mean ! solar heat flux over ice (T-point) [W/m2] 475 INTEGER , INTENT(in ) :: pdim ! number of ice categories 476 !! 477 INTEGER :: ijpl ! number of ice categories (size of 3rd dim of input arrays) 478 INTEGER :: ji, jj, jl ! dummy loop indices 479 REAL(wp) :: zztmp ! temporary variable 480 !!--------------------------------------------------------------------- 481 IF( nn_timing == 1 ) CALL timing_start('blk_ice_meanqsr') 482 ! 483 ijpl = pdim ! number of ice categories 484 zztmp = 1. / ( 1. - albo ) 485 ! ! ========================== ! 486 DO jl = 1, ijpl ! Loop over ice categories ! 487 ! ! ========================== ! 488 DO jj = 1 , jpj 489 DO ji = 1, jpi 490 p_qsr_mean(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr_mean(ji,jj) 491 END DO 492 END DO 493 END DO 494 ! 495 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_meanqsr') 496 ! 497 END SUBROUTINE blk_ice_meanqsr 498 441 499 442 500 SUBROUTINE blk_ice_core( pst , pui , pvi , palb , & -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r3680 r4306 176 176 & tprecip , sprecip , & 177 177 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 178 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice_cs, qsr_ice_mean, jpl ) 179 178 180 CASE( 5 ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 179 181 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) … … 216 218 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 217 219 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes 220 #if defined key_top 221 IF( ltrcdm2dc_ice )CALL lim_bio_meanqsr_2 222 #endif 218 223 219 224 IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp ) &
Note: See TracChangeset
for help on using the changeset viewer.
