Changeset 4901 for branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3
- Timestamp:
- 2014-11-27T16:41:22+01:00 (10 years ago)
- Location:
- branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 9 edited
-
iceini.F90 (modified) (1 diff)
-
limistate.F90 (modified) (2 diffs)
-
limitd_me.F90 (modified) (4 diffs)
-
limsbc.F90 (modified) (6 diffs)
-
limthd.F90 (modified) (11 diffs)
-
limthd_dh.F90 (modified) (2 diffs)
-
limthd_dif.F90 (modified) (7 diffs)
-
limthd_lac.F90 (modified) (12 diffs)
-
thd_ice.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r4897 r4901 89 89 CALL lim_itd_ini ! ice thickness distribution initialization 90 90 ! 91 CALL lim_itd_me_init ! ice thickness distribution initialization 91 92 ! ! Initial sea-ice state 92 93 IF( .NOT. ln_rstart ) THEN ! start from rest -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r4900 r4901 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 … … 113 112 114 113 CALL lim_istate_init ! reading the initials parameters of the ice 115 116 # if defined key_coupled117 albege(:,:) = 0.8 * tms(:,:)118 # endif119 114 120 115 ! surface temperature -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r4900 r4901 150 150 CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 151 151 152 IF( numit == nstart ) CALL lim_itd_me_init ! Initialization (first time-step only)153 154 152 IF(ln_ctl) THEN 155 153 CALL prt_ctl(tab2d_1=ato_i , clinfo1=' lim_itd_me: ato_i : ', tab2d_2=at_i , clinfo2=' at_i : ') … … 1037 1035 ! / rafting category n1. 1038 1036 !-------------------------------------------------------------------------- 1039 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1037 vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) 1040 1038 vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por ) 1041 1039 vsw (ji,jj) = vrdg1(ji,jj) * ridge_por … … 1043 1041 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 1044 1042 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 1045 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1043 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1046 1044 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 1047 1045 … … 1128 1126 jj = indxj(ij) 1129 1127 ! heat content of ridged ice 1130 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )1128 erdg1(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) 1131 1129 eirft(ji,jj,jk) = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj) 1132 1130 e_i (ji,jj,jk,jl1) = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4900 r4901 32 32 USE sbc_oce ! Surface boundary condition: ocean fields 33 33 USE sbccpl 34 USE cpl_oasis3, ONLY : lk_cpl 35 USE oce , ONLY : iatte, oatte, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 34 USE oce , ONLY : fraqsr_1lev, sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 36 35 USE albedo ! albedo parameters 37 36 USE lbclnk ! ocean lateral boundary condition - MPP exchanges … … 98 97 !! - fr_i : ice fraction 99 98 !! - tn_ice : sea-ice surface temperature 100 !! - alb_ice : sea-ice albe rdo (lk_cpl=T)99 !! - alb_ice : sea-ice albedo (lk_cpl=T) 101 100 !! 102 101 !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90. 103 102 !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 103 !! These refs are now obsolete since everything has been revised 104 !! The ref should be Rousset et al., 2015? 104 105 !!--------------------------------------------------------------------- 105 INTEGER, INTENT(in) :: kt ! number of iteration 106 ! 107 INTEGER :: ji, jj, jl, jk ! dummy loop indices 108 REAL(wp) :: zinda, zemp ! local scalars 109 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 110 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 106 INTEGER, INTENT(in) :: kt ! number of iteration 107 ! 108 INTEGER :: ji, jj, jl, jk ! dummy loop indices 109 ! 110 REAL(wp) :: zinda, zemp ! local scalars 111 REAL(wp) :: zf_mass ! Heat flux associated with mass exchange ice->ocean (W.m-2) 112 REAL(wp) :: zfcm1 ! New solar flux received by the ocean 113 ! 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb_cs, zalb_os ! 2D/3D workspace 112 115 !!--------------------------------------------------------------------- 113 114 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp )115 116 116 117 ! make calls for heat fluxes before it is modified … … 134 135 ! Solar heat flux reaching the ocean = zfcm1 (W.m-2) 135 136 !--------------------------------------------------- 136 IF( lk_cpl ) THEN ! be carfeful: not been tested yet137 ! original line137 IF( lk_cpl ) THEN 138 !!! LIM2 version zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) ) 138 139 zfcm1 = qsr_tot(ji,jj) 139 !!!zfcm1 = qsr_tot(ji,jj) + ftr_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) / ( 1._wp - zinda + zinda * iatte(ji,jj) )140 140 DO jl = 1, jpl 141 zfcm1 = zfcm1 - ( qsr_ice(ji,jj,jl) - ftr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl)141 zfcm1 = zfcm1 + ( ftr_ice(ji,jj,jl) - qsr_ice(ji,jj,jl) ) * old_a_i(ji,jj,jl) 142 142 END DO 143 143 ELSE 144 !!!zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 145 !!! & ( 1._wp - pfrld(ji,jj) ) * ftr_ice(ji,jj) / ( 1._wp - zinda + zinda * iatte(ji,jj) ) 144 !!! LIM2 version zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 146 145 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) 147 146 DO jl = 1, jpl … … 215 214 216 215 !------------------------------------------------! 217 ! Computation of snow/ice and ocean albedo!216 ! Snow/ice albedo (only if sent to coupler) ! 218 217 !------------------------------------------------! 219 218 IF( lk_cpl ) THEN ! coupled case 220 CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb ) ! snow/ice albedo 221 alb_ice(:,:,:) = 0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:) ! Ice albedo (mean clear and overcast skys) 219 220 CALL wrk_alloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 221 222 CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os ) ! cloud-sky and overcast-sky ice albedos 223 224 alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 225 226 CALL wrk_dealloc( jpi, jpj, jpl, zalb_cs, zalb_os ) 227 222 228 ENDIF 223 229 … … 229 235 CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl ) 230 236 ENDIF 231 ! 232 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 233 ! 237 234 238 END SUBROUTINE lim_sbc_flx 235 239 … … 344 348 ! clem modif 345 349 IF( .NOT. ln_rstart ) THEN 346 iatte(:,:) = 1._wp 347 oatte(:,:) = 1._wp 350 fraqsr_1lev(:,:) = 1._wp 348 351 ENDIF 349 352 ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r4900 r4901 22 22 USE phycst ! physical constants 23 23 USE dom_oce ! ocean space and time domain variables 24 USE oce , ONLY : iatte, oatte24 USE oce , ONLY : fraqsr_1lev 25 25 USE ice ! LIM: sea-ice variables 26 26 USE par_ice ! LIM: sea-ice parameters … … 43 43 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 44 44 USE timing ! Timing 45 USE cpl_oasis3, ONLY : lk_cpl46 45 USE limcons ! conservation tests 47 46 … … 68 67 !! *** ROUTINE lim_thd *** 69 68 !! 70 !! ** Purpose : This routine manages the ice thermodynamic.69 !! ** Purpose : This routine manages ice thermodynamics 71 70 !! 72 71 !! ** Action : - Initialisation of some variables … … 74 73 !! at the ice base, snow acc.,heat budget of the leads) 75 74 !! - 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 75 !! - call lim_thd_dif for vertical heat diffusion 76 !! - call lim_thd_dh for vertical ice growth and melt 77 !! - call lim_thd_ent for enthalpy remapping 78 !! - call lim_thd_sal for ice desalination 79 !! - call lim_thd_temp to retrieve temperature from ice enthalpy 80 80 !! - back to the geographic grid 81 81 !! 82 !! ** References : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-9082 !! ** References : 83 83 !!--------------------------------------------------------------------- 84 84 INTEGER, INTENT(in) :: kt ! number of iteration … … 93 93 ! 94 94 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 95 ! 96 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns 95 97 !!------------------------------------------------------------------- 98 CALL wrk_alloc( jpi, jpj, zqsr, zqns ) 99 96 100 IF( nn_timing == 1 ) CALL timing_start('limthd') 97 101 … … 137 141 !-----------------------------------------------------------------------------! 138 142 143 !--- Ocean solar and non solar fluxes to be used in zqld 144 IF ( .NOT. lk_cpl ) THEN ! --- forced case, fluxes to the lead are the same as over the ocean 145 ! 146 zqsr(:,:) = qsr(:,:) ; zqns(:,:) = qns(:,:) 147 ! 148 ELSE ! --- coupled case, fluxes to the lead are total - intercepted 149 ! 150 zqsr(:,:) = qsr_tot(:,:) ; zqns(:,:) = qns_tot(:,:) 151 ! 152 DO jl = 1, jpl 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 zqsr(ji,jj) = zqsr(ji,jj) - qsr_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 156 zqns(ji,jj) = zqns(ji,jj) - qns_ice(ji,jj,jl) * old_a_i(ji,jj,jl) 157 END DO 158 END DO 159 END DO 160 ! 161 ENDIF 162 139 163 !CDIR NOVERRCHK 140 164 DO jj = 1, jpj … … 149 173 ! ! temperature and turbulent mixing (McPhee, 1992) 150 174 ! 175 151 176 ! --- 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 ) & 177 zqld = tms(ji,jj) * rdt_ice * & 178 & ( pfrld(ji,jj) * ( zqsr(ji,jj) * fraqsr_1lev(ji,jj) + zqns(ji,jj) ) & 179 & + ( pfrld(ji,jj)**betas - pfrld(ji,jj) ) * sprecip(ji,jj) * & ! heat content of precip 180 & ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & 157 181 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rtt ) ) 182 ! REMARK valid at least in forced mode from clem 183 ! precip is included in qns but not in qns_ice 158 184 159 185 !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! … … 185 211 hfx_in(ji,jj) = hfx_in(ji,jj) & 186 212 ! heat flux above the ocean 187 & + pfrld(ji,jj) * ( qns(ji,jj) + qsr(ji,jj) )&213 & + pfrld(ji,jj) * ( zqns(ji,jj) + zqsr(ji,jj) ) & 188 214 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 189 215 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rtt ) - lfus ) & … … 306 332 CALL tab_2d_1d( nbpb, sfx_bri_1d (1:nbpb), sfx_bri , jpi, jpj, npb(1:nbpb) ) 307 333 CALL tab_2d_1d( nbpb, sfx_res_1d (1:nbpb), sfx_res , jpi, jpj, npb(1:nbpb) ) 308 309 CALL tab_2d_1d( nbpb, iatte_1d (1:nbpb), iatte , jpi, jpj, npb(1:nbpb) )310 CALL tab_2d_1d( nbpb, oatte_1d (1:nbpb), oatte , jpi, jpj, npb(1:nbpb) )311 334 312 335 CALL tab_2d_1d( nbpb, hfx_thd_1d (1:nbpb), hfx_thd , jpi, jpj, npb(1:nbpb) ) … … 482 505 ENDIF 483 506 ! 507 ! 508 CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 509 510 ! 484 511 ! conservation test 485 512 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 486 513 ! 487 514 IF( nn_timing == 1 ) CALL timing_stop('limthd') 515 488 516 END SUBROUTINE lim_thd 489 517 … … 552 580 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 553 581 IF(lwm) WRITE ( numoni, namicethd ) 582 583 IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' ) 554 584 ! 555 585 IF(lwp) THEN ! control print -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r4900 r4901 26 26 USE wrk_nemo ! work arrays 27 27 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 28 USE cpl_oasis3, ONLY : lk_cpl29 28 30 29 IMPLICIT NONE … … 166 165 ! 167 166 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)167 zinda = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) 168 ztmelts = zinda * rtt + ( 1._wp - zinda ) * rtt 169 170 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 171 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 173 172 174 173 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_b(ji) - ztmelts ) ) -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r4900 r4901 25 25 USE wrk_nemo ! work arrays 26 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 USE cpl_oasis3, ONLY : lk_cpl27 USE sbc_oce, ONLY : lk_cpl 28 28 29 29 IMPLICIT NONE … … 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 --- ! … … 272 271 273 272 DO ji = kideb, kiut ! Radiation transmitted below the ice 274 !!!ftr_ice_1d(ji) = ftr_ice_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif275 273 ftr_ice_1d(ji) = zradtr_i(ji,nlay_i) 276 274 END DO … … 407 405 !------------------------------------------------------------------------------| 408 406 ! 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 407 IF( .NOT. lk_cpl ) THEN !--- forced atmosphere case 408 DO ji = kideb , kiut 409 ! update of the non solar flux according to the update in T_su 410 qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( t_su_b(ji) - ztsuoldit(ji) ) 411 END DO 412 ENDIF 413 414 ! Update incoming flux 415 DO ji = kideb , kiut 413 416 ! update incoming flux 414 417 zf(ji) = zfsw(ji) & ! net absorbed solar radiation 415 + qns_ice_1d(ji) ! non solar total flux418 + qns_ice_1d(ji) ! non solar total flux 416 419 ! (LWup, LWdw, SH, LH) 417 420 END DO … … 737 740 CALL lim_thd_enmelt( kideb, kiut ) 738 741 739 ! --- diag erroron heat diffusion - PART 2 --- !742 ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! 740 743 DO ji = kideb, kiut 741 744 zdq(ji) = - zq_ini(ji) + ( SUM( q_i_b(ji,1:nlay_i) ) * ht_i_b(ji) / REAL( nlay_i ) + & 742 745 & 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 --- ! 746 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 ) 747 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_b(ji) 748 END DO 749 750 ! diagnose external surface (forced case) or bottom (forced case) from heat conservation 751 IF( .NOT. lk_cpl ) THEN ! --- forced case: qns_ice and fc_su are diagnosed 752 ! 753 DO ji = kideb, kiut 754 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji) 755 fc_su (ji) = fc_su(ji) - zhfx_err(ji) 756 END DO 757 ! 758 ELSE ! --- coupled case: ocean turbulent heat flux is diagnosed 759 ! 760 DO ji = kideb, kiut 761 fhtur_1d (ji) = fhtur_1d(ji) - zhfx_err(ji) 762 END DO 763 ! 764 ENDIF 765 766 ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m2) 767 DO ji = kideb, kiut 749 768 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 750 769 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_b(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) … … 759 778 CALL wrk_dealloc( jpij, jkmax+2, zindterm, zindtbis, zdiagbis ) 760 779 CALL wrk_dealloc( jpij, jkmax+2, 3, ztrid ) 761 CALL wrk_dealloc( jpij, zdq, zq_ini )780 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 762 781 763 782 END SUBROUTINE lim_thd_dif -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r4900 r4901 29 29 USE lib_mpp ! MPP library 30 30 USE wrk_nemo ! work arrays 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 33 USE limthd_ent … … 133 134 !Energy of melting q(S,T) [J.m-3] 134 135 zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 135 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i )136 e_i(ji,jj,jk,jl) = zindb * e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi10 ) ) * REAL( nlay_i, wp ) 136 137 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac 137 138 END DO … … 171 172 zgamafr = 0.03 172 173 173 DO jj = 1, jpj 174 DO ji = 1, jpi 175 174 DO jj = 2, jpj 175 DO ji = 2, jpi 176 176 IF ( qlead(ji,jj) < 0._wp ) THEN 177 177 !------------- … … 243 243 END DO ! loop on ji ends 244 244 END DO ! loop on jj ends 245 ! 246 CALL lbc_lnk( zvrel(:,:), 'T', 1. ) 247 CALL lbc_lnk( hicol(:,:), 'T', 1. ) 245 248 246 249 ENDIF ! End of computation of frazil ice collection thickness … … 255 258 ! This occurs if open water energy budget is negative 256 259 nbpac = 0 260 npac(:) = 0 261 ! 257 262 DO jj = 1, jpj 258 263 DO ji = 1, jpi … … 315 320 ! Keep old ice areas and volume in memory 316 321 !----------------------------------------- 317 zv_old(:,:) = zv_i_1d(:,:) 318 za_old(:,:) = za_i_1d(:,:) 319 322 zv_old(1:nbpac,:) = zv_i_1d(1:nbpac,:) 323 za_old(1:nbpac,:) = za_i_1d(1:nbpac,:) 320 324 !---------------------- 321 325 ! Thickness of new ice … … 324 328 zh_newice(ji) = hiccrit 325 329 END DO 326 IF( fraz_swi == 1 ) zh_newice( :) = hicol_b(:)330 IF( fraz_swi == 1 ) zh_newice(1:nbpac) = hicol_b(1:nbpac) 327 331 328 332 !---------------------- … … 331 335 SELECT CASE ( num_sal ) 332 336 CASE ( 1 ) ! Sice = constant 333 zs_newice( :) = bulk_sal337 zs_newice(1:nbpac) = bulk_sal 334 338 CASE ( 2 ) ! Sice = F(z,t) [Vancoppenolle et al (2005)] 335 339 DO ji = 1, nbpac … … 339 343 END DO 340 344 CASE ( 3 ) ! Sice = F(z) [multiyear ice] 341 zs_newice( :) = 2.3345 zs_newice(1:nbpac) = 2.3 342 346 END SELECT 343 347 … … 472 476 za_i_1d(ji,jl) = zinda * za_i_1d(ji,jl) 473 477 zv_i_1d(ji,jl) = zv_i_1d(ji,jl) + zv_newfra 474 475 478 ! for remapping 476 479 h_i_old (ji,nlay_i+1) = zv_newfra … … 479 482 480 483 ! --- Ice enthalpy remapping --- ! 481 IF( zv_newfra > 0._wp ) THEN 482 CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 483 ENDIF 484 CALL lim_thd_ent( 1, nbpac, ze_i_1d(1:nbpac,:,jl) ) 484 485 485 486 ENDDO … … 534 535 DO ji = 1, jpi 535 536 ! heat content in Joules 536 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ) * unit_fac )537 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * area(ji,jj) * v_i(ji,jj,jl) / ( REAL( nlay_i ,wp ) * unit_fac ) 537 538 END DO 538 539 END DO -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r4900 r4901 115 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom 116 116 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: iatte_1d !: clem attenuation coef of the input solar flux (unitless)118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: oatte_1d !: clem attenuation coef of the input solar flux (unitless)119 120 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_b !: corresponding to the 2D var t_s 121 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_b !: corresponding to the 2D var t_i … … 149 146 & qsr_ice_1d (jpij) , & 150 147 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) , & 151 & t_bo_b (jpij) , iatte_1d (jpij) , oatte_1d (jpij) ,&148 & t_bo_b (jpij) , & 152 149 & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) ,hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 153 150 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , &
Note: See TracChangeset
for help on using the changeset viewer.
