Changeset 13237 for NEMO/trunk/src/OCE/ISF
- Timestamp:
- 2020-07-03T11:12:53+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/ISF
- Files:
-
- 8 edited
-
isfcavgam.F90 (modified) (1 diff)
-
isfcpl.F90 (modified) (9 diffs)
-
isfdiags.F90 (modified) (1 diff)
-
isfdynatf.F90 (modified) (3 diffs)
-
isfhdiv.F90 (modified) (2 diffs)
-
isfload.F90 (modified) (3 diffs)
-
isfstp.F90 (modified) (7 diffs)
-
isftbl.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/ISF/isfcavgam.F90
r12077 r13237 30 30 PUBLIC isfcav_gammats 31 31 32 # include "domzgr_substitute.h90" 32 33 !!---------------------------------------------------------------------- 33 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/OCE/ISF/isfcpl.F90
r13226 r13237 15 15 USE isfutils, ONLY : debug 16 16 USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine 17 #if ! defined key_qco 17 18 USE domvvl , ONLY: dom_vvl_zgr ! vertical scale factor interpolation 19 #else 20 USE domqco , ONLY: dom_qco_zgr ! vertical scale factor interpolation 21 #endif 18 22 USE domngb , ONLY: dom_ngb ! find the closest grid point from a given lon/lat position 19 23 ! … … 43 47 !! * Substitutions 44 48 # include "do_loop_substitute.h90" 49 # include "domzgr_substitute.h90" 45 50 !!---------------------------------------------------------------------- 46 51 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 112 117 vv (:,:,:,Kbb) = vv (:,:,:,Kmm) 113 118 ssh (:,:,Kbb) = ssh (:,:,Kmm) 119 #if ! defined key_qco 114 120 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 115 121 #endif 116 122 ! prepare writing restart 117 123 IF( lwxios ) THEN … … 135 141 INTEGER, INTENT(in) :: Kmm ! ocean time level index 136 142 !!---------------------------------------------------------------------- 143 INTEGER :: jk ! loop index 144 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw ! e3t , e3u, e3v !!st patch to use substitution 145 !!---------------------------------------------------------------------- 146 ! 147 DO jk = 1, jpk 148 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 149 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 150 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 151 ! 152 zgdepw(:,:,jk) = gdepw(:,:,jk,Kmm) 153 END DO 137 154 ! 138 155 IF( lwxios ) CALL iom_swap( cwxios_context ) 139 156 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask , ldxios = lwxios ) 140 157 CALL iom_rstput( kt, nitrst, numrow, 'ssmask' , ssmask, ldxios = lwxios ) 141 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n' , e3t(:,:,:,Kmm), ldxios = lwxios )142 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , e3u(:,:,:,Kmm), ldxios = lwxios )143 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , e3v(:,:,:,Kmm), ldxios = lwxios )144 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm), ldxios = lwxios )158 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n' , ze3t , ldxios = lwxios ) 159 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , ze3u , ldxios = lwxios ) 160 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , ze3v , ldxios = lwxios ) 161 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', zgdepw , ldxios = lwxios ) 145 162 IF( lwxios ) CALL iom_swap( cxios_context ) 146 163 ! … … 209 226 IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)' 210 227 IF(lwp) write(numout,*) '~~~~~~~~~~~' 228 #if ! defined key_qco 211 229 DO jk = 1, jpk 212 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 213 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 214 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 230 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + (ht_0(:,:) + ssh(:,:,Kmm)) * r1_ht_0(:,:) ) 215 231 END DO 216 232 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 217 233 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 234 #else 235 CALL dom_qco_zgr(Kbb, Kmm, Kaa) 236 #endif 218 237 ! 219 238 END SUBROUTINE isfcpl_ssh … … 400 419 ! 1.1: get volume flux before coupling (>0 out) 401 420 DO_2D_00_00 402 zqvolb(ji,jj,jk) = ( e2u(ji,jj) * ze3u_b(ji,jj,jk) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * ze3u_b(ji-1,jj ,jk) * uu(ji-1,jj ,jk,Kmm) & 403 & + e1v(ji,jj) * ze3v_b(ji,jj,jk) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * ze3v_b(ji ,jj-1,jk) * vv(ji ,jj-1,jk,Kmm) ) & 421 zqvolb(ji,jj,jk) = & 422 & ( e2u(ji ,jj ) * ze3u_b(ji ,jj ,jk) * uu(ji ,jj ,jk,Kmm) & 423 & - e2u(ji-1,jj ) * ze3u_b(ji-1,jj ,jk) * uu(ji-1,jj ,jk,Kmm) & 424 & + e1v(ji ,jj ) * ze3v_b(ji ,jj ,jk) * vv(ji ,jj ,jk,Kmm) & 425 & - e1v(ji ,jj-1) * ze3v_b(ji ,jj-1,jk) * vv(ji ,jj-1,jk,Kmm) ) & 404 426 & * ztmask_b(ji,jj,jk) 405 427 END_2D … … 412 434 ! compute volume flux divergence after coupling 413 435 DO_2D_00_00 414 zqvoln(ji,jj,jk) = ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * e3u(ji-1,jj ,jk,Kmm) * uu(ji-1,jj ,jk,Kmm) & 415 & + e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) & 436 zqvoln(ji,jj,jk) = & 437 & ( e2u(ji ,jj ) * e3u(ji ,jj ,jk,Kmm) * uu(ji ,jj ,jk,Kmm) & 438 & - e2u(ji-1,jj ) * e3u(ji-1,jj ,jk,Kmm) * uu(ji-1,jj ,jk,Kmm) & 439 & + e1v(ji ,jj ) * e3v(ji ,jj ,jk,Kmm) * vv(ji ,jj ,jk,Kmm) & 440 & - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) & 416 441 & * tmask(ji,jj,jk) 417 442 END_2D … … 523 548 524 549 ! volume diff 525 zdvol = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) - ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk) 550 zdvol = e3t (ji,jj,jk,Kmm) * tmask (ji,jj,jk) & 551 & - ze3t_b(ji,jj,jk ) * ztmask_b(ji,jj,jk) 526 552 527 553 ! heat diff … … 555 581 DO ji = nldi,nlei 556 582 jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ; 557 IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp) 583 IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN 584 nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp) 585 ENDIF 558 586 ENDDO 559 587 ENDDO -
NEMO/trunk/src/OCE/ISF/isfdiags.F90
r12905 r13237 26 26 !! * Substitutions 27 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/OCE/ISF/isfdynatf.F90
r12489 r13237 14 14 15 15 USE phycst , ONLY: r1_rho0 ! physical constant 16 USE dom_oce, ONLY: tmask, ssmask, ht, e3t, r1_e1e2t ! time and space domain 16 USE dom_oce ! time and space domain 17 USE oce, ONLY : ssh ! sea-surface height !!st needed for substitution 17 18 18 19 USE in_out_manager … … 25 26 !! * Substitutions 26 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 27 29 28 30 CONTAINS … … 81 83 ! add the increment 82 84 DO jk = 1, jpkm1 83 pe3t_f(:,:,jk) = pe3t_f(:,:,jk) - tmask(:,:,jk) * zfwfinc(:,:) * e3t(:,:,jk,Kmm) 85 pe3t_f(:,:,jk) = pe3t_f(:,:,jk) - tmask(:,:,jk) * zfwfinc(:,:) & 86 & * e3t(:,:,jk,Kmm) 84 87 END DO 85 88 ! -
NEMO/trunk/src/OCE/ISF/isfhdiv.F90
r12489 r13237 26 26 !! * Substitutions 27 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 28 29 29 30 CONTAINS … … 134 135 ! 135 136 DO jk=1,jpk 136 phdiv(:,:,jk) = phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) 137 phdiv(:,:,jk) = phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) & 138 & / e3t(:,:,jk,Kmm) 137 139 END DO 138 140 ! -
NEMO/trunk/src/OCE/ISF/isfload.F90
r12340 r13237 13 13 USE isf_oce, ONLY: cn_isfload, rn_isfload_T, rn_isfload_S ! ice shelf variables 14 14 15 USE dom_oce , ONLY: e3w, gdept, risfdep, mikt! vertical scale factor15 USE dom_oce ! vertical scale factor 16 16 USE eosbn2 , ONLY: eos ! eos routine 17 17 … … 26 26 !! * Substitutions 27 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 28 29 29 30 CONTAINS … … 99 100 ! 100 101 ! top layer of the ice shelf 101 pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w(ji,jj,1,Kmm) 102 pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) ) & 103 & * e3w(ji,jj,1,Kmm) 102 104 ! 103 105 ! core layers of the ice shelf 104 106 DO jk = 2, ikt-1 105 pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w(ji,jj,jk,Kmm) 107 pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) & 108 & * e3w(ji,jj,jk,Kmm) 106 109 END DO 107 110 ! -
NEMO/trunk/src/OCE/ISF/isfstp.F90
r12242 r13237 13 13 !! isfstp : compute iceshelf melt and heat flux 14 14 !!---------------------------------------------------------------------- 15 !16 15 USE isf_oce ! isf variables 17 16 USE isfload, ONLY: isf_load ! ice shelf load … … 21 20 USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables 22 21 23 USE dom_oce, ONLY: ht, e3t, ln_isfcav, ln_linssh ! ocean space and time domain 22 USE dom_oce ! ocean space and time domain 23 USE oce , ONLY: ssh ! sea surface height 24 24 USE domvvl, ONLY: ln_vvl_zstar ! zstar logical 25 25 USE zdfdrg, ONLY: r_Cdmin_top, r_ke0_top ! vertical physics: top/bottom drag coef. … … 31 31 32 32 IMPLICIT NONE 33 34 33 PRIVATE 35 34 36 35 PUBLIC isf_stp, isf_init, isf_nam ! routine called in sbcmod and divhor 37 36 37 !! * Substitutions 38 # include "domzgr_substitute.h90" 38 39 !!---------------------------------------------------------------------- 39 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 41 42 !! Software governed by the CeCILL license (see ./LICENSE) 42 43 !!---------------------------------------------------------------------- 44 43 45 CONTAINS 44 46 … … 60 62 INTEGER, INTENT(in) :: kt ! ocean time step 61 63 INTEGER, INTENT(in) :: Kmm ! ocean time level index 64 !!---------------------------------------------------------------------- 65 INTEGER :: jk ! loop index 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! e3t 62 67 !!--------------------------------------------------------------------- 63 68 ! … … 78 83 ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl) 79 84 rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:) 80 CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 85 DO jk = 1, jpk 86 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 87 END DO 88 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 81 89 ! 82 90 ! 1.3: compute ice shelf melt … … 100 108 ! by simplicity, we assume the top level where param applied do not change with time (done in init part) 101 109 rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:) 102 CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 110 DO jk = 1, jpk 111 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 112 END DO 113 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 103 114 ! 104 115 ! 2.3: compute ice shelf melt -
NEMO/trunk/src/OCE/ISF/isftbl.F90
r12340 r13237 25 25 !! * Substitutions 26 26 # include "do_loop_substitute.h90" 27 # include "domzgr_substitute.h90" 27 28 28 29 CONTAINS … … 56 57 REAL(wp), DIMENSION(jpi,jpj) :: zhtbl ! thickness of the tbl 57 58 REAL(wp), DIMENSION(jpi,jpj) :: zfrac ! thickness of the tbl 59 INTEGER :: jk ! loop index 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t,ze3u,ze3v ! e3 58 61 !!-------------------------------------------------------------------- 59 62 ! … … 64 67 zhtbl = phtbl 65 68 ! 69 DO jk = 1, jpk 70 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 71 END DO 66 72 ! compute tbl lvl and thickness 67 CALL isf_tbl_lvl( hu(:,:,Kmm), e3u(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )73 CALL isf_tbl_lvl( hu(:,:,Kmm), ze3u, ktop, ikbot, zhtbl, zfrac ) 68 74 ! 69 75 ! compute tbl property at U point 70 CALL isf_tbl_avg( miku, ikbot, zhtbl, zfrac, e3u(:,:,:,Kmm), pvarin, zvarout )76 CALL isf_tbl_avg( miku, ikbot, zhtbl, zfrac, ze3u, pvarin, zvarout ) 71 77 ! 72 78 ! compute tbl property at T point … … 82 88 zhtbl = phtbl 83 89 ! 90 DO jk = 1, jpk 91 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 92 END DO 84 93 ! compute tbl lvl and thickness 85 CALL isf_tbl_lvl( hv(:,:,Kmm), e3v(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )94 CALL isf_tbl_lvl( hv(:,:,Kmm), ze3v, ktop, ikbot, zhtbl, zfrac ) 86 95 ! 87 96 ! compute tbl property at V point 88 CALL isf_tbl_avg( mikv, ikbot, zhtbl, zfrac, e3v(:,:,:,Kmm), pvarin, zvarout )97 CALL isf_tbl_avg( mikv, ikbot, zhtbl, zfrac, ze3v, pvarin, zvarout ) 89 98 ! 90 99 ! pvarout is an averaging of wet point … … 98 107 ! 99 108 ! compute tbl property at T point 100 CALL isf_tbl_avg( ktop, kbot, phtbl, pfrac, e3t(:,:,:,Kmm), pvarin, pvarout ) 109 DO jk = 1, jpk 110 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 111 END DO 112 CALL isf_tbl_avg( ktop, kbot, phtbl, pfrac, ze3t, pvarin, pvarout ) 101 113 ! 102 114 END SELECT … … 212 224 ! phtbl need to be bounded by water column thickness before 213 225 ! test: if htbl = water column thickness, should return mbathy 214 ! test: if htbl = 0 should return ktop (phtbl cap to e3t(ji,jj,1))226 ! test: if htbl = 0 should return ktop (phtbl cap to pe3t(ji,jj,1)) 215 227 ! 216 228 ! get ktbl
Note: See TracChangeset
for help on using the changeset viewer.
