Changeset 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
- Timestamp:
- 2014-12-15T17:42:49+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r3294 r4990 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 22 USE ldfdyn_oce ! ocean active tracers: lateral physics 24 23 USE dianam ! build the name of file (routine) 25 24 USE zdfmxl ! mixed layer depth 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE in_out_manager ! I/O manager 26 27 USE ioipsl ! NetCDF library 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link)28 28 USE lib_mpp ! MPP library 29 29 USE wrk_nemo ! Memory allocation 30 31 30 32 31 IMPLICIT NONE … … 37 36 END INTERFACE 38 37 39 PUBLIC trd_vor ! routine called by step.F90 40 PUBLIC trd_vor_zint ! routine called by dynamics routines 38 PUBLIC trd_vor ! routine called by trddyn.F90 41 39 PUBLIC trd_vor_init ! routine called by opa.F90 42 40 PUBLIC trd_vor_alloc ! routine called by nemogcm.F90 … … 80 78 IF( trd_vor_alloc /= 0 ) CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 81 79 END FUNCTION trd_vor_alloc 80 81 82 SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt ) 83 !!---------------------------------------------------------------------- 84 !! *** ROUTINE trd_vor *** 85 !! 86 !! ** Purpose : computation of cumulated trends over analysis period 87 !! and make outputs (NetCDF or DIMG format) 88 !!---------------------------------------------------------------------- 89 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends 90 INTEGER , INTENT(in ) :: ktrd ! trend index 91 INTEGER , INTENT(in ) :: kt ! time step 92 ! 93 INTEGER :: ji, jj ! dummy loop indices 94 REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv ! 2D workspace 95 !!---------------------------------------------------------------------- 96 97 CALL wrk_alloc( jpi, jpj, ztswu, ztswv ) 98 99 SELECT CASE( ktrd ) 100 CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg ) ! Hydrostatique Pressure Gradient 101 CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg ) ! KE Gradient 102 CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo ) ! Relative Vorticity 103 CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo ) ! Planetary Vorticity Term 104 CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf ) ! Horizontal Diffusion 105 CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad ) ! Vertical Advection 106 CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg ) ! Surface Pressure Grad. 107 CASE( jpdyn_zdf ) ! Vertical Diffusion 108 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 109 DO jj = 2, jpjm1 ! wind stress trends 110 DO ji = fs_2, fs_jpim1 ! vector opt. 111 ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 112 ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 113 END DO 114 END DO 115 ! 116 CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf ) ! zdf trend including surf./bot. stresses 117 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf ) ! surface wind stress 118 CASE( jpdyn_bfr ) 119 CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr ) ! Bottom stress 120 ! 121 CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends 122 CALL trd_vor_iom( kt ) 123 END SELECT 124 ! 125 CALL wrk_dealloc( jpi, jpj, ztswu, ztswv ) 126 ! 127 END SUBROUTINE trd_vor 82 128 83 129 … … 109 155 !! trends output in netCDF format using ioipsl 110 156 !!---------------------------------------------------------------------- 111 !112 157 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 113 158 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend … … 131 176 ! ===================================== 132 177 133 SELECT CASE (ktrd)134 ! 135 CASE (jpvor_bfr) ! bottom friction178 SELECT CASE( ktrd ) 179 ! 180 CASE( jpvor_bfr ) ! bottom friction 136 181 DO jj = 2, jpjm1 137 182 DO ji = fs_2, fs_jpim1 … … 143 188 END DO 144 189 ! 145 CASE (jpvor_swf) ! wind stress190 CASE( jpvor_swf ) ! wind stress 146 191 zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 147 192 zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) … … 154 199 155 200 ! Curl 156 DO ji =1,jpim1157 DO jj =1,jpjm1201 DO ji = 1, jpim1 202 DO jj = 1, jpjm1 158 203 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 159 204 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) … … 229 274 END DO 230 275 231 ! Save Beta.V term to avoid average before Curl232 ! Beta.V : intergration, noaverage233 IF( ktrd == jpvor_ bev) THEN276 ! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum 277 ! as Beta.V term need intergration, not average 278 IF( ktrd == jpvor_pvo ) THEN 234 279 zubet(:,:) = zudpvor(:,:) 235 280 zvbet(:,:) = zvdpvor(:,:) 236 ENDIF 237 238 ! Average except for Beta.V 281 DO ji = 1, jpim1 282 DO jj = 1, jpjm1 283 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 284 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 285 END DO 286 END DO 287 ! Average of the Curl and Surface mask 288 vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1) 289 ENDIF 290 ! 291 ! Average 239 292 zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 240 293 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 241 294 ! 242 295 ! Curl 243 296 DO ji=1,jpim1 … … 247 300 END DO 248 301 END DO 249 250 302 ! Surface mask 251 303 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 304 270 305 IF( ndebug /= 0 ) THEN … … 278 313 279 314 280 SUBROUTINE trd_vor ( kt )315 SUBROUTINE trd_vor_iom( kt ) 281 316 !!---------------------------------------------------------------------- 282 317 !! *** ROUTINE trd_vor *** … … 285 320 !! and make outputs (NetCDF or DIMG format) 286 321 !!---------------------------------------------------------------------- 287 ! 288 INTEGER, INTENT(in) :: kt ! ocean time-step index 322 INTEGER , INTENT(in ) :: kt ! time step 289 323 ! 290 324 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 305 339 306 340 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 341 313 342 ! I.2 vertically integrated vorticity … … 330 359 331 360 ! Curl 332 DO ji =1,jpim1333 DO jj =1,jpjm1361 DO ji = 1, jpim1 362 DO jj = 1, jpjm1 334 363 vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 335 364 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) … … 337 366 END DO 338 367 339 IF( ndebug /= 0 ) THEN340 WRITE(numout,*) ' debuging trd_vor: I.2 done'341 CALL FLUSH(numout)342 ENDIF343 344 368 ! ================================= 345 369 ! II. Cumulated trends … … 351 375 vor_avrbb(:,:) = vor_avrb(:,:) 352 376 vor_avrbn(:,:) = vor_avr (:,:) 353 ENDIF354 355 IF( ndebug /= 0 ) THEN356 WRITE(numout,*) ' debuging trd_vor: I1.1 done'357 CALL FLUSH(numout)358 377 ENDIF 359 378 … … 371 390 ENDIF 372 391 373 IF( ndebug /= 0 ) THEN374 WRITE(numout,*) ' debuging trd_vor: II.2 done'375 CALL FLUSH(numout)376 ENDIF377 378 392 ! ============================================= 379 393 ! III. Output in netCDF + residual computation … … 391 405 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 392 406 393 IF( ndebug /= 0 ) THEN394 WRITE(numout,*) ' zmean = ',zmean395 WRITE(numout,*) ' debuging trd_vor: III.1 done'396 CALL FLUSH(numout)397 ENDIF398 407 399 408 ! III.2 compute residual … … 406 415 CALL lbc_lnk( vor_avrres, 'F', 1. ) 407 416 408 IF( ndebug /= 0 ) THEN409 WRITE(numout,*) ' debuging trd_vor: III.2 done'410 CALL FLUSH(numout)411 ENDIF412 417 413 418 ! III.3 time evolution array swap … … 415 420 vor_avrbb(:,:) = vor_avrb(:,:) 416 421 vor_avrbn(:,:) = vor_avr (:,:) 417 418 IF( ndebug /= 0 ) THEN419 WRITE(numout,*) ' debuging trd_vor: III.3 done'420 CALL FLUSH(numout)421 ENDIF422 422 ! 423 423 nmoydpvor = 0 … … 463 463 CALL wrk_dealloc( jpi, jpj, zun, zvn ) 464 464 ! 465 END SUBROUTINE trd_vor 465 END SUBROUTINE trd_vor_iom 466 466 467 467 … … 587 587 END SUBROUTINE trd_vor_init 588 588 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 589 !!====================================================================== 615 590 END MODULE trdvor
Note: See TracChangeset
for help on using the changeset viewer.