Changeset 10945
- Timestamp:
- 2019-05-07T19:29:25+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/ICE
- Files:
-
- 3 edited
-
icedyn_adv_umx.F90 (modified) (30 diffs)
-
icedyn_rdgrft.F90 (modified) (1 diff)
-
icevar.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_adv_umx.F90
r10930 r10945 32 32 33 33 PUBLIC ice_dyn_adv_umx ! called by icedyn_adv.F90 34 35 REAL(wp) :: z1_6 = 1._wp / 6._wp ! =1/636 REAL(wp) :: z1_120 = 1._wp / 120._wp ! =1/12037 38 ! advection for S and T: dVS/dt = -div( uA * uHS / u ) => ll_advS = F39 ! or dVS/dt = -div( uV * uS / u ) => ll_advS = T40 LOGICAL :: ll_advS = .FALSE.41 34 ! 42 ! alternate directions for upstream 43 LOGICAL :: ll_upsxy = .TRUE. 35 INTEGER, PARAMETER :: np_advS = 1 ! advection for S and T: dVS/dt = -div( uVS ) => np_advS = 1 36 ! or dVS/dt = -div( uA * uHS / u ) => np_advS = 2 37 ! or dVS/dt = -div( uV * uS / u ) => np_advS = 3 38 INTEGER, PARAMETER :: np_limiter = 1 ! limiter: 1 = nonosc 39 ! 2 = superbee 40 ! 3 = h3 41 LOGICAL :: ll_upsxy = .TRUE. ! alternate directions for upstream 42 LOGICAL :: ll_hoxy = .TRUE. ! alternate directions for high order 43 LOGICAL :: ll_neg = .TRUE. ! if T interpolated at u/v points is negative or v_i < 1.e-6 44 ! then interpolate T at u/v points using the upstream scheme 45 LOGICAL :: ll_prelim = .FALSE. ! prelimiter from: Zalesak(1979) eq. 14 => not well defined in 2D 44 46 ! 45 ! alternate directions for high order46 LOGICAL :: ll_hoxy = .TRUE.47 REAL(wp) :: z1_6 = 1._wp / 6._wp ! =1/6 48 REAL(wp) :: z1_120 = 1._wp / 120._wp ! =1/120 47 49 ! 48 ! if T interpolated at u/v points is negative or v_i < 1.e-6 49 ! then interpolate T at u/v points using the upstream scheme 50 LOGICAL :: ll_neg = .TRUE. 51 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zmski_small, zmskj_small 52 ! 53 ! limiter: 1=nonosc_ice, 2=superbee, 3=h3(rachid) 54 INTEGER :: kn_limiter = 1 55 ! 56 ! prelimiter: use it to avoid overshoot in H 57 LOGICAL :: ll_prelimiter_zalesak = .FALSE. ! from: Zalesak(1979) eq. 14 => better for 1D. Not well defined in 2D 50 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: imsk_small, jmsk_small 58 51 ! 59 52 !! * Substitutions … … 100 93 REAL(wp) :: zdt, zvi_cen 101 94 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 102 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 95 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 103 96 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat 104 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups 105 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups 106 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai, z1_aip, z1_vi, z1_vs 107 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhvar 99 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar 108 100 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 101 ! 102 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 109 103 !!---------------------------------------------------------------------- 110 104 ! … … 150 144 zudy(:,:) = pu_ice(:,:) * e2u(:,:) 151 145 zvdx(:,:) = pv_ice(:,:) * e1v(:,:) 152 146 ! 147 ! setup transport for each ice cat 148 DO jl = 1, jpl 149 zu_cat(:,:,jl) = zudy(:,:) 150 zv_cat(:,:,jl) = zvdx(:,:) 151 END DO 152 ! 153 153 ! --- define velocity for advection: u*grad(H) --- ! 154 154 DO jj = 2, jpjm1 … … 184 184 ! setup a mask where advection will be upstream 185 185 IF( ll_neg ) THEN 186 IF( .NOT. ALLOCATED( zmski_small) ) ALLOCATE( zmski_small(jpi,jpj,jpl) )187 IF( .NOT. ALLOCATED( zmskj_small) ) ALLOCATE( zmskj_small(jpi,jpj,jpl) )186 IF( .NOT. ALLOCATED(imsk_small) ) ALLOCATE( imsk_small(jpi,jpj,jpl) ) 187 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 188 188 DO jl = 1, jpl 189 189 DO jj = 1, jpjm1 190 190 DO ji = 1, jpim1 191 191 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 192 IF( zvi_cen < epsi06) THEN ; zmski_small(ji,jj,jl) = 0.193 ELSE ; zmski_small(ji,jj,jl) = 1. ;ENDIF192 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 193 ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF 194 194 zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 195 IF( zvi_cen < epsi06) THEN ; zmskj_small(ji,jj,jl) = 0.196 ELSE ; zmskj_small(ji,jj,jl) = 1. ;ENDIF195 IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0 196 ELSE ; jmsk_small(ji,jj,jl) = 1 ; ENDIF 197 197 END DO 198 198 END DO … … 204 204 ! ----------------------- ! 205 205 ! 206 ! set u*A=u for advection of A only207 DO jl = 1, jpl208 zua_ho(:,:,jl) = zudy(:,:)209 zva_ho(:,:,jl) = zvdx(:,:)210 END DO211 212 206 !== Ice area ==! 213 207 zamsk = 1._wp 214 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zu a_ho , zva_ho, zcu_box, zcv_box, &208 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zu_cat , zv_cat , zcu_box, zcv_box, & 215 209 & pa_i, pa_i, zua_ups, zva_ups, zua_ho , zva_ho ) 216 zamsk = 0._wp 217 218 IF( .NOT. ll_advS ) THEN !-- advection form: uA * uHS / u 210 ! 211 ! ! --------------------------------- ! 212 IF( np_advS == 1 ) THEN ! -- advection form: -div( uVS ) -- ! 213 ! ! --------------------------------- ! 214 zamsk = 0._wp 219 215 !== Ice volume ==! 220 216 zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:) 221 217 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 222 218 & zhvar, pv_i, zua_ups, zva_ups ) 223 !224 219 !== Snw volume ==! 225 220 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) … … 227 222 & zhvar, pv_s, zua_ups, zva_ups ) 228 223 ! 224 zamsk = 1._wp 225 !== Salt content ==! 226 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 227 & psv_i, psv_i ) 228 !== Ice heat content ==! 229 DO jk = 1, nlay_i 230 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 231 & pe_i(:,:,jk,:), pe_i(:,:,jk,:) ) 232 END DO 233 !== Snw heat content ==! 234 DO jk = 1, nlay_s 235 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 236 & pe_s(:,:,jk,:), pe_s(:,:,jk,:) ) 237 END DO 238 ! 239 ! ! ------------------------------------------ ! 240 ELSEIF( np_advS == 2 ) THEN ! -- advection form: -div( uA * uHS / u ) -- ! 241 ! ! ------------------------------------------ ! 242 zamsk = 0._wp 243 !== Ice volume ==! 244 zhvar(:,:,:) = pv_i(:,:,:) * z1_ai(:,:,:) 245 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 246 & zhvar, pv_i, zua_ups, zva_ups ) 247 !== Snw volume ==! 248 zhvar(:,:,:) = pv_s(:,:,:) * z1_ai(:,:,:) 249 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 250 & zhvar, pv_s, zua_ups, zva_ups ) 229 251 !== Salt content ==! 230 252 zhvar(:,:,:) = psv_i(:,:,:) * z1_ai(:,:,:) 231 253 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & 232 254 & zhvar, psv_i, zua_ups, zva_ups ) 233 !234 255 !== Ice heat content ==! 235 256 DO jk = 1, nlay_i … … 238 259 & zhvar, pe_i(:,:,jk,:), zua_ups, zva_ups ) 239 260 END DO 240 !241 261 !== Snw heat content ==! 242 262 DO jk = 1, nlay_s … … 246 266 END DO 247 267 ! 248 ELSE !-- advection form: uV * uS / u 268 ! ! ----------------------------------------- ! 269 ELSEIF( np_advS == 3 ) THEN ! -- advection form: -div( uV * uS / u ) -- ! 270 ! ! ----------------------------------------- ! 271 zamsk = 0._wp 272 ! 273 ALLOCATE( zuv_ho (jpi,jpj,jpl), zvv_ho (jpi,jpj,jpl), & 274 & zuv_ups(jpi,jpj,jpl), zvv_ups(jpi,jpj,jpl), z1_vi(jpi,jpj,jpl), z1_vs(jpi,jpj,jpl) ) 275 ! 249 276 ! inverse of Vi 250 277 WHERE( pv_i(:,:,:) >= epsi20 ) ; z1_vi(:,:,:) = 1._wp / pv_i(:,:,:) … … 264 291 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 265 292 & zhvar, pv_i, zuv_ups, zvv_ups, zuv_ho , zvv_ho ) 266 !267 293 !== Salt content ==! 268 294 zhvar(:,:,:) = psv_i(:,:,:) * z1_vi(:,:,:) 269 295 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zuv_ho , zvv_ho , zcu_box, zcv_box, & 270 296 & zhvar, psv_i, zuv_ups, zvv_ups ) 271 !272 297 !== Ice heat content ==! 273 298 DO jk = 1, nlay_i … … 276 301 & zhvar, pe_i(:,:,jk,:), zuv_ups, zvv_ups ) 277 302 END DO 278 !279 303 !== Snow volume ==! 280 304 zuv_ups = zua_ups … … 283 307 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx, zua_ho , zva_ho , zcu_box, zcv_box, & 284 308 & zhvar, pv_s, zuv_ups, zvv_ups, zuv_ho , zvv_ho ) 285 !286 309 !== Snw heat content ==! 287 310 DO jk = 1, nlay_s … … 291 314 END DO 292 315 ! 316 DEALLOCATE( zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs ) 317 ! 293 318 ENDIF 294 319 ! 295 320 !== Ice age ==! 296 321 IF( iom_use('iceage') .OR. iom_use('iceage_cat') ) THEN 297 ! clem: in theory we should use the formulation below to advect the ice age, but the code is unable to deal with298 ! fields that do not depend on volume (here oa_i depends on concentration). It creates abnormal ages that299 ! spread into the domain. Therefore we cheat and consider that ice age should be advected as ice concentration300 !!zhvar(:,:,:) = poa_i(:,:,:) * z1_ai(:,:,:)301 !!CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy, zvdx, zua_ho, zva_ho, zcu_box, zcv_box, zhvar, poa_i )302 ! set u*A=u for advection of ice age303 DO jl = 1, jpl304 zua_ho(:,:,jl) = zudy(:,:)305 zva_ho(:,:,jl) = zvdx(:,:)306 END DO307 322 zamsk = 1._wp 308 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu a_ho, zva_ho, zcu_box, zcv_box, &323 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat, zv_cat, zcu_box, zcv_box, & 309 324 & poa_i, poa_i ) 310 zamsk = 0._wp311 325 ENDIF 312 326 ! 313 327 !== melt ponds ==! 314 328 IF ( ln_pnd_H12 ) THEN 315 ! set u*A=u for advection of Ap only316 DO jl = 1, jpl317 zua_ho(:,:,jl) = zudy(:,:)318 zva_ho(:,:,jl) = zvdx(:,:)319 END DO320 329 ! fraction 321 330 zamsk = 1._wp 322 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu a_ho , zva_ho, zcu_box, zcv_box, &331 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zu_cat , zv_cat , zcu_box, zcv_box, & 323 332 & pa_ip, pa_ip, zua_ups, zva_ups, zua_ho , zva_ho ) 333 ! volume 324 334 zamsk = 0._wp 325 ! volume326 335 zhvar(:,:,:) = pv_ip(:,:,:) * z1_aip(:,:,:) 327 336 CALL adv_umx( zamsk, kn_umx, jt, kt, zdt, zudy , zvdx , zua_ho , zva_ho , zcu_box, zcv_box, & … … 341 350 ! 342 351 ! --- Ensure non-negative fields and in-bound thicknesses --- ! 343 !344 352 ! Remove negative values (conservation is ensured) 345 353 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) … … 474 482 CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1. ) 475 483 ! 476 IF ( kn_limiter == 1 ) THEN484 IF ( np_limiter == 1 ) THEN 477 485 CALL nonosc_ice( 1._wp, pdt, pu, pv, ptc, zt_ups, zfu_ups, zfv_ups, zfu_ho, zfv_ho ) 478 ELSEIF( kn_limiter == 2 .OR. kn_limiter == 3 ) THEN486 ELSEIF( np_limiter == 2 .OR. np_limiter == 3 ) THEN 479 487 CALL limiter_x( pdt, pu, ptc, zfu_ups, zfu_ho ) 480 488 CALL limiter_y( pdt, pv, ptc, zfv_ups, zfv_ho ) … … 659 667 END DO 660 668 ! 661 IF ( kn_limiter == 1 ) THEN669 IF ( np_limiter == 1 ) THEN 662 670 CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 663 ELSEIF( kn_limiter == 2 .OR. kn_limiter == 3 ) THEN671 ELSEIF( np_limiter == 2 .OR. np_limiter == 3 ) THEN 664 672 CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 665 673 CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) … … 677 685 END DO 678 686 END DO 679 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )687 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 680 688 681 689 DO jl = 1, jpl !-- first guess of tracer from u-flux … … 698 706 END DO 699 707 END DO 700 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )708 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 701 709 702 710 ELSE !== even ice time step: adv_y then adv_x ==! … … 709 717 END DO 710 718 END DO 711 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )719 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 712 720 ! 713 721 DO jl = 1, jpl !-- first guess of tracer from v-flux … … 730 738 END DO 731 739 END DO 732 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )740 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 733 741 734 742 ENDIF 735 IF( kn_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )743 IF( np_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 736 744 737 745 ENDIF … … 771 779 CALL ultimate_x( pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho ) 772 780 ! !-- limiter in x --! 773 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )781 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 774 782 ! !-- advective form update in zpt --! 775 783 DO jl = 1, jpl … … 792 800 ENDIF 793 801 ! !-- limiter in y --! 794 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )802 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 795 803 ! 796 804 ! … … 800 808 CALL ultimate_y( pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho ) 801 809 ! !-- limiter in y --! 802 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho )810 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 803 811 ! !-- advective form update in zpt --! 804 812 DO jl = 1, jpl … … 821 829 ENDIF 822 830 ! !-- limiter in x --! 823 IF( kn_limiter == 2 .OR. kn_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho )831 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 824 832 ! 825 833 ENDIF 826 834 827 IF( kn_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho )835 IF( np_limiter == 1 ) CALL nonosc_ice( pamsk, pdt, pu, pv, pt, pt_ups, pfu_ups, pfv_ups, pfu_ho, pfv_ho ) 828 836 ! 829 837 END SUBROUTINE macho … … 967 975 DO jj = 1, jpjm1 968 976 DO ji = 1, fs_jpim1 969 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( zmski_small(ji,jj,jl) == 0..AND. pamsk == 0. ) ) THEN977 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 970 978 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 971 979 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) … … 1121 1129 DO jj = 1, jpjm1 1122 1130 DO ji = 1, fs_jpim1 1123 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( zmskj_small(ji,jj,jl) == 0..AND. pamsk == 0. ) ) THEN1131 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1124 1132 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & 1125 1133 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) … … 1185 1193 ! | | | | * 1186 1194 ! t_ups : i-1 i i+1 i+2 1187 IF( ll_prelim iter_zalesak) THEN1195 IF( ll_prelim ) THEN 1188 1196 1189 1197 DO jl = 1, jpl … … 1352 1360 Rjp = zslpx(ji+1,jj,jl) 1353 1361 1354 IF( kn_limiter == 3 ) THEN1362 IF( np_limiter == 3 ) THEN 1355 1363 1356 1364 IF( pu(ji,jj) > 0. ) THEN ; Rr = Rjm … … 1368 1376 pfu_ho(ji,jj,jl) = pfu_ups(ji,jj,jl) + zlimiter 1369 1377 1370 ELSEIF( kn_limiter == 2 ) THEN1378 ELSEIF( np_limiter == 2 ) THEN 1371 1379 IF( Rj /= 0. ) THEN 1372 1380 IF( pu(ji,jj) > 0. ) THEN ; Cr = Rjm / Rj … … 1447 1455 Rjp = zslpy(ji,jj+1,jl) 1448 1456 1449 IF( kn_limiter == 3 ) THEN1457 IF( np_limiter == 3 ) THEN 1450 1458 1451 1459 IF( pv(ji,jj) > 0. ) THEN ; Rr = Rjm … … 1463 1471 pfv_ho(ji,jj,jl) = pfv_ups(ji,jj,jl) + zlimiter 1464 1472 1465 ELSEIF( kn_limiter == 2 ) THEN1473 ELSEIF( np_limiter == 2 ) THEN 1466 1474 1467 1475 IF( Rj /= 0. ) THEN -
NEMO/trunk/src/ICE/icedyn_rdgrft.F90
r10531 r10945 945 945 CALL ctl_stop( 'ice_dyn_rdgrft_init: choose one and only one participation function (ln_partf_lin or ln_partf_exp)' ) 946 946 ENDIF 947 ! ! allocate tke arrays 947 ! 948 IF( .NOT. ln_icethd ) THEN 949 rn_porordg = 0._wp 950 rn_fsnwrdg = 1._wp ; rn_fsnwrft = 1._wp 951 rn_fpndrdg = 1._wp ; rn_fpndrft = 1._wp 952 IF( lwp ) THEN 953 WRITE(numout,*) ' ==> only ice dynamics is activated, thus some parameters must be changed' 954 WRITE(numout,*) ' rn_porordg = ', rn_porordg 955 WRITE(numout,*) ' rn_fsnwrdg = ', rn_fsnwrdg 956 WRITE(numout,*) ' rn_fpndrdg = ', rn_fpndrdg 957 WRITE(numout,*) ' rn_fsnwrft = ', rn_fsnwrft 958 WRITE(numout,*) ' rn_fpndrft = ', rn_fpndrft 959 ENDIF 960 ENDIF 961 ! ! allocate arrays 948 962 IF( ice_dyn_rdgrft_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'ice_dyn_rdgrft_init: unable to allocate arrays' ) 949 963 ! -
NEMO/trunk/src/ICE/icevar.F90
r10930 r10945 563 563 DO jl = 1, jpl !== loop over the categories ==! 564 564 ! 565 ! make sure a_i=0 where v_i<=0 566 WHERE( pv_i(:,:,:) <= 0._wp ) pa_i(:,:,:) = 0._wp 567 565 568 !---------------------------------------- 566 569 ! zap ice energy and send it to the ocean … … 569 572 DO jj = 1 , jpj 570 573 DO ji = 1 , jpi 571 IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN574 IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 572 575 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 573 576 pe_i(ji,jj,jk,jl) = 0._wp … … 580 583 DO jj = 1 , jpj 581 584 DO ji = 1 , jpi 582 IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN585 IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 583 586 hfx_res(ji,jj) = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 584 587 pe_s(ji,jj,jk,jl) = 0._wp … … 593 596 DO jj = 1 , jpj 594 597 DO ji = 1 , jpi 595 IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN598 IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 596 599 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 597 600 pv_i (ji,jj,jl) = 0._wp 598 601 ENDIF 599 IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN602 IF( pv_s(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 600 603 wfx_res(ji,jj) = wfx_res(ji,jj) + pv_s (ji,jj,jl) * rhos * z1_dt 601 604 pv_s (ji,jj,jl) = 0._wp 602 605 ENDIF 603 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) < 0._wp ) THEN606 IF( psv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 604 607 sfx_res(ji,jj) = sfx_res(ji,jj) + psv_i(ji,jj,jl) * rhoi * z1_dt 605 608 psv_i (ji,jj,jl) = 0._wp
Note: See TracChangeset
for help on using the changeset viewer.
