- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdglo.F90
r10425 r11949 59 59 CONTAINS 60 60 61 SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt )61 SUBROUTINE trd_glo( ptrdx, ptrdy, ktrd, ctype, kt, Kmm ) 62 62 !!--------------------------------------------------------------------- 63 63 !! *** ROUTINE trd_glo *** … … 72 72 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type (='DYN'/'TRA') 73 73 INTEGER , INTENT(in ) :: kt ! time step 74 INTEGER , INTENT(in ) :: Kmm ! time level index 74 75 !! 75 76 INTEGER :: ji, jj, jk ! dummy loop indices … … 87 88 DO jj = 1, jpj 88 89 DO ji = 1, jpi 89 zvm = e1e2t(ji,jj) * e3t _n(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)90 zvm = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) * tmask_i(ji,jj) 90 91 zvt = ptrdx(ji,jj,jk) * zvm 91 92 zvs = ptrdy(ji,jj,jk) * zvm 92 93 tmo(ktrd) = tmo(ktrd) + zvt 93 94 smo(ktrd) = smo(ktrd) + zvs 94 t2 (ktrd) = t2(ktrd) + zvt * ts n(ji,jj,jk,jp_tem)95 s2 (ktrd) = s2(ktrd) + zvs * ts n(ji,jj,jk,jp_sal)95 t2 (ktrd) = t2(ktrd) + zvt * ts(ji,jj,jk,jp_tem,Kmm) 96 s2 (ktrd) = s2(ktrd) + zvs * ts(ji,jj,jk,jp_sal,Kmm) 96 97 END DO 97 98 END DO … … 99 100 ! ! linear free surface: diagnose advective flux trough the fixed k=1 w-surface 100 101 IF( ln_linssh .AND. ktrd == jptra_zad ) THEN 101 tmo(jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) )102 smo(jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:) )103 t2 (jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) * e1e2t(:,:) * tmask_i(:,:) )104 s2 (jptra_sad) = SUM( w n(:,:,1) * tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) * e1e2t(:,:) * tmask_i(:,:) )102 tmo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 103 smo(jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 104 t2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) * ts(:,:,1,jp_tem,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 105 s2 (jptra_sad) = SUM( ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) * ts(:,:,1,jp_sal,Kmm) * e1e2t(:,:) * tmask_i(:,:) ) 105 106 ENDIF 106 107 ! … … 121 122 DO ji = 1, jpim1 122 123 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 123 & * e1e2u (ji,jj) * e3u _n(ji,jj,jk)124 & * e1e2u (ji,jj) * e3u(ji,jj,jk,Kmm) 124 125 zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 125 & * e1e2v (ji,jj) * e3u _n(ji,jj,jk)126 & * e1e2v (ji,jj) * e3u(ji,jj,jk,Kmm) 126 127 umo(ktrd) = umo(ktrd) + zvt 127 128 vmo(ktrd) = vmo(ktrd) + zvs 128 hke(ktrd) = hke(ktrd) + u n(ji,jj,jk) * zvt + vn(ji,jj,jk) * zvs129 hke(ktrd) = hke(ktrd) + uu(ji,jj,jk,Kmm) * zvt + vv(ji,jj,jk,Kmm) * zvs 129 130 END DO 130 131 END DO … … 141 142 umo(jpdyn_tau) = umo(jpdyn_tau) + zvt 142 143 vmo(jpdyn_tau) = vmo(jpdyn_tau) + zvs 143 hke(jpdyn_tau) = hke(jpdyn_tau) + u n(ji,jj,1) * zvt + vn(ji,jj,1) * zvs144 hke(jpdyn_tau) = hke(jpdyn_tau) + uu(ji,jj,1,Kmm) * zvt + vv(ji,jj,1,Kmm) * zvs 144 145 END DO 145 146 END DO … … 155 156 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 156 157 ! ikbv = mbkv(ji,jj) 157 ! zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * u n(ji,jj,ikbu) * e1e2u(ji,jj)158 ! zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * v n(ji,jj,ikbv) * e1e2v(ji,jj)158 ! zvt = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu(ji,jj,ikbu,Kmm) * e1e2u(ji,jj) 159 ! zvs = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv(ji,jj,ikbv,Kmm) * e1e2v(ji,jj) 159 160 ! umo(jpdyn_bfri) = umo(jpdyn_bfri) + zvt 160 161 ! vmo(jpdyn_bfri) = vmo(jpdyn_bfri) + zvs 161 ! hke(jpdyn_bfri) = hke(jpdyn_bfri) + u n(ji,jj,ikbu) * zvt + vn(ji,jj,ikbv) * zvs162 ! hke(jpdyn_bfri) = hke(jpdyn_bfri) + uu(ji,jj,ikbu,Kmm) * zvt + vv(ji,jj,ikbv,Kmm) * zvs 162 163 ! END DO 163 164 ! END DO … … 183 184 184 185 185 SUBROUTINE glo_dyn_wri( kt )186 SUBROUTINE glo_dyn_wri( kt, Kmm ) 186 187 !!--------------------------------------------------------------------- 187 188 !! *** ROUTINE glo_dyn_wri *** … … 190 191 !!---------------------------------------------------------------------- 191 192 INTEGER, INTENT(in) :: kt ! ocean time-step index 193 INTEGER, INTENT(in) :: Kmm ! time level index 192 194 ! 193 195 INTEGER :: ji, jj, jk ! dummy loop indices … … 209 211 zkepe(:,:,:) = 0._wp 210 212 211 CALL eos( ts n, rhd, rhop ) ! now potential density213 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop ) ! now potential density 212 214 213 215 zcof = 0.5_wp / rau0 ! Density flux at w-point 214 216 zkz(:,:,1) = 0._wp 215 217 DO jk = 2, jpk 216 zkz(:,:,jk) = zcof * e1e2t(:,:) * w n(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:)218 zkz(:,:,jk) = zcof * e1e2t(:,:) * ww(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) * tmask_i(:,:) 217 219 END DO 218 220 … … 221 223 DO jj = 1, jpjm1 222 224 DO ji = 1, jpim1 223 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u _n(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )224 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v _n(ji,jj,jk) * vn(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )225 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 226 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 225 227 END DO 226 228 END DO … … 233 235 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & 234 236 & + zky(ji,jj,jk) - zky(ji ,jj-1,jk ) ) & 235 & / ( e1e2t(ji,jj) * e3t _n(ji,jj,jk) ) * tmask(ji,jj,jk) * tmask_i(ji,jj)237 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 236 238 END DO 237 239 END DO … … 242 244 peke = 0._wp 243 245 DO jk = 1, jpkm1 244 peke = peke + SUM( zkepe(:,:,jk) * gdept _n(:,:,jk) * e1e2t(:,:) * e3t_n(:,:,jk) )246 peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) ) 245 247 END DO 246 248 peke = grav * peke … … 506 508 507 509 508 SUBROUTINE trd_glo_init 510 SUBROUTINE trd_glo_init( Kmm ) 509 511 !!--------------------------------------------------------------------- 510 512 !! *** ROUTINE trd_glo_init *** … … 512 514 !! ** Purpose : Read the namtrd namelist 513 515 !!---------------------------------------------------------------------- 516 INTEGER, INTENT(in) :: Kmm ! time level index 514 517 INTEGER :: ji, jj, jk ! dummy loop indices 515 518 !!---------------------------------------------------------------------- … … 524 527 tvolt = 0._wp 525 528 DO jk = 1, jpkm1 526 tvolt = tvolt + SUM( e1e2t(:,:) * e3t _n(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) )529 tvolt = tvolt + SUM( e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) * tmask_i(:,:) ) 527 530 END DO 528 531 CALL mpp_sum( 'trdglo', tvolt ) ! sum over the global domain … … 541 544 DO jj = 2, jpjm1 542 545 DO ji = fs_2, fs_jpim1 ! vector opt. 543 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u _n(ji,jj,jk) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk)544 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v _n(ji,jj,jk) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)546 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 547 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 545 548 END DO 546 549 END DO
Note: See TracChangeset
for help on using the changeset viewer.