- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r3294 r6225 4 4 !! Ocean diagnostics: momentum trends 5 5 !!===================================================================== 6 !! History : 1.0 ! 04-2006 (L. Brunier, A-M. Treguier) Original code 7 !! 2.0 ! 04-2008 (C. Talandier) New trends organization 6 !! History : 1.0 ! 2006-01 (L. Brunier, A-M. Treguier) Original code 7 !! 2.0 ! 2008-04 (C. Talandier) New trends organization 8 !! 3.5 ! 2012-02 (G. Madec) regroup beta.V computation with pvo trend 8 9 !!---------------------------------------------------------------------- 9 #if defined key_trdvor || defined key_esopa 10 !!---------------------------------------------------------------------- 11 !! 'key_trdvor' : momentum trend diagnostics 10 12 11 !!---------------------------------------------------------------------- 13 12 !! trd_vor : momentum trends averaged over the depth … … 17 16 USE oce ! ocean dynamics and tracers variables 18 17 USE dom_oce ! ocean space and time domain variables 19 USE trd mod_oce ! ocean variables trends18 USE trd_oce ! trends: ocean variables 20 19 USE zdf_oce ! ocean vertical physics 21 USE in_out_manager ! I/O manager20 USE sbc_oce ! surface boundary condition: ocean 22 21 USE phycst ! Define parameters for the routines 23 USE ldfdyn _oce! ocean active tracers: lateral physics22 USE ldfdyn ! ocean active tracers: lateral physics 24 23 USE dianam ! build the name of file (routine) 25 24 USE zdfmxl ! mixed layer depth 25 ! 26 USE in_out_manager ! I/O manager 26 27 USE ioipsl ! NetCDF library 27 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 29 30 USE wrk_nemo ! Memory allocation 30 31 31 32 32 IMPLICIT NONE 33 33 PRIVATE … … 37 37 END INTERFACE 38 38 39 PUBLIC trd_vor ! routine called by step.F90 40 PUBLIC trd_vor_zint ! routine called by dynamics routines 39 PUBLIC trd_vor ! routine called by trddyn.F90 41 40 PUBLIC trd_vor_init ! routine called by opa.F90 42 41 PUBLIC trd_vor_alloc ! routine called by nemogcm.F90 … … 58 57 59 58 !! * Substitutions 60 # include "domzgr_substitute.h90"61 # include "ldfdyn_substitute.h90"62 59 # include "vectopt_loop_substitute.h90" 63 60 !!---------------------------------------------------------------------- … … 80 77 IF( trd_vor_alloc /= 0 ) CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 81 78 END FUNCTION trd_vor_alloc 79 80 81 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt ) 82 !!---------------------------------------------------------------------- 83 !! *** ROUTINE trd_vor *** 84 !! 85 !! ** Purpose : computation of cumulated trends over analysis period 86 !! and make outputs (NetCDF format) 87 !!---------------------------------------------------------------------- 88 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends 89 INTEGER , INTENT(in ) :: ktrd ! trend index 90 INTEGER , INTENT(in ) :: kt ! time step 91 ! 92 INTEGER :: ji, jj ! dummy loop indices 93 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv ! 2D workspace 94 !!---------------------------------------------------------------------- 95 96 CALL wrk_alloc( jpi, jpj, ztswu, ztswv ) 97 98 SELECT CASE( ktrd ) 99 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg ) ! Hydrostatique Pressure Gradient 100 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg ) ! KE Gradient 101 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo ) ! Relative Vorticity 102 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo ) ! Planetary Vorticity Term 103 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf ) ! Horizontal Diffusion 104 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad ) ! Vertical Advection 105 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg ) ! Surface Pressure Grad. 106 CASE( jpdyn_zdf ) ! Vertical Diffusion 107 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 108 DO jj = 2, jpjm1 ! wind stress trends 109 DO ji = fs_2, fs_jpim1 ! vector opt. 110 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( e3u_n(ji,jj,1) * rau0 ) 111 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( e3v_n(ji,jj,1) * rau0 ) 112 END DO 113 END DO 114 ! 115 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf ) ! zdf trend including surf./bot. stresses 116 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf ) ! surface wind stress 117 CASE( jpdyn_bfr ) 118 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr ) ! Bottom stress 119 ! 120 CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends 121 CALL trd_vor_iom( kt ) 122 END SELECT 123 ! 124 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv ) 125 ! 126 END SUBROUTINE trd_vor 82 127 83 128 … … 109 154 !! trends output in netCDF format using ioipsl 110 155 !!---------------------------------------------------------------------- 111 !112 156 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 113 157 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend … … 131 175 ! ===================================== 132 176 133 SELECT CASE (ktrd)134 ! 135 CASE (jpvor_bfr) ! bottom friction177 SELECT CASE( ktrd ) 178 ! 179 CASE( jpvor_bfr ) ! bottom friction 136 180 DO jj = 2, jpjm1 137 181 DO ji = fs_2, fs_jpim1 138 182 ikbu = mbkv(ji,jj) 139 183 ikbv = mbkv(ji,jj) 140 zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)141 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)184 zudpvor(ji,jj) = putrdvor(ji,jj) * e3u_n(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 185 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * e3v_n(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 142 186 END DO 143 187 END DO 144 188 ! 145 CASE (jpvor_swf) ! wind stress146 zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)147 zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)189 CASE( jpvor_swf ) ! wind stress 190 zudpvor(:,:) = putrdvor(:,:) * e3u_n(:,:,1) * e1u(:,:) * umask(:,:,1) 191 zvdpvor(:,:) = pvtrdvor(:,:) * e3v_n(:,:,1) * e2v(:,:) * vmask(:,:,1) 148 192 ! 149 193 END SELECT 150 194 151 195 ! Average except for Beta.V 152 zudpvor(:,:) = zudpvor(:,:) * hur(:,:)153 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)196 zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 197 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 154 198 155 199 ! Curl 156 DO ji =1,jpim1157 DO jj =1,jpjm1200 DO ji = 1, jpim1 201 DO jj = 1, jpjm1 158 202 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 159 203 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) … … 225 269 ! putrdvor and pvtrdvor terms 226 270 DO jk = 1,jpk 227 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk)228 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk)271 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * e3u_n(:,:,jk) * e1u(:,:) * umask(:,:,jk) 272 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * e3v_n(:,:,jk) * e2v(:,:) * vmask(:,:,jk) 229 273 END DO 230 274 231 ! Save Beta.V term to avoid average before Curl232 ! Beta.V : intergration, noaverage233 IF( ktrd == jpvor_ bev) THEN275 ! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum 276 ! as Beta.V term need intergration, not average 277 IF( ktrd == jpvor_pvo ) THEN 234 278 zubet(:,:) = zudpvor(:,:) 235 279 zvbet(:,:) = zvdpvor(:,:) 236 ENDIF 237 238 ! Average except for Beta.V 239 zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 240 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 241 280 DO ji = 1, jpim1 281 DO jj = 1, jpjm1 282 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 283 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 284 END DO 285 END DO 286 ! Average of the Curl and Surface mask 287 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1) 288 ENDIF 289 ! 290 ! Average 291 zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 292 zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 293 ! 242 294 ! Curl 243 295 DO ji=1,jpim1 … … 247 299 END DO 248 300 END DO 249 250 301 ! Surface mask 251 302 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 252 253 ! Special treatement for the Beta.V term254 ! Compute the Curl of the Beta.V term which is not averaged255 IF( ktrd == jpvor_bev ) THEN256 DO ji=1,jpim1257 DO jj=1,jpjm1258 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) &259 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )260 END DO261 END DO262 263 ! Average on the Curl264 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:)265 266 ! Surface mask267 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1)268 ENDIF269 303 270 304 IF( ndebug /= 0 ) THEN … … 278 312 279 313 280 SUBROUTINE trd_vor ( kt )314 SUBROUTINE trd_vor_iom( kt ) 281 315 !!---------------------------------------------------------------------- 282 316 !! *** ROUTINE trd_vor *** 283 317 !! 284 318 !! ** Purpose : computation of cumulated trends over analysis period 285 !! and make outputs (NetCDF or DIMG format) 286 !!---------------------------------------------------------------------- 287 ! 288 INTEGER, INTENT(in) :: kt ! ocean time-step index 319 !! and make outputs (NetCDF format) 320 !!---------------------------------------------------------------------- 321 INTEGER , INTENT(in ) :: kt ! time step 289 322 ! 290 323 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 305 338 306 339 IF( kt > nit000 ) vor_avrb(:,:) = vor_avr(:,:) 307 308 IF( ndebug /= 0 ) THEN309 WRITE(numout,*) ' debuging trd_vor: I.1 done '310 CALL FLUSH(numout)311 ENDIF312 340 313 341 ! I.2 vertically integrated vorticity … … 322 350 ! Vertically averaged velocity 323 351 DO jk = 1, jpk - 1 324 zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)325 zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)352 zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * e3u_n(:,:,jk) 353 zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * e3v_n(:,:,jk) 326 354 END DO 327 355 328 zun(:,:) = zun(:,:) * hur(:,:)329 zvn(:,:) = zvn(:,:) * hvr(:,:)356 zun(:,:) = zun(:,:) * r1_hu_n(:,:) 357 zvn(:,:) = zvn(:,:) * r1_hv_n(:,:) 330 358 331 359 ! Curl 332 DO ji =1,jpim1333 DO jj =1,jpjm1360 DO ji = 1, jpim1 361 DO jj = 1, jpjm1 334 362 vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 335 363 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) … … 337 365 END DO 338 366 339 IF( ndebug /= 0 ) THEN340 WRITE(numout,*) ' debuging trd_vor: I.2 done'341 CALL FLUSH(numout)342 ENDIF343 344 367 ! ================================= 345 368 ! II. Cumulated trends … … 351 374 vor_avrbb(:,:) = vor_avrb(:,:) 352 375 vor_avrbn(:,:) = vor_avr (:,:) 353 ENDIF354 355 IF( ndebug /= 0 ) THEN356 WRITE(numout,*) ' debuging trd_vor: I1.1 done'357 CALL FLUSH(numout)358 376 ENDIF 359 377 … … 371 389 ENDIF 372 390 373 IF( ndebug /= 0 ) THEN374 WRITE(numout,*) ' debuging trd_vor: II.2 done'375 CALL FLUSH(numout)376 ENDIF377 378 391 ! ============================================= 379 392 ! III. Output in netCDF + residual computation … … 391 404 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 392 405 393 IF( ndebug /= 0 ) THEN394 WRITE(numout,*) ' zmean = ',zmean395 WRITE(numout,*) ' debuging trd_vor: III.1 done'396 CALL FLUSH(numout)397 ENDIF398 406 399 407 ! III.2 compute residual … … 406 414 CALL lbc_lnk( vor_avrres, 'F', 1. ) 407 415 408 IF( ndebug /= 0 ) THEN409 WRITE(numout,*) ' debuging trd_vor: III.2 done'410 CALL FLUSH(numout)411 ENDIF412 416 413 417 ! III.3 time evolution array swap … … 415 419 vor_avrbb(:,:) = vor_avrb(:,:) 416 420 vor_avrbn(:,:) = vor_avr (:,:) 417 418 IF( ndebug /= 0 ) THEN419 WRITE(numout,*) ' debuging trd_vor: III.3 done'420 CALL FLUSH(numout)421 ENDIF422 421 ! 423 422 nmoydpvor = 0 … … 463 462 CALL wrk_dealloc( jpi, jpj, zun, zvn ) 464 463 ! 465 END SUBROUTINE trd_vor 464 END SUBROUTINE trd_vor_iom 466 465 467 466 … … 587 586 END SUBROUTINE trd_vor_init 588 587 589 #else590 !!----------------------------------------------------------------------591 !! Default option : Empty module592 !!----------------------------------------------------------------------593 INTERFACE trd_vor_zint594 MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d595 END INTERFACE596 CONTAINS597 SUBROUTINE trd_vor( kt ) ! Empty routine598 WRITE(*,*) 'trd_vor: You should not have seen this print! error?', kt599 END SUBROUTINE trd_vor600 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )601 REAL, DIMENSION(:,:), INTENT( inout ) :: putrdvor, pvtrdvor602 INTEGER, INTENT( in ) :: ktrd ! ocean trend index603 WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd604 END SUBROUTINE trd_vor_zint_2d605 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )606 REAL, DIMENSION(:,:,:), INTENT( inout ) :: putrdvor, pvtrdvor607 INTEGER, INTENT( in ) :: ktrd ! ocean trend index608 WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd609 END SUBROUTINE trd_vor_zint_3d610 SUBROUTINE trd_vor_init ! Empty routine611 WRITE(*,*) 'trd_vor_init: You should not have seen this print! error?'612 END SUBROUTINE trd_vor_init613 #endif614 588 !!====================================================================== 615 589 END MODULE trdvor
Note: See TracChangeset
for help on using the changeset viewer.
