- Timestamp:
- 2012-11-02T07:13:40+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r3517 r3524 37 37 USE oce, ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass, sshu_b, sshv_b, sshu_n, sshv_n, sshf_n 38 38 USE dom_ice, ONLY : tms 39 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 39 40 40 41 IMPLICIT NONE … … 56 57 # include "vectopt_loop_substitute.h90" 57 58 !!---------------------------------------------------------------------- 58 !! NEMO/LIM3 4.0, UCL - NEMO Consortium (2011)59 !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 59 60 !! $Id$ 60 61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 99 100 ! 100 101 INTEGER :: ji, jj ! dummy loop indices 101 INTEGER :: ierr ! local integer 102 INTEGER :: ifvt, i1mfr, idfr ! some switches 103 INTEGER :: iflt, ial, iadv, ifral, ifrdv 104 REAL(wp) :: zinda, zemp, zemp_snow, zfmm ! local scalars 105 REAL(wp), POINTER, DIMENSION(:,:) :: zfcm1 , zfcm2 ! solar/non solar heat fluxes 102 INTEGER :: ierr, ifvt, i1mfr, idfr ! local integer 103 INTEGER :: iflt, ial , iadv , ifral, ifrdv ! - - 104 REAL(wp) :: zinda, zemp, zemp_snow, zfmm ! local scalars 105 REAL(wp) :: zfcm1 , zfcm2 ! - - 106 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 107 107 !!--------------------------------------------------------------------- 108 108 109 CALL wrk_alloc( jpi, jpj, zfcm1 , zfcm2 )110 109 IF( lk_cpl ) CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp ) 111 110 … … 141 140 142 141 ! computation the solar flux at ocean surface 143 zfcm1 (ji,jj) = pfrld(ji,jj) * qsr(ji,jj) + ( 1.- pfrld(ji,jj) ) * fstric(ji,jj)142 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) 144 143 ! fstric Solar flux transmitted trough the ice 145 144 ! qsr Net short wave heat flux on free ocean … … 148 147 149 148 ! computation the non solar heat flux at ocean surface 150 zfcm2(ji,jj) = - zfcm1(ji,jj) & 151 & + iflt * ( fscmbq(ji,jj) ) & ! total abl -> fscmbq is given to the ocean 152 ! fscmbq and ffltbif are obsolete 153 ! & + iflt * ffltbif(ji,jj) !!! only if one category is used 154 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 155 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 156 & + fhmec(ji,jj) & ! new contribution due to snow melt when ridging!! 157 & + fheat_rpo(ji,jj) & ! contribution from ridge formation 158 & + fheat_res(ji,jj) 159 ! fscmbq Part of the solar radiation transmitted through the ice and going to the ocean computed in limthd_zdf.F90 160 ! ffltbif Total heat content of the ice (brine pockets+ice) / delta_t 149 zfcm2 = - zfcm1 & ! ??? 150 & + iflt * fscmbq(ji,jj) & ! total ablation: heat given to the ocean 151 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 152 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & 153 & + fhmec(ji,jj) & ! snow melt when ridging 154 & + fheat_mec(ji,jj) & ! ridge formation 155 & + fheat_res(ji,jj) ! residual heat flux 161 156 ! qcmif Energy needed to bring the ocean surface layer until its freezing (ok) 162 157 ! qldif heat balance of the lead (or of the open ocean) 163 ! qfvbq i think this is wrong! 164 ! ---> Array used to store energy in case of total lateral ablation 165 ! qfvbq latent heat uptake/release after accretion/ablation 166 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 167 168 IF( num_sal == 2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + fhbri(ji,jj) ! add contribution due to brine drainage 158 ! qfvbq latent heat uptake/release after accretion/ablation 159 ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead 160 161 IF( num_sal == 2 ) zfcm2 = zfcm2 + fhbri(ji,jj) ! add contribution due to brine drainage 169 162 170 163 ! bottom radiative component is sent to the computation of the oceanic heat flux 171 fsbbq(ji,jj) = ( 1. 0- ( ifvt + iflt ) ) * fscmbq(ji,jj)164 fsbbq(ji,jj) = ( 1._wp - ( ifvt + iflt ) ) * fscmbq(ji,jj) 172 165 173 166 ! used to compute the oceanic heat flux at the next time step 174 qsr(ji,jj) = zfcm1 (ji,jj)! solar heat flux175 qns(ji,jj) = zfcm2 (ji,jj)- fdtcn(ji,jj) ! non solar heat flux167 qsr(ji,jj) = zfcm1 ! solar heat flux 168 qns(ji,jj) = zfcm2 - fdtcn(ji,jj) ! non solar heat flux 176 169 ! ! fdtcn : turbulent oceanic heat flux 177 170 … … 180 173 WRITE(numout,*) ' lim_sbc : heat fluxes ' 181 174 WRITE(numout,*) ' qsr : ', qsr(jiindx,jjindx) 182 WRITE(numout,*) ' zfcm1 : ', zfcm1(jiindx,jjindx)183 175 WRITE(numout,*) ' pfrld : ', pfrld(jiindx,jjindx) 184 176 WRITE(numout,*) ' fstric : ', fstric (jiindx,jjindx) 185 177 WRITE(numout,*) 186 178 WRITE(numout,*) ' qns : ', qns(jiindx,jjindx) 187 WRITE(numout,*) ' zfcm2 : ', zfcm2(jiindx,jjindx) 188 WRITE(numout,*) ' zfcm1 : ', zfcm1(jiindx,jjindx) 179 WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx) 189 180 WRITE(numout,*) ' ifral : ', ifral 190 181 WRITE(numout,*) ' ial : ', ial … … 201 192 WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx) 202 193 WRITE(numout,*) ' fhmec : ', fhmec(jiindx,jjindx) 203 WRITE(numout,*) ' fheat_ rpo : ', fheat_rpo(jiindx,jjindx)194 WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 204 195 WRITE(numout,*) ' fhbri : ', fhbri(jiindx,jjindx) 205 196 WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) … … 239 230 ! correcting brine salt fluxes (zinda = 1 if pfrld=1 , =0 otherwise) 240 231 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 241 fsbri(ji,jj) = zinda * fsbri(ji,jj)232 sfx_bri(ji,jj) = zinda * sfx_bri(ji,jj) 242 233 END DO 243 234 END DO … … 248 239 249 240 IF( num_sal == 2 ) THEN ! variable ice salinity: brine drainage included in the salt flux 250 sfx (:,:) = fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + fsbri(:,:)241 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) + sfx_bri(:,:) 251 242 ELSE ! constant ice salinity: 252 sfx (:,:) = fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:)243 sfx(:,:) = sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) 253 244 ENDIF 254 245 !-----------------------------------------------! … … 285 276 ENDIF 286 277 ! 287 CALL wrk_dealloc( jpi, jpj, zfcm1 , zfcm2 )288 278 IF( lk_cpl ) CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp ) 289 279 !
Note: See TracChangeset
for help on using the changeset viewer.
