- Timestamp:
- 2013-12-11T15:38:42+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4155 r4332 45 45 PUBLIC lim_itd_shiftice 46 46 47 REAL(wp) :: epsi20 = 1.e-20_wp ! constant values48 REAL(wp) :: epsi13 = 1.e-13_wp !49 47 REAL(wp) :: epsi10 = 1.e-10_wp ! 48 REAL(wp) :: epsi06 = 1.e-6_wp ! 50 49 51 50 !!---------------------------------------------------------------------- … … 110 109 CALL lim_var_glo2eqv ! only for info 111 110 112 !---------------------------------------------------------------------------------------- 113 ! 4) Computation of trend terms and get back to old values 114 !---------------------------------------------------------------------------------------- 115 116 !- Trend terms 117 d_a_i_thd(:,:,:) = a_i(:,:,:) - old_a_i(:,:,:) 118 d_v_s_thd(:,:,:) = v_s(:,:,:) - old_v_s(:,:,:) 119 d_v_i_thd(:,:,:) = v_i(:,:,:) - old_v_i(:,:,:) 120 d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 121 d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:) 122 !?? d_oa_i_thd(:,:,:) = oa_i (:,:,:) - old_oa_i (:,:,:) 123 d_smv_i_thd(:,:,:) = 0._wp 124 IF( num_sal == 2 ) d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:) 125 126 ! diag only (clem) 127 dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) * r1_rdtice * rday 128 129 IF(ln_ctl) THEN ! Control print 111 IF(ln_ctl) THEN ! Control print 130 112 CALL prt_ctl_info(' ') 131 113 CALL prt_ctl_info(' - Cell values : ') … … 183 165 ! ------------------------------- 184 166 ! 185 !- Recover Old values 186 a_i(:,:,:) = old_a_i (:,:,:) 187 v_s(:,:,:) = old_v_s (:,:,:) 188 v_i(:,:,:) = old_v_i (:,:,:) 189 e_s(:,:,:,:) = old_e_s (:,:,:,:) 190 e_i(:,:,:,:) = old_e_i (:,:,:,:) 191 !?? oa_i(:,:,:) = old_oa_i(:,:,:) 192 IF( num_sal == 2 ) smv_i(:,:,:) = old_smv_i(:,:,:) 193 ! 194 IF( nn_timing == 1 ) CALL timing_stop('limitd_th') 167 IF( nn_timing == 1 ) CALL timing_stop('limitd_th') 195 168 END SUBROUTINE lim_itd_th 196 169 ! … … 281 254 DO jj = 1, jpj 282 255 DO ji = 1, jpi 283 zindb = 1.0 -MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes284 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl),epsi10) * zindb285 zindb = 1.0 -MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl)+epsi10)) !0 if no ice and 1 if yes286 zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl),epsi10) * zindb287 IF( a_i(ji,jj,jl) > 1e-6 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl)256 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes 257 ht_i(ji,jj,jl) = v_i(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi10 ) * zindb 258 zindb = 1.0 - MAX( 0.0, SIGN( 1.0, - old_a_i(ji,jj,jl) + epsi10) ) !0 if no ice and 1 if yes 259 zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX( old_a_i(ji,jj,jl), epsi10 ) * zindb 260 IF( a_i(ji,jj,jl) > epsi06 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 288 261 END DO 289 262 END DO … … 321 294 ! Tricky trick see limitd_me.F90 322 295 ! will be soon removed, CT 323 ! hi_max(kubnd) = 99 9.99296 ! hi_max(kubnd) = 99. 324 297 zhbnew(:,:,:) = 0._wp 325 298 … … 329 302 ij = nind_j(ji) 330 303 ! 331 IF ( ( zht_i_o(ii,ij,jl) .GT.epsi10 ) .AND. &332 ( zht_i_o(ii,ij,jl+1) .GT.epsi10 ) ) THEN304 IF ( ( zht_i_o(ii,ij,jl) .GT. epsi10 ) .AND. & 305 ( zht_i_o(ii,ij,jl+1) .GT. epsi10 ) ) THEN 333 306 !interpolate between adjacent category growth rates 334 307 zslope = ( zdhice(ii,ij,jl+1) - zdhice(ii,ij,jl) ) / & … … 402 375 zhbnew(ji,jj,kubnd) = 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1) 403 376 ELSE 404 zhbnew(ji,jj,kubnd) = hi_max(kubnd) 377 zhbnew(ji,jj,kubnd) = hi_max(kubnd) 378 !!? clem bug: since hi_max(jpl)=99, this limit is very high 379 !!? but I think it is erased in fitline subroutine 405 380 ENDIF 406 381 … … 447 422 * a_i(ii,ij,klbnd) / ( a_i(ii,ij,klbnd) - zda0 ) 448 423 a_i(ii,ij,klbnd) = a_i(ii,ij,klbnd) - zda0 449 v_i(ii,ij,klbnd) = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem @useless ?424 v_i(ii,ij,klbnd) = a_i(ii,ij,klbnd)*ht_i(ii,ij,klbnd) ! clem-useless ? 450 425 ENDIF ! zetamax > 0 451 426 ! ji, a_i > epsi10 … … 539 514 a_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) / hiclim 540 515 ht_i(ii,ij,1) = hiclim 541 v_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem @useless516 v_i(ii,ij,1) = a_i(ii,ij,1) * ht_i(ii,ij,1) !clem-useless 542 517 ENDIF 543 518 END DO !ji … … 602 577 REAL(wp) :: zdhr ! 1 / (hR - hL) 603 578 REAL(wp) :: zwk1, zwk2 ! temporary variables 604 REAL(wp) :: zacrith ! critical minimum concentration in an ice category 605 !!------------------------------------------------------------------ 606 ! 607 zacrith = 1.0e-6 579 !!------------------------------------------------------------------ 580 ! 608 581 ! 609 582 DO jj = 1, jpj 610 583 DO ji = 1, jpi 611 584 ! 612 IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > zacrith&585 IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > epsi10 & 613 586 & .AND. hice(ji,jj) > 0._wp ) THEN 614 587 … … 1009 982 !zdaice(ji,jj,jl) = a_i(ji,jj,jl) 1010 983 !zdvice(ji,jj,jl) = v_i(ji,jj,jl) 1011 zdaice(ji,jj,jl) = a_i(ji,jj,jl)/21012 zdvice(ji,jj,jl) = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1))/2984 !zdaice(ji,jj,jl) = a_i(ji,jj,jl) * 0.5_wp 985 !zdvice(ji,jj,jl) = v_i(ji,jj,jl)-zdaice(ji,jj,jl)*(hi_max(jl)+hi_max(jl-1)) * 0.5_wp 1013 986 ! end TECLIM change 987 ! clem: how much of a_i you send in cat sup is somewhat arbitrary 988 zdaice(ji,jj,jl) = a_i(ji,jj,jl) * ( ht_i(ji,jj,jl) - hi_max(jl) + epsi10 ) / ht_i(ji,jj,jl) 989 zdvice(ji,jj,jl) = v_i(ji,jj,jl) - ( a_i(ji,jj,jl) - zdaice(ji,jj,jl) ) * ( hi_max(jl) - epsi10 ) 1014 990 ENDIF 1015 991 END DO ! ji … … 1038 1014 zshiftflag = 0 1039 1015 1016 !clem-change 1017 ! DO jj = 1, jpj 1018 ! DO ji = 1, jpi 1019 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. & 1020 ! ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1021 ! ! 1022 ! zshiftflag = 1 1023 ! zdonor(ji,jj,jl) = jl + 1 1024 ! zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 1025 ! zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 1026 ! ENDIF 1027 ! END DO ! ji 1028 ! END DO ! jj 1029 ! 1030 ! IF(lk_mpp) CALL mpp_max( zshiftflag ) 1031 ! 1032 ! IF( zshiftflag == 1 ) THEN ! Shift ice between categories 1033 ! CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 1034 ! ! Reset shift parameters 1035 ! zdonor(:,:,jl) = 0 1036 ! zdaice(:,:,jl) = 0._wp 1037 ! zdvice(:,:,jl) = 0._wp 1038 ! ENDIF 1039 !clem-change 1040 1041 ! clem-change begin: why not doing that? 1040 1042 DO jj = 1, jpj 1041 1043 DO ji = 1, jpi 1042 1044 IF( a_i(ji,jj,jl+1) > epsi10 .AND. & 1043 1045 ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 1044 ! 1045 zshiftflag = 1 1046 zdonor(ji,jj,jl) = jl + 1 1047 zdaice(ji,jj,jl) = a_i(ji,jj,jl+1) 1048 zdvice(ji,jj,jl) = v_i(ji,jj,jl+1) 1046 ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10 1047 a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1) 1049 1048 ENDIF 1050 1049 END DO ! ji 1051 1050 END DO ! jj 1052 1053 IF(lk_mpp) CALL mpp_max( zshiftflag ) 1054 1055 IF( zshiftflag == 1 ) THEN ! Shift ice between categories 1056 CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 1057 ! Reset shift parameters 1058 zdonor(:,:,jl) = 0 1059 zdaice(:,:,jl) = 0._wp 1060 zdvice(:,:,jl) = 0._wp 1061 ENDIF 1051 ! clem-change end 1062 1052 1063 1053 END DO ! jl
Note: See TracChangeset
for help on using the changeset viewer.
