Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv_mus.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/traadv_mus.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/TRA/traadv_mus.F90
r13497 r14789 29 29 USE in_out_manager ! I/O manager 30 30 USE lib_mpp ! distribued memory computing 31 USE lbclnk ! ocean lateral boundary condition (or mpp link) 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 31 USE lbclnk ! ocean lateral boundary condition (or mpp link) 32 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 33 34 34 IMPLICIT NONE … … 36 36 37 37 PUBLIC tra_adv_mus ! routine called by traadv.F90 38 38 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 40 40 ! ! and in closed seas (orca 2 and 1 configurations) 41 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind !: mixed upstream/centered index 42 42 43 43 LOGICAL :: l_trd ! flag to compute trends 44 44 LOGICAL :: l_ptr ! flag to compute poleward transport … … 50 50 !!---------------------------------------------------------------------- 51 51 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 52 !! $Id$ 52 !! $Id$ 53 53 !! Software governed by the CeCILL license (see ./LICENSE) 54 54 !!---------------------------------------------------------------------- … … 65 65 !! 66 66 !! ** Method : MUSCL scheme plus centered scheme at ocean boundaries 67 !! ld_msc_ups=T : 67 !! ld_msc_ups=T : 68 68 !! 69 69 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends … … 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 ==! … … 131 134 ! !-- first guess of the slopes 132 135 zwx(:,:,jpk) = 0._wp ! bottom values 133 zwy(:,:,jpk) = 0._wp 134 DO_3D( 1, 0, 1, 0, 1, jpkm1 )136 zwy(:,:,jpk) = 0._wp 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( '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( '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 … … 185 188 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) ) 186 189 END IF 187 ! ! "Poleward" heat and salt transports 190 ! ! "Poleward" heat and salt transports 188 191 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 189 192 ! ! heat transport … … 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.
