Changeset 13258 for NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/ICE
- Timestamp:
- 2020-07-07T12:23:18+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12973_AGRIF_CMEMS
- Files:
-
- 17 edited
-
. (modified) (1 prop)
-
src/ICE/icecor.F90 (modified) (1 diff)
-
src/ICE/icedyn.F90 (modified) (2 diffs)
-
src/ICE/icedyn_adv_pra.F90 (modified) (4 diffs)
-
src/ICE/icedyn_adv_umx.F90 (modified) (22 diffs)
-
src/ICE/icedyn_rdgrft.F90 (modified) (3 diffs)
-
src/ICE/icedyn_rhg_evp.F90 (modified) (14 diffs)
-
src/ICE/iceistate.F90 (modified) (4 diffs)
-
src/ICE/iceitd.F90 (modified) (3 diffs)
-
src/ICE/icesbc.F90 (modified) (1 diff)
-
src/ICE/icethd.F90 (modified) (2 diffs)
-
src/ICE/icethd_dh.F90 (modified) (2 diffs)
-
src/ICE/icethd_do.F90 (modified) (2 diffs)
-
src/ICE/icethd_ent.F90 (modified) (3 diffs)
-
src/ICE/iceupdate.F90 (modified) (2 diffs)
-
src/ICE/icevar.F90 (modified) (1 diff)
-
src/ICE/icewri.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS
- Property svn:externals
-
old new 2 2 ^/utils/build/makenemo@HEAD makenemo 3 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools _dev_r12970_AGRIF_CMEMStools4 ^/utils/tools/@HEAD tools 5 5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/ICE/icecor.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icedyn.F90
r12377 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icedyn_adv_pra.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icedyn_adv_umx.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icedyn_rdgrft.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icedyn_rhg_evp.F90
r12489 r13258 49 49 !! * Substitutions 50 50 # include "do_loop_substitute.h90" 51 # include "domzgr_substitute.h90" 51 52 !!---------------------------------------------------------------------- 52 53 !! NEMO/ICE 4.0 , NEMO Consortium (2018) … … 299 300 300 301 END_2D 301 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 ) 302 303 ! 303 304 ! !== Landfast ice parameterization ==! … … 318 319 tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 319 320 END_2D 320 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. )321 CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 321 322 ! 322 323 ELSE !-- no landfast … … 352 353 353 354 END_2D 354 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1. )355 CALL lbc_lnk( 'icedyn_rhg_evp', zds, 'F', 1.0_wp ) 355 356 356 357 DO_2D_01_01 … … 394 395 395 396 END_2D 396 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1. )397 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 397 398 398 399 DO_2D_10_10 … … 483 484 ENDIF 484 485 END_2D 485 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )486 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 486 487 ! 487 488 #if defined key_agrif … … 532 533 ENDIF 533 534 END_2D 534 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )535 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 535 536 ! 536 537 #if defined key_agrif … … 583 584 ENDIF 584 585 END_2D 585 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1. )586 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 586 587 ! 587 588 #if defined key_agrif … … 632 633 ENDIF 633 634 END_2D 634 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1. )635 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 635 636 ! 636 637 #if defined key_agrif … … 693 694 694 695 END_2D 695 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 ) 696 697 697 698 ! --- Store the stress tensor for the next time step --- ! 698 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 ) 699 700 pstress1_i (:,:) = zs1 (:,:) 700 701 pstress2_i (:,:) = zs2 (:,:) … … 713 714 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 714 715 ! 715 CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1. , ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., &716 & 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 ) 717 718 ! 718 719 CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) … … 751 752 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 752 753 END_2D 753 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 ) 754 755 ! 755 756 CALL iom_put( 'isig1' , zsig1 ) … … 768 769 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 769 770 ! 770 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1. , zspgV, 'V', -1., &771 & 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 ) 772 773 773 774 CALL iom_put( 'dssh_dx' , zspgU * zmsk00 ) ! Sea-surface tilt term in force balance (x) … … 801 802 END_2D 802 803 803 CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1. , zdiag_ymtrp_ice, 'V', -1., &804 & zdiag_xmtrp_snw, 'U', -1. , zdiag_ymtrp_snw, 'V', -1., &805 & 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 ) 806 807 807 808 CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice ) ! X-component of sea-ice mass transport (kg/s) -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/ICE/iceistate.F90
r13026 r13258 66 66 INTEGER , PARAMETER :: jp_hpd = 9 ! index of pnd depth (m) 67 67 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: si ! structure of input fields (file informations, fields read) 68 ! 68 69 69 !! * Substitutions 70 70 # include "do_loop_substitute.h90" … … 108 108 REAL(wp), DIMENSION(jpi,jpj) :: zt_su_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 109 109 REAL(wp), DIMENSION(jpi,jpj) :: zapnd_ini, zhpnd_ini !data from namelist or nc file 110 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d ! temporaryarrays110 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zti_3d , zts_3d !locak arrays 111 111 !! 112 112 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zhi_2d, zhs_2d, zai_2d, zti_2d, zts_2d, ztsu_2d, zsi_2d, zaip_2d, zhip_2d … … 427 427 ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 428 428 ! 429 IF( .NOT.ln_linssh ) THEN 430 ! 431 WHERE( ht_0(:,:) > 0 ) ; z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 432 ELSEWHERE ; z2d(:,:) = 1._wp ; END WHERE 433 ! 434 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 435 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 436 e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 437 e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 438 END DO 439 ! 440 ! Reconstruction of all vertical scale factors at now and before time-steps 441 ! ========================================================================= 442 ! Horizontal scale factor interpolations 443 ! -------------------------------------- 444 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 445 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 446 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 447 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 448 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 449 ! Vertical scale factor interpolations 450 ! ------------------------------------ 451 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 452 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 453 CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 454 CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 455 CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 456 ! t- and w- points depth 457 ! ---------------------- 458 !!gm not sure of that.... 459 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 460 gdepw(:,:,1,Kmm) = 0.0_wp 461 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 462 DO jk = 2, jpk 463 gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk ,Kmm) 464 gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 465 gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - ssh (:,:,Kmm) 466 END DO 467 ENDIF 429 IF( .NOT.ln_linssh ) CALL dom_vvl_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 430 ! !!st 431 ! IF( .NOT.ln_linssh ) THEN 432 ! ! 433 ! WHERE( ht_0(:,:) > 0 ) ; z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 434 ! ELSEWHERE ; z2d(:,:) = 1._wp ; END WHERE 435 ! ! 436 ! DO jk = 1,jpkm1 ! adjust initial vertical scale factors 437 ! e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 438 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 439 ! e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 440 ! END DO 441 ! ! 442 ! ! Reconstruction of all vertical scale factors at now and before time-steps 443 ! ! ========================================================================= 444 ! ! Horizontal scale factor interpolations 445 ! ! -------------------------------------- 446 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 447 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 448 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 449 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 450 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 451 ! ! Vertical scale factor interpolations 452 ! ! ------------------------------------ 453 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 454 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 455 ! CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 456 ! CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 457 ! CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 458 ! ! t- and w- points depth 459 ! ! ---------------------- 460 ! !!gm not sure of that.... 461 ! gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 462 ! gdepw(:,:,1,Kmm) = 0.0_wp 463 ! gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 464 ! DO jk = 2, jpk 465 ! gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk ,Kmm) 466 ! gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 467 ! gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - ssh (:,:,Kmm) 468 ! END DO 469 ! ENDIF 468 470 ENDIF 469 471 … … 503 505 !! 504 506 !!----------------------------------------------------------------------------- 505 INTEGER :: ios ! Local integer output status for namelist read506 INTEGER :: ifpr, ierror 507 INTEGER :: ios, ifpr, ierror ! Local integers 508 507 509 ! 508 510 CHARACTER(len=256) :: cn_dir ! Root directory for location of ice files -
NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/ICE/iceitd.F90
r12377 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icesbc.F90
r12377 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icethd.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icethd_dh.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icethd_do.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icethd_ent.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/iceupdate.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icevar.F90
r12489 r13258 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_r12973_AGRIF_CMEMS/src/ICE/icewri.F90
r12489 r13258 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.
