- 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/limthd_dif.F90
r3808 r4161 10 10 !! ! 04-2007 (M. Vancoppenolle) Energy conservation 11 11 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 12 !! - ! 2012-05 (C. Rousset) add penetration solar flux 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_lim3 … … 34 35 35 36 !!---------------------------------------------------------------------- 36 !! NEMO/LIM3 3.4, UCL - NEMO Consortium (2011)37 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 37 38 !! $Id$ 38 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 156 157 DO ji = kideb , kiut 157 158 ! is there snow or not 158 isnow(ji)= INT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) )) )159 isnow(ji)= NINT( 1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) ) ) 159 160 ! surface temperature of fusion 160 161 !!gm ??? ztfs(ji) = rtt !!!???? 161 ztfs(ji) = isnow(ji) * rtt + (1.0-isnow(ji)) * rtt162 ztfs(ji) = REAL( isnow(ji) ) * rtt + REAL( 1 - isnow(ji) ) * rtt 162 163 ! layer thickness 163 zh_i(ji) = ht_i_b(ji) / nlay_i164 zh_s(ji) = ht_s_b(ji) / nlay_s164 zh_i(ji) = ht_i_b(ji) / REAL( nlay_i ) 165 zh_s(ji) = ht_s_b(ji) / REAL( nlay_s ) 165 166 END DO 166 167 … … 174 175 DO layer = 1, nlay_s ! vert. coord of the up. lim. of the layer-th snow layer 175 176 DO ji = kideb , kiut 176 z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s177 z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / REAL( nlay_s ) 177 178 END DO 178 179 END DO … … 180 181 DO layer = 1, nlay_i ! vert. coord of the up. lim. of the layer-th ice layer 181 182 DO ji = kideb , kiut 182 z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i183 z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / REAL( nlay_i ) 183 184 END DO 184 185 END DO … … 201 202 DO ji = kideb , kiut 202 203 ! switches 203 isnow(ji) = INT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) )) )204 isnow(ji) = NINT( 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) ) ) 204 205 ! hs > 0, isnow = 1 205 206 zhsu (ji) = hnzst ! threshold for the computation of i0 206 207 zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) ) 207 208 208 i0(ji) = ( 1._wp- isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )209 i0(ji) = REAL( 1 - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) ) 209 210 !fr1_i0_1d = i0 for a thin ice surface 210 211 !fr1_i0_2d = i0 for a thick ice surface … … 243 244 244 245 DO ji = kideb, kiut ! ice initialization 245 zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * isnow(ji) + zftrice(ji) * ( 1._wp- isnow(ji) )246 zradtr_i(ji,0) = zradtr_s(ji,nlay_s) * REAL( isnow(ji) ) + zftrice(ji) * REAL( 1 - isnow(ji) ) 246 247 END DO 247 248 … … 256 257 257 258 DO ji = kideb, kiut ! Radiation transmitted below the ice 258 fstbif_1d(ji) = fstbif_1d(ji) + zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji)259 fstbif_1d(ji) = fstbif_1d(ji) + iatte_1d(ji) * zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji) ! clem modif 259 260 END DO 260 261 … … 264 265 ii = MOD( npb(ji) - 1 , jpi ) + 1 265 266 ij = ( npb(ji) - 1 ) / jpi + 1 266 fstroc(ii,ij,jl) = zradtr_i(ji,nlay_i)267 fstroc(ii,ij,jl) = iatte_1d(ji) * zradtr_i(ji,nlay_i) ! clem modif 267 268 END DO 268 269 ! +++++ … … 376 377 zkappa_s(ji,nlay_s) = 2.0*rcdsn*ztcond_i(ji,0)/MAX(zeps, & 377 378 (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji))) 378 zkappa_i(ji,0) = zkappa_s(ji,nlay_s)* isnow(ji) &379 + zkappa_i(ji,0)* (1.0-isnow(ji))379 zkappa_i(ji,0) = zkappa_s(ji,nlay_s)*REAL( isnow(ji) ) & 380 + zkappa_i(ji,0)*REAL( 1 - isnow(ji) ) 380 381 END DO 381 382 ! … … 658 659 t_s_b(ji,nlay_s) = (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) & 659 660 * t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) & 660 * MAX(0.0,SIGN(1.0,ht_s_b(ji) -zeps))661 * MAX(0.0,SIGN(1.0,ht_s_b(ji))) 661 662 662 663 ! surface temperature 663 isnow(ji) = INT( 1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) ) ) )664 isnow(ji) = NINT( 1.0 - MAX( 0.0 , SIGN( 1.0 , -ht_s_b(ji) ) ) ) 664 665 ztsuoldit(ji) = t_su_b(ji) 665 IF( t_su_b(ji) < ztfs(ji) ) 666 t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( isnow(ji)*t_s_b(ji,1) &667 & + (1.0-isnow(ji))*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))666 IF( t_su_b(ji) < ztfs(ji) ) & 667 t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( REAL( isnow(ji) )*t_s_b(ji,1) & 668 & + REAL( 1 - isnow(ji) )*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji)) 668 669 END DO 669 670 ! … … 721 722 #endif 722 723 ! ! surface ice conduction flux 723 isnow(ji) = INT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) ) )724 fc_su(ji) = - isnow(ji)* zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji)) &725 & - ( 1._wp- isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_b(ji,1) - t_su_b(ji))724 isnow(ji) = NINT( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) ) ) 725 fc_su(ji) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji)) & 726 & - REAL( 1 - isnow(ji) ) * zkappa_i(ji,0) * zg1 * (t_i_b(ji,1) - t_su_b(ji)) 726 727 ! ! bottom ice conduction flux 727 728 fc_bo_i(ji) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) ) … … 734 735 DO ji = kideb, kiut 735 736 ! Upper snow value 736 fc_s(ji,0) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) )737 fc_s(ji,0) = - REAL( isnow(ji) ) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) ) 737 738 ! Bott. snow value 738 fc_s(ji,1) = - isnow(ji)* zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) )739 fc_s(ji,1) = - REAL( isnow(ji) ) * zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) ) 739 740 END DO 740 741 DO ji = kideb, kiut ! Upper ice layer 741 fc_i(ji,0) = - isnow(ji) * & ! interface flux if there is snow742 fc_i(ji,0) = - REAL( isnow(ji) ) * & ! interface flux if there is snow 742 743 ( zkappa_i(ji,0) * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) & 743 - ( 1.0- isnow(ji) ) * ( zkappa_i(ji,0) * &744 - REAL( 1 - isnow(ji) ) * ( zkappa_i(ji,0) * & 744 745 zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not 745 746 END DO
Note: See TracChangeset
for help on using the changeset viewer.
