- Timestamp:
- 2013-11-07T11:01:27+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4148 r4161 10 10 !! ! + simplification of the ice-ocean stress calculation 11 11 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 12 !! - ! 2012 (D. Iovino) salt flux change 13 !! - ! 2012-05 (C. Rousset) add penetration solar flux 12 14 !! 3.5 ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass 13 15 !!---------------------------------------------------------------------- … … 35 37 USE prtctl ! Print control 36 38 USE cpl_oasis3, ONLY : lk_cpl 39 USE traqsr ! clem: add penetration of solar flux into the calculation of heat budget 37 40 USE oce, ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass, sshu_b, sshv_b, sshu_n, sshv_n, sshf_n 38 41 USE dom_ice, ONLY : tms … … 57 60 # include "vectopt_loop_substitute.h90" 58 61 !!---------------------------------------------------------------------- 59 !! NEMO/LIM3 3.4, UCL - NEMO Consortium (2011)62 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 60 63 !! $Id$ 61 64 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 99 102 INTEGER, INTENT(in) :: kt ! number of iteration 100 103 ! 101 INTEGER :: ji, jj ! dummy loop indices104 INTEGER :: ji, jj, jl ! dummy loop indices 102 105 INTEGER :: ierr, ifvt, i1mfr, idfr ! local integer 103 106 INTEGER :: iflt, ial , iadv , ifral, ifrdv ! - - … … 106 109 REAL(wp) :: zfcm1 , zfcm2 ! - - 107 110 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace 111 REAL(wp) :: zzfcm1, zfscmbq ! clem: for light penetration 108 112 !!--------------------------------------------------------------------- 109 113 … … 119 123 DO ji = 1, jpi 120 124 zinda = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 121 ifvt = zinda * MAX( rzero , SIGN( rone, - phicif(ji,jj) ) ) !subscripts are bad here122 i1mfr = 1.0 - MAX( rzero , SIGN( rone , - ( at_i(ji,jj)) ) )125 ifvt = zinda * MAX( rzero , SIGN( rone, - phicif(ji,jj) ) ) !subscripts are bad here 126 i1mfr = 1.0 - MAX( rzero , SIGN( rone , - at_i(ji,jj) ) ) 123 127 idfr = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 124 128 iflt = zinda * (1 - i1mfr) * (1 - ifvt ) … … 141 145 142 146 ! computation the solar flux at ocean surface 143 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) 147 IF (lk_cpl) THEN ! be carfeful: not being tested yet 148 ! original line 149 !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 150 ! new line to include solar penetration (not tested) 151 zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 152 DO jl = 1, jpl 153 zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 154 END DO 155 ELSE 156 zfcm1 = pfrld(ji,jj) * qsr(ji,jj) + & 157 & ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 158 ENDIF 144 159 ! fstric Solar flux transmitted trough the ice 145 160 ! qsr Net short wave heat flux on free ocean 146 161 ! new line 147 fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 162 fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 163 164 ! solar flux and fscmbq with light penetration (clem) 165 zzfcm1 = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 166 zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 148 167 149 168 ! computation the non solar heat flux at ocean surface 150 zfcm2 = - z fcm1 & ! ???151 & + iflt * fscmbq(ji,jj)& ! total ablation: heat given to the ocean169 zfcm2 = - zzfcm1 & ! 170 & + iflt * zfscmbq & ! total ablation: heat given to the ocean 152 171 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice & 153 172 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice & … … 170 189 ! ! fdtcn : turbulent oceanic heat flux 171 190 172 !!gm this IF prevents the vertorisation of the whole loop173 IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN174 WRITE(numout,*) ' lim_sbc : heat fluxes '175 WRITE(numout,*) ' qsr : ', qsr(jiindx,jjindx)176 WRITE(numout,*) ' pfrld : ', pfrld(jiindx,jjindx)177 WRITE(numout,*) ' fstric : ', fstric (jiindx,jjindx)178 WRITE(numout,*)179 WRITE(numout,*) ' qns : ', qns(jiindx,jjindx)180 WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx)181 WRITE(numout,*) ' ifral : ', ifral182 WRITE(numout,*) ' ial : ', ial183 WRITE(numout,*) ' qcmif : ', qcmif(jiindx,jjindx)184 WRITE(numout,*) ' qldif : ', qldif(jiindx,jjindx)185 186 187 WRITE(numout,*) ' ifrdv : ', ifrdv188 WRITE(numout,*) ' qfvbq : ', qfvbq(jiindx,jjindx)189 WRITE(numout,*) ' qdtcn : ', qdtcn(jiindx,jjindx)190 191 192 WRITE(numout,*) ' '193 WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx)194 WRITE(numout,*) ' fhmec : ', fhmec(jiindx,jjindx)195 WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx)196 WRITE(numout,*) ' fhbri : ', fhbri(jiindx,jjindx)197 WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx)198 ENDIF199 !!gm end191 !!gm this IF prevents the vertorisation of the whole loop 192 ! IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 193 ! WRITE(numout,*) ' lim_sbc : heat fluxes ' 194 ! WRITE(numout,*) ' qsr : ', qsr(jiindx,jjindx) 195 ! WRITE(numout,*) ' pfrld : ', pfrld(jiindx,jjindx) 196 ! WRITE(numout,*) ' fstric : ', fstric (jiindx,jjindx) 197 ! WRITE(numout,*) 198 ! WRITE(numout,*) ' qns : ', qns(jiindx,jjindx) 199 ! WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx) 200 ! WRITE(numout,*) ' ifral : ', ifral 201 ! WRITE(numout,*) ' ial : ', ial 202 ! WRITE(numout,*) ' qcmif : ', qcmif(jiindx,jjindx) 203 ! WRITE(numout,*) ' qldif : ', qldif(jiindx,jjindx) 204 ! !WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice 205 ! !WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice 206 ! WRITE(numout,*) ' ifrdv : ', ifrdv 207 ! WRITE(numout,*) ' qfvbq : ', qfvbq(jiindx,jjindx) 208 ! WRITE(numout,*) ' qdtcn : ', qdtcn(jiindx,jjindx) 209 ! !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice 210 ! !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice 211 ! WRITE(numout,*) ' ' 212 ! WRITE(numout,*) ' fdtcn : ', fdtcn(jiindx,jjindx) 213 ! WRITE(numout,*) ' fhmec : ', fhmec(jiindx,jjindx) 214 ! WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 215 ! WRITE(numout,*) ' fhbri : ', fhbri(jiindx,jjindx) 216 ! WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 217 ! ENDIF 218 !!gm end 200 219 END DO 201 220 END DO … … 218 237 219 238 ! computing freshwater exchanges at the ice/ocean interface 220 zemp = emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 221 & - tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 222 & + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 223 & - fmmec(ji,jj) ! snow falling when ridging 239 IF (lk_cpl) THEN 240 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 241 & - rdm_snw(ji,jj) / rdt_ice 242 ELSE 243 zemp = emp(ji,jj) * ( 1.0 - at_i(ji,jj) ) & ! evaporation over oceanic fraction 244 & - tprecip(ji,jj) * at_i(ji,jj) & ! all precipitation reach the ocean 245 & + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) ) & ! except solid precip intercepted by sea-ice 246 & - fmmec(ji,jj) ! snow falling when ridging 247 ENDIF 224 248 225 249 ! mass flux at the ocean/ice interface (sea ice fraction) … … 370 394 !! ** input : Namelist namicedia 371 395 !!------------------------------------------------------------------- 396 REAL(wp) :: zsum, zarea 372 397 ! 373 398 INTEGER :: ji, jj ! dummy loop indices … … 390 415 END WHERE 391 416 ENDIF 417 ! clem modif 418 iatte(:,:) = 1._wp 419 oatte(:,:) = 1._wp 420 ! 392 421 ! ! embedded sea ice 393 422 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass … … 435 464 ENDIF 436 465 ! 466 !!? IF( .NOT. ln_rstart ) THEN ! delete the initial ssh below sea-ice area 467 !!? ! 468 !!? zarea = glob_sum( e1e2t(:,:) ) ! interior global domain surface 469 !!? zsum = glob_sum( e1e2t(:,:) * ( snwice_mass(:,:) ) ) / zarea * r1_rau0 470 !!? sshn(:,:) = sshn(:,:) - zsum 471 !!? sshb(:,:) = sshb(:,:) - zsum 472 !!? ENDIF 473 ! 474 437 475 END SUBROUTINE lim_sbc_init 438 476
Note: See TracChangeset
for help on using the changeset viewer.