Changeset 13982 for NEMO/trunk/src/OCE/TRA/traadv_mus.F90
- Timestamp:
- 2020-12-02T11:57:05+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/TRA/traadv_mus.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/TRA/traadv_mus.F90
r13497 r13982 81 81 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 82 82 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 83 ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support) 83 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 84 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation … … 88 89 REAL(wp) :: zu, z0u, zzwx, zw , zalpha ! local scalars 89 90 REAL(wp) :: zv, z0v, zzwy, z0w ! - - 90 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zwx, zslpx ! 3D workspace91 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zwy, zslpy ! - -91 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwx, zslpx ! 3D workspace 92 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwy, zslpy ! - - 92 93 !!---------------------------------------------------------------------- 93 94 ! 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. 95 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 96 IF( kt == kit000 ) THEN 97 IF(lwp) WRITE(numout,*) 98 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 99 IF(lwp) WRITE(numout,*) ' : mixed up-stream ', ld_msc_ups 100 IF(lwp) WRITE(numout,*) '~~~~~~~' 101 IF(lwp) WRITE(numout,*) 102 ! 103 ! Upstream / MUSCL scheme indicator 104 ! 105 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 106 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 107 ! 108 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 109 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 110 upsmsk(:,:) = 0._wp ! not upstream by default 111 ! 112 DO jk = 1, jpkm1 113 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 114 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 115 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 116 END DO 117 ENDIF 118 ! 119 ENDIF 120 ! 121 l_trd = .FALSE. 122 l_hst = .FALSE. 123 l_ptr = .FALSE. 124 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 125 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 126 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 127 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 128 ENDIF 126 129 ! 127 130 DO jn = 1, kjpt !== loop over the tracers ==! … … 132 135 zwx(:,:,jpk) = 0._wp ! bottom values 133 136 zwy(:,:,jpk) = 0._wp 134 DO_3D( 1, 0, 1, 0, 1, jpkm1 )137 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 135 138 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 136 139 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 137 140 END_3D 138 141 ! lateral boundary conditions (changed sign) 139 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )142 IF ( nn_hls.EQ.1 ) CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) 140 143 ! !-- Slopes of tracer 141 144 zslpx(:,:,jpk) = 0._wp ! bottom values 142 145 zslpy(:,:,jpk) = 0._wp 143 DO_3D( 0, 1, 0, 1, 1, jpkm1 )146 DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) 144 147 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 145 148 & * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 148 151 END_3D 149 152 ! 150 DO_3D( 0, 1, 0, 1, 1, jpkm1 ) !-- Slopes limitation153 DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 ) !-- Slopes limitation 151 154 zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 152 155 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 157 160 END_3D 158 161 ! 159 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes162 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) !-- MUSCL horizontal advective fluxes 160 163 ! MUSCL fluxes 161 164 z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) … … 173 176 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 174 177 END_3D 175 CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign)178 IF ( nn_hls.EQ.1 ) CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! lateral boundary conditions (changed sign) 176 179 ! 177 180 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !-- Tracer advective trend … … 195 198 zwx(:,:, 1 ) = 0._wp ! surface & bottom boundary conditions 196 199 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 DO200 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! interior values 201 zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 202 END_3D 200 203 ! !-- Slopes of tracer 201 204 zslpx(:,:,1) = 0._wp ! surface values … … 223 226 END_2D 224 227 ELSE ! no cavities: only at the ocean surface 225 zwx(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 228 DO_2D( 1, 1, 1, 1 ) 229 zwx(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 230 END_2D 226 231 ENDIF 227 232 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
