- Timestamp:
- 2020-07-02T16:41:07+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icecor.F90
r12724 r13228 114 114 ENDIF 115 115 END_2D 116 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1. , v_ice, 'V', -1.)116 CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 117 117 ENDIF 118 118 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icedyn.F90
r12377 r13228 129 129 zcoefu = ( REAL(jpiglo+1)*0.5 - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5 - 1. ) 130 130 zcoefv = ( REAL(jpjglo+1)*0.5 - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5 - 1. ) 131 u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1. , zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1)132 v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1. , zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1)131 u_ice(ji,jj) = rn_uice * 1.5 * SIGN( 1.0_wp, zcoefu ) * ABS( zcoefu ) * umask(ji,jj,1) 132 v_ice(ji,jj) = rn_vice * 1.5 * SIGN( 1.0_wp, zcoefv ) * ABS( zcoefv ) * vmask(ji,jj,1) 133 133 END_2D 134 134 ! --- … … 159 159 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) ) * r1_e1e2t(ji,jj) 160 160 END_2D 161 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. )161 CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1.0_wp ) 162 162 ! output 163 163 CALL iom_put( 'icediv' , zdivu_i ) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icedyn_adv_pra.F90
r12724 r13228 117 117 END_2D 118 118 END DO 119 CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1. , zhs_max, 'T', 1., zhip_max, 'T', 1.)119 CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 120 120 ! 121 121 ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! … … 254 254 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 255 255 END_2D 256 CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1. )256 CALL lbc_lnk( 'icedyn_adv_pra', pato_i, 'T', 1.0_wp ) 257 257 ! 258 258 ! --- Ensure non-negative fields --- ! … … 425 425 426 426 !-- Lateral boundary conditions 427 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1. , ps0 , 'T', 1.&428 & , psx , 'T', -1. , psy , 'T', -1.& ! caution gradient ==> the sign changes429 & , psxx , 'T', 1. , psyy, 'T', 1. , psxy, 'T', 1.)427 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1.0_wp, ps0 , 'T', 1.0_wp & 428 & , psx , 'T', -1.0_wp, psy , 'T', -1.0_wp & ! caution gradient ==> the sign changes 429 & , psxx , 'T', 1.0_wp, psyy, 'T', 1.0_wp , psxy, 'T', 1.0_wp ) 430 430 ! 431 431 END SUBROUTINE adv_x … … 584 584 585 585 !-- Lateral boundary conditions 586 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1. , ps0 , 'T', 1.&587 & , psx , 'T', -1. , psy , 'T', -1.& ! caution gradient ==> the sign changes588 & , psxx , 'T', 1. , psyy, 'T', 1. , psxy, 'T', 1.)586 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1.0_wp, ps0 , 'T', 1.0_wp & 587 & , psx , 'T', -1.0_wp, psy , 'T', -1.0_wp & ! caution gradient ==> the sign changes 588 & , psxx , 'T', 1.0_wp, psyy, 'T', 1.0_wp , psxy, 'T', 1.0_wp ) 589 589 ! 590 590 END SUBROUTINE adv_y -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icedyn_adv_umx.F90
r12724 r13228 122 122 END_2D 123 123 END DO 124 CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1. , zhs_max, 'T', 1., zhip_max, 'T', 1.)124 CALL lbc_lnk_multi( 'icedyn_adv_umx', zhi_max, 'T', 1.0_wp, zhs_max, 'T', 1.0_wp, zhip_max, 'T', 1.0_wp ) 125 125 ! 126 126 ! … … 336 336 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt 337 337 END_2D 338 CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1. )338 CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1.0_wp ) 339 339 ! 340 340 ! … … 469 469 END_2D 470 470 END DO 471 CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1. )471 CALL lbc_lnk( 'icedyn_adv_umx', zt_ups, 'T', 1.0_wp ) 472 472 ! 473 473 IF ( np_limiter == 1 ) THEN … … 500 500 END_2D 501 501 END DO 502 CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T', 1. )502 CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T', 1.0_wp ) 503 503 ! 504 504 END SUBROUTINE adv_umx … … 552 552 END_2D 553 553 END DO 554 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )554 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 555 555 ! 556 556 DO jl = 1, jpl !-- flux in y-direction … … 576 576 END_2D 577 577 END DO 578 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )578 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 579 579 ! 580 580 DO jl = 1, jpl !-- flux in x-direction … … 598 598 END_2D 599 599 END DO 600 CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1. )600 CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 601 601 602 602 END SUBROUTINE upstream … … 660 660 END_2D 661 661 END DO 662 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )662 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 663 663 664 664 DO jl = 1, jpl !-- flux in y-direction … … 686 686 END_2D 687 687 END DO 688 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )688 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 689 689 ! 690 690 DO jl = 1, jpl !-- flux in x-direction … … 744 744 END_2D 745 745 END DO 746 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )746 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 747 747 ! 748 748 ! !-- ultimate interpolation of pt at v-point --! … … 771 771 END_2D 772 772 END DO 773 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )773 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 774 774 ! 775 775 ! !-- ultimate interpolation of pt at u-point --! … … 824 824 END DO 825 825 END DO 826 CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1. )826 CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 827 827 ! 828 828 ! !-- BiLaplacian in i-direction --! … … 838 838 END DO 839 839 END DO 840 CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1. )840 CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 841 841 ! 842 842 ! … … 964 964 END_2D 965 965 END DO 966 CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1. )966 CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 967 967 ! 968 968 ! !-- BiLaplacian in j-direction --! … … 975 975 END_2D 976 976 END DO 977 CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1. )977 CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 978 978 ! 979 979 ! … … 1114 1114 END_2D 1115 1115 END DO 1116 CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1. , ztj_ups, 'T', 1.)1116 CALL lbc_lnk_multi( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp ) 1117 1117 1118 1118 DO jl = 1, jpl … … 1136 1136 END_2D 1137 1137 END DO 1138 CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1. , pfv_ho, 'V', -1.) ! lateral boundary cond.1138 CALL lbc_lnk_multi( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp ) ! lateral boundary cond. 1139 1139 1140 1140 ENDIF … … 1193 1193 END_2D 1194 1194 END DO 1195 CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1. , zbetdo, 'T', 1.) ! lateral boundary cond. (unchanged sign)1195 CALL lbc_lnk_multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 1196 1196 1197 1197 … … 1248 1248 END_2D 1249 1249 END DO 1250 CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1. ) ! lateral boundary cond.1250 CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp) ! lateral boundary cond. 1251 1251 1252 1252 DO jl = 1, jpl … … 1312 1312 END_2D 1313 1313 END DO 1314 CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1. ) ! lateral boundary cond.1314 CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp) ! lateral boundary cond. 1315 1315 ! 1316 1316 END SUBROUTINE limiter_x … … 1339 1339 END_2D 1340 1340 END DO 1341 CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1. ) ! lateral boundary cond.1341 CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp) ! lateral boundary cond. 1342 1342 1343 1343 DO jl = 1, jpl … … 1404 1404 END_2D 1405 1405 END DO 1406 CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1. ) ! lateral boundary cond.1406 CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp) ! lateral boundary cond. 1407 1407 ! 1408 1408 END SUBROUTINE limiter_y -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icedyn_rdgrft.F90
r12724 r13228 300 300 301 301 ! ! Ice thickness needed for rafting 302 ! In single precision there were floating point invalids due a sqrt of zhi which happens to have negative values 303 ! To solve that an extra check about the value of pv_i was added. 304 ! Although adding this condition is safe, the double definition (one for single other for double) has been kept to preserve the results of the sette test. 305 #if defined key_single 306 307 WHERE( pa_i(1:npti,:) > epsi10 .and. pv_i(1:npti,:) > epsi10 ) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 308 #else 302 309 WHERE( pa_i(1:npti,:) > epsi10 ) ; zhi(1:npti,:) = pv_i(1:npti,:) / pa_i(1:npti,:) 310 #endif 303 311 ELSEWHERE ; zhi(1:npti,:) = 0._wp 304 312 END WHERE … … 780 788 strength(ji,jj) = zworka(ji,jj) 781 789 END_2D 782 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. )790 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 783 791 ! 784 792 CASE( 2 ) !--- Temporal smoothing … … 799 807 ENDIF 800 808 END_2D 801 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1. )809 CALL lbc_lnk( 'icedyn_rdgrft', strength, 'T', 1.0_wp ) 802 810 ! 803 811 END SELECT -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icedyn_rhg_evp.F90
r12731 r13228 300 300 301 301 END_2D 302 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1. , zdt_m, 'T', 1.)302 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 303 303 ! 304 304 ! !== Landfast ice parameterization ==! … … 319 319 tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 320 320 END_2D 321 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. )321 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 322 322 ! 323 323 ELSE !-- no landfast … … 353 353 354 354 END_2D 355 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. )355 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1.0_wp ) 356 356 357 357 DO_2D_01_01 … … 395 395 396 396 END_2D 397 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. )397 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 398 398 399 399 DO_2D_10_10 … … 484 484 ENDIF 485 485 END_2D 486 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )486 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 487 487 ! 488 488 #if defined key_agrif … … 533 533 ENDIF 534 534 END_2D 535 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )535 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 536 536 ! 537 537 #if defined key_agrif … … 584 584 ENDIF 585 585 END_2D 586 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )586 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 587 587 ! 588 588 #if defined key_agrif … … 633 633 ENDIF 634 634 END_2D 635 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )635 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 636 636 ! 637 637 #if defined key_agrif … … 694 694 695 695 END_2D 696 CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1. , pdivu_i, 'T', 1., pdelta_i, 'T', 1.)696 CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp ) 697 697 698 698 ! --- Store the stress tensor for the next time step --- ! 699 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1. , zs2, 'T', 1., zs12, 'F', 1.)699 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 700 700 pstress1_i (:,:) = zs1 (:,:) 701 701 pstress2_i (:,:) = zs2 (:,:) … … 714 714 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 715 715 ! 716 CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1. , ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., &717 & ztaux_bi, 'U', -1. , ztauy_bi, 'V', -1.)716 CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 717 & ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 718 718 ! 719 719 CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) … … 752 752 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 753 753 END_2D 754 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1. , zsig2, 'T', 1., zsig3, 'T', 1.)754 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp ) 755 755 ! 756 756 CALL iom_put( 'isig1' , zsig1 ) … … 769 769 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 770 770 ! 771 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1. , zspgV, 'V', -1., &772 & zCorU, 'U', -1. , zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1.)771 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 772 & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 773 773 774 774 CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x) … … 802 802 END_2D 803 803 804 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1. , zdiag_ymtrp_ice, 'V', -1., &805 & zdiag_xmtrp_snw, 'U', -1. , zdiag_ymtrp_snw, 'V', -1., &806 & zdiag_xatrp , 'U', -1. , zdiag_yatrp , 'V', -1.)804 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 805 & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 806 & zdiag_xatrp , 'U', -1.0_wp, zdiag_yatrp , 'V', -1.0_wp ) 807 807 808 808 CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice ) ! X-component of sea-ice mass transport (kg/s) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceitd.F90
r12377 r13228 148 148 ! Note: hn(t+1) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 149 149 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 150 # if defined key_single 151 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi06 ) ) nptidx(ji) = 0 152 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi06 ) ) nptidx(ji) = 0 153 # else 150 154 IF( a_i_2d(ji,jl ) > epsi10 .AND. h_i_2d(ji,jl ) > ( zhbnew(ji,jl) - epsi10 ) ) nptidx(ji) = 0 151 155 IF( a_i_2d(ji,jl+1) > epsi10 .AND. h_i_2d(ji,jl+1) < ( zhbnew(ji,jl) + epsi10 ) ) nptidx(ji) = 0 156 # endif 152 157 ! 153 158 ! 2) Hn-1 < Hn* < Hn+1 … … 170 175 ! h1(t) must not be too close to either HR or HL otherwise a division by nearly 0 is possible 171 176 ! in itd_glinear in the case (HR-HL) = 3(Hice - HL) or = 3(HR - Hice) 177 # if defined key_single 178 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi06 ) ) nptidx(ji) = 0 179 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi06 ) ) nptidx(ji) = 0 180 # else 172 181 IF( h_ib_2d(ji,1) < ( hi_max(0) + epsi10 ) ) nptidx(ji) = 0 173 182 IF( h_ib_2d(ji,1) > ( hi_max(1) - epsi10 ) ) nptidx(ji) = 0 183 # endif 174 184 END DO 175 185 ! … … 538 548 ! 4) Update ice thickness and temperature 539 549 !------------------------------------------------------------------------------- 550 # if defined key_single 551 WHERE( a_i_2d(1:npti,:) >= epsi06 ) 552 # else 540 553 WHERE( a_i_2d(1:npti,:) >= epsi20 ) 554 # endif 541 555 h_i_2d (1:npti,:) = v_i_2d(1:npti,:) / a_i_2d(1:npti,:) 542 556 t_su_2d(1:npti,:) = zaTsfn(1:npti,:) / a_i_2d(1:npti,:) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icesbc.F90
r12377 r13228 86 86 vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 87 87 END_2D 88 CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1. , vtau_ice, 'V', -1.)88 CALL lbc_lnk_multi( 'icesbc', utau_ice, 'U', -1.0_wp, vtau_ice, 'V', -1.0_wp ) 89 89 ENDIF 90 90 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icethd.F90
r12724 r13228 121 121 END_2D 122 122 ENDIF 123 CALL lbc_lnk( 'icethd', zfric, 'T', 1. )123 CALL lbc_lnk( 'icethd', zfric, 'T', 1.0_wp ) 124 124 ! 125 125 !--------------------------------------------------------------------! … … 218 218 CALL ice_thd_dh ! Ice-Snow thickness 219 219 CALL ice_thd_pnd ! Melt ponds formation 220 CALL ice_thd_ent( e_i_1d(1:npti,:) ) ! Ice enthalpy remapping220 CALL ice_thd_ent( e_i_1d(1:npti,:), .true. ) ! Ice enthalpy remapping 221 221 ENDIF 222 222 CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icethd_dh.F90
r12724 r13228 186 186 ! Snow precipitation 187 187 !------------------- 188 CALL ice_thd_snwblow( 1. - at_i_1d(1:npti), zsnw(1:npti) ) ! snow distribution over ice after wind blowing188 CALL ice_thd_snwblow( 1.0_wp - at_i_1d(1:npti), zsnw(1:npti) ) ! snow distribution over ice after wind blowing 189 189 190 190 zdeltah(1:npti,:) = 0._wp … … 442 442 443 443 zEi = rcpi * ( zt_i_new - (ztmelts+rt0) ) & ! Specific enthalpy of forming ice (J/kg, <0) 444 & - rLfus * ( 1.0 - ztmelts / ( zt_i_new - rt0) ) + rcp * ztmelts444 & - rLfus * ( 1.0 - ztmelts / ( MIN( zt_i_new - rt0, -epsi10 ) ) ) + rcp * ztmelts 445 445 446 446 zEw = rcp * ( t_bo_1d(ji) - rt0 ) ! Specific enthalpy of seawater (J/kg, < 0) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icethd_do.F90
r12724 r13228 191 191 END_2D 192 192 ! 193 CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1. , ht_i_new, 'T', 1.)193 CALL lbc_lnk_multi( 'icethd_do', zvrel, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp ) 194 194 195 195 ENDIF … … 385 385 END DO 386 386 ! --- Ice enthalpy remapping --- ! 387 CALL ice_thd_ent( ze_i_2d(1:npti,:,jl) )387 CALL ice_thd_ent( ze_i_2d(1:npti,:,jl), .false. ) 388 388 END DO 389 389 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icethd_ent.F90
r12724 r13228 38 38 CONTAINS 39 39 40 SUBROUTINE ice_thd_ent( qnew )40 SUBROUTINE ice_thd_ent( qnew, compute_hfx_err ) 41 41 !!------------------------------------------------------------------- 42 42 !! *** ROUTINE ice_thd_ent *** … … 64 64 !!------------------------------------------------------------------- 65 65 REAL(wp), DIMENSION(:,:), INTENT(inout) :: qnew ! new enthlapies (J.m-3, remapped) 66 LOGICAL, INTENT(in) :: compute_hfx_err ! determines whether to compute diag. 67 ! error or not 66 68 ! 67 69 INTEGER :: ji ! dummy loop indices … … 128 130 ! comment: if input h_i_old and eh_i_old are already multiplied by a_i (as in icethd_do), 129 131 ! then we should not (* a_i) again but not important since this is just to check that remap error is ~0 130 DO ji = 1, npti 131 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * & 132 & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 133 END DO 134 132 IF( compute_hfx_err ) THEN 133 DO ji = 1, npti 134 hfx_err_rem_1d(ji) = hfx_err_rem_1d(ji) + a_i_1d(ji) * r1_Dt_ice * & 135 & ( SUM( qnew(ji,1:nlay_i) ) * zhnew(ji) - SUM( eh_i_old(ji,0:nlay_i+1) ) ) 136 END DO 137 END IF 138 135 139 END SUBROUTINE ice_thd_ent 136 140 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/iceupdate.F90
r12724 r13228 342 342 tmod_io(ji,jj) = zrhoco * SQRT( zmodt ) ! rhoco * |U_ice-U_oce| at T-point 343 343 END_2D 344 CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1. , tmod_io, 'T', 1.)344 CALL lbc_lnk_multi( 'iceupdate', taum, 'T', 1.0_wp, tmod_io, 'T', 1.0_wp ) 345 345 ! 346 346 utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step … … 364 364 vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice 365 365 END_2D 366 CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1. , vtau, 'V', -1.) ! lateral boundary condition366 CALL lbc_lnk_multi( 'iceupdate', utau, 'U', -1.0_wp, vtau, 'V', -1.0_wp ) ! lateral boundary condition 367 367 ! 368 368 IF( ln_timing ) CALL timing_stop('ice_update_tau') -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icevar.F90
r12724 r13228 635 635 !!------------------------------------------------------------------- 636 636 ! 637 WHERE( pa_i (1:npti,:) < 0._wp .AND. pa_i (1:npti,:) > -epsi10 ) pa_i (1:npti,:) = 0._wp ! a_i must be >= 0 638 WHERE( pv_i (1:npti,:) < 0._wp .AND. pv_i (1:npti,:) > -epsi10 ) pv_i (1:npti,:) = 0._wp ! v_i must be >= 0 639 WHERE( pv_s (1:npti,:) < 0._wp .AND. pv_s (1:npti,:) > -epsi10 ) pv_s (1:npti,:) = 0._wp ! v_s must be >= 0 640 WHERE( psv_i(1:npti,:) < 0._wp .AND. psv_i(1:npti,:) > -epsi10 ) psv_i(1:npti,:) = 0._wp ! sv_i must be >= 0 641 WHERE( poa_i(1:npti,:) < 0._wp .AND. poa_i(1:npti,:) > -epsi10 ) poa_i(1:npti,:) = 0._wp ! oa_i must be >= 0 642 WHERE( pe_i (1:npti,:,:) < 0._wp .AND. pe_i (1:npti,:,:) > -epsi06 ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 643 WHERE( pe_s (1:npti,:,:) < 0._wp .AND. pe_s (1:npti,:,:) > -epsi06 ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 637 638 WHERE( pa_i (1:npti,:) < 0._wp ) pa_i (1:npti,:) = 0._wp ! a_i must be >= 0 639 WHERE( pv_i (1:npti,:) < 0._wp ) pv_i (1:npti,:) = 0._wp ! v_i must be >= 0 640 WHERE( pv_s (1:npti,:) < 0._wp ) pv_s (1:npti,:) = 0._wp ! v_s must be >= 0 641 WHERE( psv_i(1:npti,:) < 0._wp ) psv_i(1:npti,:) = 0._wp ! sv_i must be >= 0 642 WHERE( poa_i(1:npti,:) < 0._wp ) poa_i(1:npti,:) = 0._wp ! oa_i must be >= 0 643 WHERE( pe_i (1:npti,:,:) < 0._wp ) pe_i (1:npti,:,:) = 0._wp ! e_i must be >= 0 644 WHERE( pe_s (1:npti,:,:) < 0._wp ) pe_s (1:npti,:,:) = 0._wp ! e_s must be >= 0 644 645 IF( ln_pnd_H12 ) THEN 645 WHERE( pa_ip(1:npti,:) < 0._wp .AND. pa_ip(1:npti,:) > -epsi10) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0646 WHERE( pv_ip(1:npti,:) < 0._wp .AND. pv_ip(1:npti,:) > -epsi10) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0646 WHERE( pa_ip(1:npti,:) < 0._wp ) pa_ip(1:npti,:) = 0._wp ! a_ip must be >= 0 647 WHERE( pv_ip(1:npti,:) < 0._wp ) pv_ip(1:npti,:) = 0._wp ! v_ip must be >= 0 647 648 ENDIF 648 649 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icewri.F90
r12724 r13228 135 135 z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 136 136 END_2D 137 CALL lbc_lnk( 'icewri', z2d, 'T', 1. )137 CALL lbc_lnk( 'icewri', z2d, 'T', 1.0_wp ) 138 138 CALL iom_put( 'icevel', z2d ) 139 139
Note: See TracChangeset
for help on using the changeset viewer.