- Timestamp:
- 2019-11-20T10:47:16+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.1_momentum_trends/src/OCE/TRD/trddyn.F90
r11715 r11934 18 18 USE sbc_oce ! surface boundary condition: ocean 19 19 USE zdf_oce ! ocean vertical physics: variables 20 !!gm USE zdfdrg ! ocean vertical physics: bottom friction21 20 USE trd_oce ! trends: ocean variables 22 21 USE trdken ! trends: Kinetic ENergy … … 35 34 PUBLIC trd_dyn ! called by all dynXXX modules 36 35 36 INTERFACE trd_dyn 37 module procedure trd_dyn_3d, trd_dyn_2d 38 END INTERFACE 39 40 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_hpg, zvtrd_hpg 41 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_pvo, zvtrd_pvo 42 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: zutrd_bfr, zvtrd_bfr 43 REAL(wp), ALLOCATABLE, DIMENSION(:,:) , SAVE :: zutrd_tau, zvtrd_tau 44 37 45 !! * Substitutions 38 46 # include "vectopt_loop_substitute.h90" … … 44 52 CONTAINS 45 53 46 SUBROUTINE trd_dyn ( putrd, pvtrd, ktrd, kt )54 SUBROUTINE trd_dyn_3d( putrd, pvtrd, ktrd, kt ) 47 55 !!--------------------------------------------------------------------- 48 !! *** ROUTINE trd_ mod ***56 !! *** ROUTINE trd_dyn_3d *** 49 57 !! 50 58 !! ** Purpose : Dispatch momentum trend computation, e.g. 3D output, … … 55 63 INTEGER , INTENT(in ) :: ktrd ! trend index 56 64 INTEGER , INTENT(in ) :: kt ! time step 65 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve ! temporary 2D arrays 66 INTEGER :: jk 57 67 !!---------------------------------------------------------------------- 58 68 ! … … 63 73 !!gm NB : here a lbc_lnk should probably be added 64 74 75 SELECT CASE( ktrd ) 76 CASE( jpdyn_hpg_save ) 77 ! 78 ! save 3D HPG trends to possibly have barotropic part corrected later before writing out 79 ALLOCATE( zutrd_hpg(jpi,jpj,jpk), zvtrd_hpg(jpi,jpj,jpk) ) 80 zutrd_hpg(:,:,:) = putrd(:,:,:) 81 zvtrd_hpg(:,:,:) = pvtrd(:,:,:) 82 83 CASE( jpdyn_pvo_save ) 84 ! 85 ! save 3D coriolis trends to possibly have barotropic part corrected later before writing out 86 ALLOCATE( zutrd_pvo(jpi,jpj,jpk), zvtrd_pvo(jpi,jpj,jpk) ) 87 zutrd_pvo(:,:,:) = putrd(:,:,:) 88 zvtrd_pvo(:,:,:) = pvtrd(:,:,:) 89 90 CASE( jpdyn_spg ) 91 ! For explicit scheme SPG trends come here as 3D fields 92 ! Add SPG trend to 3D HPG trend and also output as 2D diagnostic in own right. 93 CALL trd_dyn_iom_2d( putrd(:,:,1), pvtrd(:,:,1), jpdyn_spg, kt ) 94 putrd(:,:,:) = putrd(:,:,:) + zutrd_hpg(:,:,:) 95 pvtrd(:,:,:) = pvtrd(:,:,:) + zvtrd_hpg(:,:,:) 96 DEALLOCATE( zutrd_hpg, zvtrd_hpg ) 97 98 CASE( jpdyn_bfr ) 99 ! 100 ! Add 3D part of BFR trend minus its depth-mean part to depth-mean trend already saved. 101 ALLOCATE( zue(jpi,jpj), zve(jpi,jpj) ) 102 zue(:,:) = e3u_a(:,:,1) * putrd(:,:,1) * umask(:,:,1) 103 zve(:,:) = e3v_a(:,:,1) * pvtrd(:,:,1) * vmask(:,:,1) 104 DO jk = 2, jpkm1 105 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * putrd(:,:,jk) * umask(:,:,jk) 106 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * pvtrd(:,:,jk) * vmask(:,:,jk) 107 END DO 108 DO jk = 1, jpkm1 109 putrd(:,:,jk) = zutrd_bfr(:,:,jk) + putrd(:,:,jk) - zue(:,:) * r1_hu_a(:,:) 110 pvtrd(:,:,jk) = zvtrd_bfr(:,:,jk) + pvtrd(:,:,jk) - zve(:,:) * r1_hv_a(:,:) 111 END DO 112 ! Update locally saved BFR trends to add to ZDF trend. 113 zutrd_bfr(:,:,:) = putrd(:,:,:) 114 zvtrd_bfr(:,:,:) = pvtrd(:,:,:) 115 116 CASE( jpdyn_zdf ) 117 ! ZDF trend: Remove barotropic component and add wind stress and bottom friction 118 ! trends from dynspg_ts. Also adding on the bottom stress for the 119 ! baroclinic solution in the case of explicit bottom friction. 120 ALLOCATE( zue(jpi,jpj), zve(jpi,jpj) ) 121 zue(:,:) = e3u_a(:,:,1) * putrd(:,:,1) * umask(:,:,1) 122 zve(:,:) = e3v_a(:,:,1) * pvtrd(:,:,1) * vmask(:,:,1) 123 DO jk = 2, jpkm1 124 zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * putrd(:,:,jk) * umask(:,:,jk) 125 zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * pvtrd(:,:,jk) * vmask(:,:,jk) 126 END DO 127 DO jk = 1, jpkm1 128 putrd(:,:,jk) = zutrd_tau(:,:) + zutrd_bfr(:,:,jk) + putrd(:,:,jk) - zue(:,:) * r1_hu_a(:,:) 129 pvtrd(:,:,jk) = zutrd_tau(:,:) + zvtrd_bfr(:,:,jk) + pvtrd(:,:,jk) - zve(:,:) * r1_hv_a(:,:) 130 END DO 131 DEALLOCATE( zue, zve, zutrd_tau, zvtrd_tau, zutrd_bfr, zvtrd_bfr ) 132 133 END SELECT 134 135 IF ( ktrd /= jpdyn_hpg_save .AND. ktrd /= jpdyn_pvo_save ) THEN 136 ! 137 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 138 ! 3D output of momentum and/or tracers trends using IOM interface 139 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 140 IF( ln_dyn_trd ) CALL trd_dyn_iom_3d( putrd, pvtrd, ktrd, kt ) 141 142 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 143 ! Integral Constraints Properties for momentum and/or tracers trends 144 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 145 IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt ) 146 147 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 148 ! Kinetic Energy trends 149 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 150 IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt ) 151 152 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 153 ! Vorticity trends 154 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 155 IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt ) 156 157 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 158 ! Mixed layer trends for active tracers 159 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 160 !!gm IF( ln_dyn_mxl ) CALL trd_mxl_dyn 161 ! 162 ENDIF 163 ! 164 END SUBROUTINE trd_dyn_3d 165 166 167 SUBROUTINE trd_dyn_2d( putrd, pvtrd, ktrd, kt ) 168 !!--------------------------------------------------------------------- 169 !! *** ROUTINE trd_mod *** 170 !! 171 !! ** Purpose : Dispatch momentum trend computation, e.g. 2D output, 172 !! integral constraints, barotropic vorticity, kinetic enrgy, 173 !! and/or mixed layer budget. 174 !!---------------------------------------------------------------------- 175 REAL(wp), DIMENSION(:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends 176 INTEGER , INTENT(in ) :: ktrd ! trend index 177 INTEGER , INTENT(in ) :: kt ! time step 178 INTEGER :: jk 179 !!---------------------------------------------------------------------- 180 ! 181 putrd(:,:) = putrd(:,:) * umask(:,:,1) ! mask the trends 182 pvtrd(:,:) = pvtrd(:,:) * vmask(:,:,1) 183 ! 184 185 !!gm NB : here a lbc_lnk should probably be added 186 187 SELECT CASE(ktrd) 188 189 CASE ( jpdyn_hpg_corr ) 190 ! 191 ! Remove "first-guess" SPG trend from 3D HPG trend. 192 DO jk = 1, jpkm1 193 zutrd_hpg(:,:,jk) = zutrd_hpg(:,:,jk) - putrd(:,:) 194 zvtrd_hpg(:,:,jk) = zvtrd_hpg(:,:,jk) - pvtrd(:,:) 195 ENDDO 196 197 CASE( jpdyn_pvo_corr ) 198 ! 199 ! Remove "first-guess" barotropic coriolis trend from 3D PVO trend. 200 DO jk = 1, jpkm1 201 zutrd_pvo(:,:,jk) = zutrd_pvo(:,:,jk) - putrd(:,:) 202 zvtrd_pvo(:,:,jk) = zvtrd_pvo(:,:,jk) - pvtrd(:,:) 203 ENDDO 204 205 CASE( jpdyn_spg ) 206 ! 207 ! For split-explicit scheme SPG trends come here as 2D fields 208 ! Add SPG trend to 3D HPG trend and also output as 2D diagnostic in own right. 209 DO jk = 1, jpkm1 210 zutrd_hpg(:,:,jk) = zutrd_hpg(:,:,jk) + putrd(:,:) 211 zvtrd_hpg(:,:,jk) = zvtrd_hpg(:,:,jk) + pvtrd(:,:) 212 ENDDO 213 CALL trd_dyn_3d( zutrd_hpg, zvtrd_hpg, jpdyn_hpg, kt ) 214 DEALLOCATE( zutrd_hpg, zvtrd_hpg ) 215 216 CASE( jpdyn_pvo ) 217 ! 218 ! Add 2D PVO trend to 3D PVO trend and also output as diagnostic in own right. 219 DO jk = 1, jpkm1 220 zutrd_pvo(:,:,jk) = zutrd_pvo(:,:,jk) + putrd(:,:) 221 zvtrd_pvo(:,:,jk) = zvtrd_pvo(:,:,jk) + pvtrd(:,:) 222 ENDDO 223 CALL trd_dyn_3d( zutrd_pvo, zvtrd_pvo, jpdyn_pvo, kt ) 224 DEALLOCATE( zutrd_pvo, zvtrd_pvo ) 225 226 CASE( jpdyn_tau ) 227 ! 228 ! Save 2D wind forcing trend locally (to be added to ZDF trend) 229 ! and output as a trend in its own right. 230 ALLOCATE( zutrd_tau(jpi,jpj), zvtrd_tau(jpi,jpj) ) 231 zutrd_tau(:,:) = putrd(:,:) 232 zvtrd_tau(:,:) = pvtrd(:,:) 233 234 CASE( jpdyn_bfr ) 235 ! 236 ! Create 3D BFR trend from 2D field and also output 2D field as diagnostic in own right. 237 ALLOCATE( zutrd_bfr(jpi,jpj,jpk), zvtrd_bfr(jpi,jpj,jpk) ) 238 zutrd_bfr(:,:,:) = 0.0 239 zvtrd_bfr(:,:,:) = 0.0 240 DO jk = 1, jpkm1 241 zutrd_bfr(:,:,jk) = putrd(:,:) * umask(:,:,jk) 242 zvtrd_bfr(:,:,jk) = pvtrd(:,:) * vmask(:,:,jk) 243 ENDDO 244 245 END SELECT 246 65 247 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 66 ! 3D output of momentum and/or tracers trends using IOM interface248 ! 2D output of momentum and/or tracers trends using IOM interface 67 249 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 68 IF( ln_dyn_trd ) CALL trd_dyn_iom ( putrd, pvtrd, ktrd, kt )250 IF( ln_dyn_trd ) CALL trd_dyn_iom_2d( putrd, pvtrd, ktrd, kt ) 69 251 70 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 71 ! Integral Constraints Properties for momentum and/or tracers trends 72 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 73 IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt ) 74 75 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 76 ! Kinetic Energy trends 77 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 78 IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt ) 79 80 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 81 ! Vorticity trends 82 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 83 IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt ) 252 253 !!$ CALLS TO THESE ROUTINES FOR 2D DIAGOSTICS NOT CODED YET 254 !!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 255 !!$ ! Integral Constraints Properties for momentum and/or tracers trends 256 !!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 257 !!$ IF( ln_glo_trd ) CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt ) 258 !!$ 259 !!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 260 !!$ ! Kinetic Energy trends 261 !!$ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 262 !!$ IF( ln_KE_trd ) CALL trd_ken( putrd, pvtrd, ktrd, kt ) 263 !!$ 264 !!$ !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 265 !!$ ! Vorticity trends 266 !!$ !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 267 !!$ IF( ln_vor_trd ) CALL trd_vor( putrd, pvtrd, ktrd, kt ) 84 268 85 269 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 88 272 !!gm IF( ln_dyn_mxl ) CALL trd_mxl_dyn 89 273 ! 90 END SUBROUTINE trd_dyn 91 92 93 SUBROUTINE trd_dyn_iom ( putrd, pvtrd, ktrd, kt )274 END SUBROUTINE trd_dyn_2d 275 276 277 SUBROUTINE trd_dyn_iom_3d( putrd, pvtrd, ktrd, kt ) 94 278 !!--------------------------------------------------------------------- 95 279 !! *** ROUTINE trd_dyn_iom *** … … 110 294 CASE( jpdyn_hpg ) ; CALL iom_put( "utrd_hpg", putrd ) ! hydrostatic pressure gradient 111 295 CALL iom_put( "vtrd_hpg", pvtrd ) 112 CASE( jpdyn_spg ) ; CALL iom_put( "utrd_spg", putrd ) ! surface pressure gradient113 CALL iom_put( "vtrd_spg", pvtrd )114 296 CASE( jpdyn_pvo ) ; CALL iom_put( "utrd_pvo", putrd ) ! planetary vorticity 115 297 CALL iom_put( "vtrd_pvo", pvtrd ) … … 147 329 CALL iom_put( "vtrd_tau", z2dy ) 148 330 DEALLOCATE( z2dx , z2dy ) 149 !!gm to be changed : computation should be done in dynzdf.F90 150 !!gm + missing the top friction 151 ! ! ! bottom stress tends (implicit case) 152 ! IF( ln_drgimp ) THEN 153 ! ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) ) 154 ! z3dx(:,:,:) = 0._wp ; z3dy(:,:,:) = 0._wp ! after velocity known (now filed at this stage) 155 ! DO jk = 1, jpkm1 156 ! DO jj = 2, jpjm1 157 ! DO ji = 2, jpim1 158 ! ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 159 ! ikbv = mbkv(ji,jj) 160 ! z3dx(ji,jj,jk) = 0.5 * ( rCdU_bot(ji+1,jj) + rCdU_bot(ji,jj) ) & 161 ! & * un(ji,jj,ikbu) / e3u_n(ji,jj,ikbu) 162 ! z3dy(ji,jj,jk) = 0.5 * ( rCdU_bot(ji,jj+1) + rCdU_bot(ji,jj) ) & 163 ! & * vn(ji,jj,ikbv) / e3v_n(ji,jj,ikbv) 164 ! END DO 165 ! END DO 166 ! END DO 167 ! CALL lbc_lnk_multi( 'trddyn', z3dx, 'U', -1., z3dy, 'V', -1. ) 168 ! CALL iom_put( "utrd_bfr", z3dx ) 169 ! CALL iom_put( "vtrd_bfr", z3dy ) 170 ! DEALLOCATE( z3dx , z3dy ) 171 ! ENDIF 172 !!gm end 173 CASE( jpdyn_bfr ) ! called if ln_drgimp=F 174 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 331 CASE( jpdyn_bfr ) ; CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 175 332 CALL iom_put( "vtrd_bfr", pvtrd ) 333 CASE( jpdyn_bfri) ; CALL iom_put( "utrd_bfri", putrd ) ! bottom friction (implicit case) 334 CALL iom_put( "vtrd_bfri", pvtrd ) 176 335 CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends 177 336 CALL iom_put( "vtrd_atf", pvtrd ) 178 337 END SELECT 179 338 ! 180 END SUBROUTINE trd_dyn_iom 339 END SUBROUTINE trd_dyn_iom_3d 340 341 342 SUBROUTINE trd_dyn_iom_2d( putrd, pvtrd, ktrd, kt ) 343 !!--------------------------------------------------------------------- 344 !! *** ROUTINE trd_dyn_iom *** 345 !! 346 !! ** Purpose : output 2D trends using IOM 347 !!---------------------------------------------------------------------- 348 REAL(wp), DIMENSION(:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends 349 INTEGER , INTENT(in ) :: ktrd ! trend index 350 INTEGER , INTENT(in ) :: kt ! time step 351 ! 352 INTEGER :: ji, jj, jk ! dummy loop indices 353 INTEGER :: ikbu, ikbv ! local integers 354 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 355 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace 356 !!---------------------------------------------------------------------- 357 ! 358 SELECT CASE( ktrd ) 359 CASE( jpdyn_spg ) ; CALL iom_put( "utrd_spg2d", putrd ) ! surface pressure gradient 360 CALL iom_put( "vtrd_spg2d", pvtrd ) 361 CASE( jpdyn_pvo ) ; CALL iom_put( "utrd_pvo2d", putrd ) ! planetary vorticity (barotropic part) 362 CALL iom_put( "vtrd_pvo2d", pvtrd ) 363 CASE( jpdyn_hpg_corr ) ; CALL iom_put( "utrd_hpg_corr", putrd ) ! horizontal pressure gradient correction 364 CALL iom_put( "vtrd_hpg_corr", pvtrd ) 365 CASE( jpdyn_pvo_corr ) ; CALL iom_put( "utrd_pvo_corr", putrd ) ! planetary vorticity correction 366 CALL iom_put( "vtrd_pvo_corr", pvtrd ) 367 CASE( jpdyn_bfr ) ; CALL iom_put( "utrd_bfr2d", putrd ) ! bottom friction due to barotropic currents 368 CALL iom_put( "vtrd_bfr2d", pvtrd ) 369 END SELECT 370 ! 371 END SUBROUTINE trd_dyn_iom_2d 181 372 182 373 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.