- Timestamp:
- 2020-09-24T20:38:10+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_mus.F90
r13295 r13516 19 19 USE trc_oce ! share passive tracers/Ocean variables 20 20 USE dom_oce ! ocean space and time domain 21 ! TEMP: This change not necessary after trd_tra is tiled 22 USE domain, ONLY : dom_tile 21 23 USE trd_oce ! trends: ocean variables 22 24 USE trdtra ! tracers trends manager … … 81 83 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 82 84 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 85 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 83 86 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 84 87 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 85 88 ! 89 ! TEMP: This change not necessary after trd_tra is tiled 90 INTEGER :: itile 86 91 INTEGER :: ji, jj, jk, jn ! dummy loop indices 87 92 INTEGER :: ierr ! local integer 88 93 REAL(wp) :: zu, z0u, zzwx, zw , zalpha ! local scalars 89 94 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 90 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zslpx ! 3D workspace 91 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwy, zslpy ! - - 95 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwx, zslpx ! 3D workspace 96 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwy, zslpy ! - - 97 ! TEMP: This change not necessary after trd_tra is tiled 98 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdx, ztrdy, ztrdz 92 99 !!---------------------------------------------------------------------- 93 ! 94 IF( kt == kit000 ) THEN 95 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 97 IF(lwp) WRITE(numout,*) ' : mixed up-stream ', ld_msc_ups 98 IF(lwp) WRITE(numout,*) '~~~~~~~' 99 IF(lwp) WRITE(numout,*) 100 ! 101 ! Upstream / MUSCL scheme indicator 102 ! 103 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 104 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 105 ! 106 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 107 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 108 upsmsk(:,:) = 0._wp ! not upstream by default 109 ! 110 DO jk = 1, jpkm1 111 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 112 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 113 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 114 END DO 115 ENDIF 116 ! 117 ENDIF 118 ! 119 l_trd = .FALSE. 120 l_hst = .FALSE. 121 l_ptr = .FALSE. 122 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 123 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 124 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 125 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 100 ! TEMP: This change not necessary after trd_tra is tiled 101 itile = ntile 102 ! 103 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 104 IF( kt == kit000 ) THEN 105 IF(lwp) WRITE(numout,*) 106 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 107 IF(lwp) WRITE(numout,*) ' : mixed up-stream ', ld_msc_ups 108 IF(lwp) WRITE(numout,*) '~~~~~~~' 109 IF(lwp) WRITE(numout,*) 110 ! 111 ! Upstream / MUSCL scheme indicator 112 ! 113 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 114 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 115 ! 116 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 117 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 118 upsmsk(:,:) = 0._wp ! not upstream by default 119 ! 120 DO jk = 1, jpkm1 121 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 122 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 123 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 124 END DO 125 ENDIF 126 ! 127 ENDIF 128 ! 129 l_trd = .FALSE. 130 l_hst = .FALSE. 131 l_ptr = .FALSE. 132 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 133 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 134 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 135 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 136 137 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 138 IF( kt == kit000 .AND. l_trd ) THEN 139 ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 140 ENDIF 141 ENDIF 126 142 ! 127 143 DO jn = 1, kjpt !== loop over the tracers ==! … … 181 197 END_3D 182 198 ! ! trend diagnostics 199 ! TEMP: These changes not necessary after trd_tra is tiled 183 200 IF( l_trd ) THEN 184 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kbb) ) 185 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) ) 201 DO_3D( 1, 0, 1, 0, 1, jpk ) 202 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 203 ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 204 END_3D 205 206 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 207 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 208 209 ! TODO: TO BE TILED- trd_tra 210 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kbb) ) 211 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kbb) ) 212 213 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 214 ENDIF 186 215 END IF 187 216 ! ! "Poleward" heat and salt transports … … 195 224 zwx(:,:, 1 ) = 0._wp ! surface & bottom boundary conditions 196 225 zwx(:,:,jpk) = 0._wp 197 DO jk = 2, jpkm1! interior values198 zwx( :,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn,Kbb) - pt(:,:,jk,jn,Kbb) )199 END DO226 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! interior values 227 zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 228 END_3D 200 229 ! !-- Slopes of tracer 201 230 zslpx(:,:,1) = 0._wp ! surface values … … 218 247 END_3D 219 248 IF( ln_linssh ) THEN ! top values, linear free surface only 249 ! TODO: NOT TESTED- requires isf 220 250 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 221 251 DO_2D( 1, 1, 1, 1 ) … … 223 253 END_2D 224 254 ELSE ! no cavities: only at the ocean surface 225 zwx(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 255 DO_2D( 1, 1, 1, 1 ) 256 zwx(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 257 END_2D 226 258 ENDIF 227 259 ENDIF … … 232 264 END_3D 233 265 ! ! send trends for diagnostic 234 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwx, pW, pt(:,:,:,jn,Kbb) ) 266 ! TEMP: These changes not necessary after trd_tra is tiled 267 IF( l_trd ) THEN 268 DO_3D( 0, 0, 0, 0, 1, jpk ) 269 ztrdz(ji,jj,jk) = zwx(ji,jj,jk) 270 END_3D 271 272 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 273 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 274 275 ! TODO: TO BE TILED- trd_tra 276 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kbb) ) 277 278 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 279 ENDIF 280 ENDIF 235 281 ! 236 282 END DO ! end of tracer loop
Note: See TracChangeset
for help on using the changeset viewer.