- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRD/trdvor.F90 (modified) (31 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRD/trdvor.F90
r10425 r13463 46 46 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avr ! average 47 47 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrb ! before vorticity (kt-1) 48 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbb ! vorticity at begining of the n write-1 timestep averaging period48 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbb ! vorticity at begining of the nn_write-1 timestep averaging period 49 49 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbn ! after vorticity at time step after the 50 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the N WRITE-1 timesteps50 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the NN_WRITE-1 timesteps 51 51 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrtot ! 52 52 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrres ! … … 56 56 57 57 !! * Substitutions 58 # include "vectopt_loop_substitute.h90" 58 # include "do_loop_substitute.h90" 59 # include "domzgr_substitute.h90" 59 60 !!---------------------------------------------------------------------- 60 61 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 78 79 79 80 80 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt )81 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt, Kmm ) 81 82 !!---------------------------------------------------------------------- 82 83 !! *** ROUTINE trd_vor *** … … 88 89 INTEGER , INTENT(in ) :: ktrd ! trend index 89 90 INTEGER , INTENT(in ) :: kt ! time step 91 INTEGER , INTENT(in ) :: Kmm ! time level index 90 92 ! 91 93 INTEGER :: ji, jj ! dummy loop indices … … 94 96 95 97 SELECT CASE( ktrd ) 96 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg ) ! Hydrostatique Pressure Gradient97 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg ) ! KE Gradient98 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo ) ! Relative Vorticity99 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo ) ! Planetary Vorticity Term100 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf ) ! Horizontal Diffusion101 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad ) ! Vertical Advection102 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg ) ! Surface Pressure Grad.98 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg, Kmm ) ! Hydrostatique Pressure Gradient 99 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg, Kmm ) ! KE Gradient 100 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo, Kmm ) ! Relative Vorticity 101 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo, Kmm ) ! Planetary Vorticity Term 102 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf, Kmm ) ! Horizontal Diffusion 103 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad, Kmm ) ! Vertical Advection 104 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg, Kmm ) ! Surface Pressure Grad. 103 105 CASE( jpdyn_zdf ) ! Vertical Diffusion 104 106 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 105 DO jj = 2, jpjm1 ! wind stress trends 106 DO ji = fs_2, fs_jpim1 ! vector opt. 107 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 ) 108 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 ) 109 END DO 110 END DO 111 ! 112 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf ) ! zdf trend including surf./bot. stresses 113 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf ) ! surface wind stress 107 DO_2D( 0, 0, 0, 0 ) 108 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u(ji,jj,1,Kmm) * rho0 ) 109 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v(ji,jj,1,Kmm) * rho0 ) 110 END_2D 111 ! 112 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf, Kmm ) ! zdf trend including surf./bot. stresses 113 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf, Kmm ) ! surface wind stress 114 114 CASE( jpdyn_bfr ) 115 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr ) ! Bottom stress115 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr, Kmm ) ! Bottom stress 116 116 ! 117 117 CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends 118 CALL trd_vor_iom( kt )118 CALL trd_vor_iom( kt, Kmm ) 119 119 END SELECT 120 120 ! … … 122 122 123 123 124 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )124 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd, Kmm ) 125 125 !!---------------------------------------------------------------------------- 126 126 !! *** ROUTINE trd_vor_zint *** … … 129 129 !! from ocean surface down to control surface (NetCDF output) 130 130 !! 131 !! ** Method/usage : integration done over n write-1 time steps131 !! ** Method/usage : integration done over nn_write-1 time steps 132 132 !! 133 133 !! ** Action : trends : … … 143 143 !! vortrd (,,10) = forcing term 144 144 !! vortrd (,,11) = bottom friction term 145 !! rotot(,) : total cumulative trends over n write-1 time steps145 !! rotot(,) : total cumulative trends over nn_write-1 time steps 146 146 !! vor_avrtot(,) : first membre of vrticity equation 147 147 !! vor_avrres(,) : residual = dh/dt entrainment … … 150 150 !!---------------------------------------------------------------------- 151 151 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 152 INTEGER , INTENT(in ) :: Kmm ! time level index 152 153 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend 153 154 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvtrdvor ! v vorticity trend … … 161 162 162 163 zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp ! Initialisation 163 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1.) ! lateral boundary condition164 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) ! lateral boundary condition 164 165 165 166 … … 171 172 ! 172 173 CASE( jpvor_bfr ) ! bottom friction 173 DO jj = 2, jpjm1 174 DO ji = fs_2, fs_jpim1 175 ikbu = mbkv(ji,jj) 176 ikbv = mbkv(ji,jj) 177 zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 178 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 179 END DO 180 END DO 174 DO_2D( 0, 0, 0, 0 ) 175 ikbu = mbkv(ji,jj) 176 ikbv = mbkv(ji,jj) 177 zudpvor(ji,jj) = putrdvor(ji,jj) * e3u(ji,jj,ikbu,Kmm) * e1u(ji,jj) * umask(ji,jj,ikbu) 178 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v(ji,jj,ikbv,Kmm) * e2v(ji,jj) * vmask(ji,jj,ikbv) 179 END_2D 181 180 ! 182 181 CASE( jpvor_swf ) ! wind stress 183 zudpvor(:,:) = putrdvor(:,:) * e3u _n(:,:,1) * e1u(:,:) * umask(:,:,1)184 zvdpvor(:,:) = pvtrdvor(:,:) * e3v _n(:,:,1) * e2v(:,:) * vmask(:,:,1)182 zudpvor(:,:) = putrdvor(:,:) * e3u(:,:,1,Kmm) * e1u(:,:) * umask(:,:,1) 183 zvdpvor(:,:) = pvtrdvor(:,:) * e3v(:,:,1,Kmm) * e2v(:,:) * vmask(:,:,1) 185 184 ! 186 185 END SELECT 187 186 188 187 ! Average except for Beta.V 189 zudpvor(:,:) = zudpvor(:,:) * r1_hu _n(:,:)190 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv _n(:,:)188 zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 189 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 191 190 192 191 ! Curl … … 194 193 DO jj = 1, jpjm1 195 194 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 196 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 195 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 196 & / ( e1f(ji,jj) * e2f(ji,jj) ) 197 197 END DO 198 198 END DO … … 207 207 208 208 209 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )209 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd , Kmm ) 210 210 !!---------------------------------------------------------------------------- 211 211 !! *** ROUTINE trd_vor_zint *** … … 214 214 !! from ocean surface down to control surface (NetCDF output) 215 215 !! 216 !! ** Method/usage : integration done over n write-1 time steps216 !! ** Method/usage : integration done over nn_write-1 time steps 217 217 !! 218 218 !! ** Action : trends : … … 228 228 !! vortrd (,,10) = forcing term 229 229 !! vortrd (,,11) = bottom friction term 230 !! rotot(,) : total cumulative trends over n write-1 time steps230 !! rotot(,) : total cumulative trends over nn_write-1 time steps 231 231 !! vor_avrtot(,) : first membre of vrticity equation 232 232 !! vor_avrres(,) : residual = dh/dt entrainment … … 236 236 ! 237 237 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 238 INTEGER , INTENT(in ) :: Kmm ! time level index 238 239 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: putrdvor ! u vorticity trend 239 240 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvtrdvor ! v vorticity trend … … 250 251 zvdpvor(:,:) = 0._wp 251 252 ! ! lateral boundary condition on input momentum trends 252 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1. , pvtrdvor, 'V', -1.)253 CALL lbc_lnk_multi( 'trdvor', putrdvor, 'U', -1.0_wp , pvtrdvor, 'V', -1.0_wp ) 253 254 254 255 ! ===================================== … … 257 258 ! putrdvor and pvtrdvor terms 258 259 DO jk = 1,jpk 259 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u _n(:,:,jk) * e1u(:,:) * umask(:,:,jk)260 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v _n(:,:,jk) * e2v(:,:) * vmask(:,:,jk)260 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u(:,:,jk,Kmm) * e1u(:,:) * umask(:,:,jk) 261 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v(:,:,jk,Kmm) * e2v(:,:) * vmask(:,:,jk) 261 262 END DO 262 263 … … 269 270 DO jj = 1, jpjm1 270 271 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 271 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 272 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) & 273 & / ( e1f(ji,jj) * e2f(ji,jj) ) 272 274 END DO 273 275 END DO 274 276 ! Average of the Curl and Surface mask 275 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu _n(:,:) * fmask(:,:,1)277 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 276 278 ENDIF 277 279 ! 278 280 ! Average 279 zudpvor(:,:) = zudpvor(:,:) * r1_hu _n(:,:)280 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv _n(:,:)281 zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 282 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 281 283 ! 282 284 ! Curl … … 284 286 DO jj=1,jpjm1 285 287 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 286 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 288 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 289 & / ( e1f(ji,jj) * e2f(ji,jj) ) 287 290 END DO 288 291 END DO … … 298 301 299 302 300 SUBROUTINE trd_vor_iom( kt )303 SUBROUTINE trd_vor_iom( kt , Kmm ) 301 304 !!---------------------------------------------------------------------- 302 305 !! *** ROUTINE trd_vor *** … … 306 309 !!---------------------------------------------------------------------- 307 310 INTEGER , INTENT(in ) :: kt ! time step 311 INTEGER , INTENT(in ) :: Kmm ! time level index 308 312 ! 309 313 INTEGER :: ji, jj, jk, jl ! dummy loop indices 310 314 INTEGER :: it, itmod ! local integers 311 315 REAL(wp) :: zmean ! local scalars 312 REAL(wp), DIMENSION(jpi,jpj) :: zu n, zvn316 REAL(wp), DIMENSION(jpi,jpj) :: zuu, zvv 313 317 !!---------------------------------------------------------------------- 314 318 … … 327 331 328 332 vor_avr (:,:) = 0._wp 329 zu n(:,:) = 0._wp330 zv n(:,:) = 0._wp333 zuu (:,:) = 0._wp 334 zvv (:,:) = 0._wp 331 335 vor_avrtot(:,:) = 0._wp 332 336 vor_avrres(:,:) = 0._wp … … 334 338 ! Vertically averaged velocity 335 339 DO jk = 1, jpk - 1 336 zu n(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk)337 zv n(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk)340 zuu(:,:) = zuu(:,:) + e1u(:,:) * uu(:,:,jk,Kmm) * e3u(:,:,jk,Kmm) 341 zvv(:,:) = zvv(:,:) + e2v(:,:) * vv(:,:,jk,Kmm) * e3v(:,:,jk,Kmm) 338 342 END DO 339 343 340 zu n(:,:) = zun(:,:) * r1_hu_n(:,:)341 zv n(:,:) = zvn(:,:) * r1_hv_n(:,:)344 zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm) 345 zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm) 342 346 343 347 ! Curl 344 348 DO ji = 1, jpim1 345 349 DO jj = 1, jpjm1 346 vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 347 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 350 vor_avr(ji,jj) = ( ( zvv(ji+1,jj) - zvv(ji,jj) ) & 351 & - ( zuu(ji,jj+1) - zuu(ji,jj) ) ) & 352 & / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 348 353 END DO 349 354 END DO … … 360 365 ENDIF 361 366 362 ! II.2 cumulated trends over analysis period (kt=2 to n write)367 ! II.2 cumulated trends over analysis period (kt=2 to nn_write) 363 368 ! ---------------------- 364 ! trends cumulated over n write-2 time steps369 ! trends cumulated over nn_write-2 time steps 365 370 366 371 IF( kt >= nit000+2 ) THEN … … 376 381 ! III. Output in netCDF + residual computation 377 382 ! ============================================= 378 383 379 384 ! define time axis 380 385 it = kt … … 385 390 ! III.1 compute total trend 386 391 ! ------------------------ 387 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * r dt )392 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rn_Dt ) 388 393 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 389 394 … … 395 400 396 401 ! Boundary conditions 397 CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1. , vor_avrres, 'F', 1.)402 CALL lbc_lnk_multi( 'trdvor', vor_avrtot, 'F', 1.0_wp , vor_avrres, 'F', 1.0_wp ) 398 403 399 404 … … 504 509 ENDIF 505 510 #if defined key_diainstant 506 zsto = n write*rdt511 zsto = nn_write*rn_Dt 507 512 clop = "inst("//TRIM(clop)//")" 508 513 #else 509 zsto = r dt514 zsto = rn_Dt 510 515 clop = "ave("//TRIM(clop)//")" 511 516 #endif 512 zout = nn_trd*r dt517 zout = nn_trd*rn_Dt 513 518 514 519 IF(lwp) WRITE(numout,*) ' netCDF initialization' … … 516 521 ! II.2 Compute julian date from starting date of the run 517 522 ! ------------------------ 518 CALL ymds2ju( nyear, nmonth, nday, r dt, zjulian )523 CALL ymds2ju( nyear, nmonth, nday, rn_Dt, zjulian ) 519 524 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 520 525 IF(lwp) WRITE(numout,*)' ' … … 528 533 IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 529 534 CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit 530 & 1, jpj, nit000-1, zjulian, r dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )535 & 1, jpj, nit000-1, zjulian, rn_Dt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set ) 531 536 CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface 532 537
Note: See TracChangeset
for help on using the changeset viewer.
