- Timestamp:
- 2020-03-23T13:14:40+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA
- Files:
-
- 2 edited
-
traadv.F90 (modified) (2 diffs)
-
traadv_mus.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv.F90
r12489 r12586 83 83 INTEGER , INTENT(in) :: kt ! ocean time-step index 84 84 INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 85 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation85 REAL(wp), POINTER, DIMENSION(:,:,:,:,:) , INTENT(inout) :: pts ! active tracers and RHS of tracer equation 86 86 ! 87 87 INTEGER :: jk ! dummy loop index 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! 3D workspace88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zuu, zvv, zww ! 3D workspace 89 89 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 90 90 !!---------------------------------------------------------------------- 91 91 ! 92 92 IF( ln_timing ) CALL timing_start('tra_adv') 93 ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 93 94 ! 94 95 ! !== effective transport ==! … … 167 168 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 168 169 ! 170 DEALLOCATE( zuu, zvv, zww ) 169 171 IF( ln_timing ) CALL timing_stop( 'tra_adv' ) 170 172 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_mus.F90
r12377 r12586 31 31 USE lbclnk ! ocean lateral boundary condition (or mpp link) 32 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 USE halo_mng 33 34 34 35 IMPLICIT NONE … … 37 38 PUBLIC tra_adv_mus ! routine called by traadv.F90 38 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits40 REAL(wp), POINTER, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 40 41 ! ! and in closed seas (orca 2 and 1 configurations) 41 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind !: mixed upstream/centered index … … 44 45 LOGICAL :: l_ptr ! flag to compute poleward transport 45 46 LOGICAL :: l_hst ! flag to compute heat/salt transport 47 48 INTEGER :: jphls = 2 46 49 47 50 !! * Substitutions … … 80 83 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 81 84 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 82 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components83 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation85 REAL(wp), POINTER, DIMENSION(:,:,: ) , INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 86 REAL(wp), POINTER, DIMENSION(:,:,:,:,:) , INTENT(inout) :: pt ! tracers and RHS of tracer equation 84 87 ! 85 88 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 87 90 REAL(wp) :: zu, z0u, zzwx, zw , zalpha ! local scalars 88 91 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zslpx ! 3D workspace90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwy, zslpy ! - -92 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwx, zslpx ! 3D workspace 93 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwy, zslpy ! - - 91 94 !!---------------------------------------------------------------------- 92 95 ! 96 CALL halo_mng_set(jphls) 97 98 ALLOCATE(zwx(jplbi:jpi,jplbj:jpj,jpk)) 99 ALLOCATE(zwy(jplbi:jpi,jplbj:jpj,jpk)) 100 ALLOCATE(zslpx(jplbi:jpi,jplbj:jpj,jpk)) 101 ALLOCATE(zslpy(jplbi:jpi,jplbj:jpj,jpk)) 102 103 CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 104 CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 105 CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 106 CALL halo_mng_resize(tmask,'T', 1._wp) 107 CALL halo_mng_resize(wmask, 'W', 1._wp) 108 CALL halo_mng_resize(umask, 'U', 1._wp) 109 CALL halo_mng_resize(vmask, 'V', 1._wp) 110 CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 111 CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 112 CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 113 CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm ) 114 CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 115 CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 116 CALL halo_mng_resize(pU, 'U', 1._wp) 117 CALL halo_mng_resize(pV, 'V', 1._wp) 118 CALL halo_mng_resize(pW, 'W', 1._wp) 119 ! 120 IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 121 IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 122 IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 123 93 124 IF( kt == kit000 ) THEN 94 125 IF(lwp) WRITE(numout,*) … … 100 131 ! Upstream / MUSCL scheme indicator 101 132 ! 102 ALLOCATE( xind(jp i,jpj,jpk), STAT=ierr )133 ALLOCATE( xind(jplbi:jpi,jplbj:jpj,jpk), STAT=ierr ) 103 134 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 104 135 ! 105 136 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 106 ALLOCATE( upsmsk(jp i,jpj), STAT=ierr )137 ALLOCATE( upsmsk(jplbi:jpi,jplbj:jpj), STAT=ierr ) 107 138 upsmsk(:,:) = 0._wp ! not upstream by default 108 139 ! … … 115 146 ! 116 147 ENDIF 117 ! 148 118 149 l_trd = .FALSE. 119 150 l_hst = .FALSE. … … 131 162 zwx(:,:,jpk) = 0._wp ! bottom values 132 163 zwy(:,:,jpk) = 0._wp 133 DO_3D_ 10_10( 1, jpkm1 )164 DO_3D_20_20( 1, jpkm1 ) 134 165 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 135 166 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 136 167 END_3D 137 168 ! lateral boundary conditions (changed sign) 138 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) 169 CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1. ) ! lateral boundary conditions (changed sign) 170 CALL lbc_lnk( 'traadv_mus', zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 139 171 ! !-- Slopes of tracer 140 172 zslpx(:,:,jpk) = 0._wp ! bottom values 141 173 zslpy(:,:,jpk) = 0._wp 142 DO_3D_ 01_01( 1, jpkm1 )174 DO_3D_31_31( 1, jpkm1 ) 143 175 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 144 176 & * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 147 179 END_3D 148 180 ! 149 DO_3D_ 01_01( 1, jpkm1 )181 DO_3D_31_31( 1, jpkm1 ) 150 182 zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 151 183 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 156 188 END_3D 157 189 ! 158 DO_3D_ 00_00( 1, jpkm1 )190 DO_3D_30_30( 1, jpkm1 ) 159 191 ! MUSCL fluxes 160 192 z0u = SIGN( 0.5, pU(ji,jj,jk) ) … … 172 204 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 173 205 END_3D 174 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 175 ! 176 DO_3D_00_00( 1, jpkm1 ) 206 CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1. ) ! lateral boundary conditions (changed sign) 207 CALL lbc_lnk( 'traadv_mus', zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 208 ! 209 DO_3D_30_30( 1, jpkm1 ) 177 210 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 178 211 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & … … 199 232 ! !-- Slopes of tracer 200 233 zslpx(:,:,1) = 0._wp ! surface values 201 DO_3D_ 11_11( 2, jpkm1 )234 DO_3D_21_21( 2, jpkm1 ) 202 235 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) ) & 203 236 & * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) 204 237 END_3D 205 DO_3D_ 11_11( 2, jpkm1 )238 DO_3D_21_21( 2, jpkm1 ) 206 239 zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji,jj,jk ) ), & 207 240 & 2.*ABS( zwx (ji,jj,jk+1) ), & 208 241 & 2.*ABS( zwx (ji,jj,jk ) ) ) 209 242 END_3D 210 DO_3D_ 00_00( 1, jpk-2 )243 DO_3D_30_30( 1, jpk-2 ) 211 244 z0w = SIGN( 0.5, pW(ji,jj,jk+1) ) 212 245 zalpha = 0.5 + z0w … … 218 251 IF( ln_linssh ) THEN ! top values, linear free surface only 219 252 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 220 DO_2D_ 11_11253 DO_2D_21_21 221 254 zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 222 255 END_2D … … 226 259 ENDIF 227 260 ! 228 DO_3D_ 00_00( 1, jpkm1 )261 DO_3D_30_30( 1, jpkm1 ) 229 262 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 230 263 END_3D … … 234 267 END DO ! end of tracer loop 235 268 ! 269 DEALLOCATE(zwx,zwy) 270 DEALLOCATE(zslpx,zslpy) 271 272 CALL halo_mng_set(1) 273 274 CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 275 CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 276 CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 277 CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 278 CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 279 CALL halo_mng_resize(tmask,'T', 1._wp) 280 CALL halo_mng_resize(wmask, 'W', 1._wp) 281 CALL halo_mng_resize(umask, 'U', 1._wp) 282 CALL halo_mng_resize(vmask, 'V', 1._wp) 283 CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 284 CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm) 285 CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 286 CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 287 CALL halo_mng_resize(pU, 'U', 1._wp) 288 CALL halo_mng_resize(pV, 'V', 1._wp) 289 CALL halo_mng_resize(pW, 'W', 1._wp) 290 291 IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 292 IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 293 IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 294 236 295 END SUBROUTINE tra_adv_mus 237 296
Note: See TracChangeset
for help on using the changeset viewer.
