- Timestamp:
- 2014-07-30T15:52:48+02:00 (10 years ago)
- Location:
- branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4730 r4733 29 29 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 30 30 USE wrk_nemo ! work arrays 31 USE cpl_oasis3, ONLY : lk_cpl32 31 33 32 IMPLICIT NONE -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4730 r4733 98 98 !! - fr_i : ice fraction 99 99 !! - tn_ice : sea-ice surface temperature 100 !! - alb_ice : sea-ice albe rdo (lk_cpl=T)100 !! - alb_ice : sea-ice albedo (lk_cpl=T) 101 101 !! 102 102 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. … … 136 136 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 137 137 !--------------------------------------------------- 138 IF( lk_cpl ) THEN ! be careful: not been tested yet139 ! original line138 IF( lk_cpl ) THEN 139 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 140 140 zfcm1 = qsr_tot(ji,jj) 141 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )142 141 DO jl = 1, jpl 143 142 zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4688 r4733 68 68 !! *** ROUTINE lim_thd *** 69 69 !! 70 !! ** Purpose : This routine manages the ice thermodynamic.70 !! ** Purpose : This routine manages ice thermodynamics 71 71 !! 72 72 !! ** Action : - Initialisation of some variables … … 74 74 !! at the ice base, snow acc.,heat budget of the leads) 75 75 !! - selection of the icy points and put them in an array 76 !! - call lim_vert_ther for vert ice thermodynamic 77 !! - back to the geographic grid 78 !! - selection of points for lateral accretion 79 !! - call lim_lat_acc for the ice accretion 76 !! - call lim_thd_dif for vertical heat diffusion 77 !! - call lim_thd_dh for vertical ice growth and melt 78 !! - call lim_thd_ent for enthalpy remapping 79 !! - call lim_thd_sal for ice desalination 80 !! - call lim_thd_temp to retrieve temperature from ice enthalpy 80 81 !! - back to the geographic grid 81 82 !! 82 !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-9083 !! ** References : 83 84 !!--------------------------------------------------------------------- 84 85 INTEGER, INTENT(in) :: kt ! number of iteration … … 93 94 ! 94 95 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 96 ! 97 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns 95 98 !!------------------------------------------------------------------- 99 CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 100 96 101 IF( nn_timing == 1 ) CALL timing_start('limthd') 97 102 … … 137 142 !-----------------------------------------------------------------------------! 138 143 144 !--- Ocean solar and non solar fluxes to be used in zqld 145 IF ( .NOT. lk_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean 146 ! 147 zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:) 148 ! 149 ELSE ! --- coupled case, fluxes to the lead are total - intercepted 150 ! 151 zqsr(:,:) = qsr_tot(:,:) ; zqns(:,:) = qns_tot(:,:) 152 ! 153 DO jl = 1, jpl 154 DO jj = 1, jpj 155 DO ji = 1, jpi 156 zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 157 zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 158 END DO 159 END DO 160 END DO 161 ! 162 ENDIF 163 139 164 !CDIR NOVERRCHK 140 165 DO jj = 1, jpj … … 149 174 ! ! temperature and turbulent mixing (McPhee, 1992) 150 175 ! 176 151 177 ! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- ! 152 zqld = tms(ji,jj) * rdt_ice * & 153 & ( pfrld(ji,jj) * ( qsr(ji,jj) * oatte(ji,jj) & ! solar heat + clem modif 154 & + qns(ji,jj) ) & ! non solar heat 155 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 156 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 178 zqld = tms(ji,jj) * rdt_ice * & 179 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * oatte(ji,jj) + zqns(ji,jj) ) 180 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 181 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 157 182 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 183 ! REMARK valid at least in forced mode from clem 184 ! precip is included in qns but not in qns_ice 158 185 159 186 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! … … 482 509 ENDIF 483 510 ! 511 ! 512 CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 513 514 ! 484 515 ! conservation test 485 516 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 486 517 ! 487 518 IF( nn_timing == 1 ) CALL timing_stop('limthd') 519 488 520 END SUBROUTINE lim_thd 489 521 -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4688 r4733 166 166 ! 167 167 DO ji = kideb, kiut 168 zinda 169 ztmelts 170 171 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)172 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji)168 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 169 ztmelts = zinda * rtt + ( 1._wp - zinda ) * rtt 170 171 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 172 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 173 173 174 174 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4688 r4733 146 146 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrid ! tridiagonal system terms 147 147 ! diag errors on heat 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini 149 REAL(wp) :: zhfx_err 148 REAL(wp), POINTER, DIMENSION(:) :: zdq, zq_ini, zhfx_err 150 149 !!------------------------------------------------------------------ 151 150 ! … … 158 157 CALL wrk_alloc( jpij, jkmax+2, 3, ztrid ) 159 158 160 CALL wrk_alloc( jpij, zdq, zq_ini )159 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) 161 160 162 161 ! --- diag error on heat diffusion - PART 1 --- ! … … 407 406 !------------------------------------------------------------------------------| 408 407 ! 409 DO ji = kideb , kiut 410 ! update of the non solar flux according to the update in T_su 411 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 412 408 IF( .NOT. lk_cpl ) THEN !--- forced atmosphere case 409 DO ji = kideb , kiut 410 ! update of the non solar flux according to the update in T_su 411 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 412 END DO 413 ENDIF 414 415 ! Update incoming flux 416 DO ji = kideb , kiut 413 417 ! update incoming flux 414 418 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 415 + qns_ice_1d(ji) ! non solar total flux419 + qns_ice_1d(ji) ! non solar total flux 416 420 ! (LWup, LWdw, SH, LH) 417 421 END DO … … 737 741 CALL lim_thd_enmelt( kideb, kiut ) 738 742 739 ! --- diag erroron heat diffusion - PART 2 --- !743 ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 740 744 DO ji = kideb, kiut 741 745 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 742 746 & SUM( q_s_b(ji,1:nlay_s) ) * ht_s_b(ji) / REAL( nlay_s ) ) 743 zhfx_err = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 744 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err * a_i_b(ji) 745 ! --- correction of qns_ice and surface conduction flux --- ! 746 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err 747 fc_su (ji) = fc_su (ji) - zhfx_err 748 ! --- Heat flux at the ice surface in W.m-2 --- ! 747 zhfx_err(ji) = ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) + zdq(ji) * r1_rdtice ) 748 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_b(ji) 749 END DO 750 751 ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 752 IF( .NOT. lk_cpl ) THEN ! --- forced case: qns_ice and fc_su are diagnosed 753 ! 754 DO ji = kideb, kiut 755 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 756 fc_su (ji) = fc_su(ji) - zhfx_err(ji) 757 END DO 758 ! 759 ELSE ! --- coupled case: ocean turbulent heat flux is diagnosed 760 ! 761 DO ji = kideb, kiut 762 fhtur_1d (ji) = fhtur_1d(ji) - zhfx_err(ji) 763 END DO 764 ! 765 ENDIF 766 767 ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 768 DO ji = kideb, kiut 749 769 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 750 770 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) … … 759 779 CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 760 780 CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 761 CALL wrk_dealloc( jpij, zdq, zq_ini )781 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 762 782 763 783 END SUBROUTINE lim_thd_dif
Note: See TracChangeset
for help on using the changeset viewer.