Changeset 2450 for branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRD
- Timestamp:
- 2010-12-04T16:20:50+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
r2364 r2450 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_trdvor' : momentum trend diagnostics 12 !!----------------------------------------------------------------------13 12 !!---------------------------------------------------------------------- 14 13 !! trd_vor : momentum trends averaged over the depth … … 39 38 PUBLIC trd_vor_init ! routine called by opa.F90 40 39 41 INTEGER :: & 42 nh_t, nmoydpvor , & 43 nidvor, nhoridvor, & 44 ndexvor1(jpi*jpj), & 45 ndimvor1, icount, & 46 idebug ! (0/1) set it to 1 in case of problem to have more print 47 48 REAL(wp), DIMENSION(jpi,jpj) :: & 49 vor_avr , & ! average 50 vor_avrb , & ! before vorticity (kt-1) 51 vor_avrbb , & ! vorticity at begining of the nwrite-1 timestep averaging period 52 vor_avrbn , & ! after vorticity at time step after the 53 rotot , & ! begining of the NWRITE-1 timesteps 54 vor_avrtot , & 55 vor_avrres 56 57 REAL(wp), DIMENSION(jpi,jpj,jpltot_vor):: vortrd !: curl of trends 40 INTEGER :: nh_t, nmoydpvor, nidvor, nhoridvor, ndexvor1(jpi*jpj), ndimvor1, icount ! needs for IOIPSL output 41 INTEGER :: ndebug ! (0/1) set it to 1 in case of problem to have more print 42 43 REAL(wp), DIMENSION(jpi,jpj) :: vor_avr ! average 44 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrb ! before vorticity (kt-1) 45 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrbb ! vorticity at begining of the nwrite-1 timestep averaging period 46 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrbn ! after vorticity at time step after the 47 REAL(wp), DIMENSION(jpi,jpj) :: rotot ! begining of the NWRITE-1 timesteps 48 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrtot ! 49 REAL(wp), DIMENSION(jpi,jpj) :: vor_avrres ! 50 51 REAL(wp), DIMENSION(jpi,jpj,jpltot_vor) :: vortrd ! curl of trends 58 52 59 53 CHARACTER(len=12) :: cvort … … 66 60 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 67 61 !! $Id$ 68 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 69 !!---------------------------------------------------------------------- 70 62 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 63 !!---------------------------------------------------------------------- 71 64 CONTAINS 72 65 … … 76 69 !! 77 70 !! ** Purpose : computation of vertically integrated vorticity budgets 78 !! from ocean surface down to control surface (NetCDF output) 79 !! 80 !! ** Method/usage : 81 !! integration done over nwrite-1 time steps 82 !! 83 !! 84 !! ** Action : 85 !! /comvor/ : 86 !! vor_avr average 87 !! vor_avrb vorticity at kt-1 88 !! vor_avrbb vorticity at begining of the NWRITE-1 89 !! time steps averaging period 90 !! vor_avrbn vorticity at time step after the 91 !! begining of the NWRITE-1 time 92 !! steps averaging period 93 !! 94 !! trends : 95 !! 71 !! from ocean surface down to control surface (NetCDF output) 72 !! 73 !! ** Method/usage : integration done over nwrite-1 time steps 74 !! 75 !! ** Action : trends : 96 76 !! vortrd (,, 1) = Pressure Gradient Trend 97 77 !! vortrd (,, 2) = KE Gradient Trend … … 104 84 !! vortrd (,, 9) = Beta V 105 85 !! vortrd (,,10) = forcing term 106 !! vortrd (,,11) = bottom friction term86 !! vortrd (,,11) = bottom friction term 107 87 !! rotot(,) : total cumulative trends over nwrite-1 time steps 108 88 !! vor_avrtot(,) : first membre of vrticity equation … … 110 90 !! 111 91 !! trends output in netCDF format using ioipsl 112 !! 113 !!---------------------------------------------------------------------- 114 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 115 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: & 116 putrdvor, & ! u vorticity trend 117 pvtrdvor ! v vorticity trend 118 !! 119 INTEGER :: ji, jj 120 INTEGER :: ikbu, ikbum1, ikbv, ikbvm1 92 !!---------------------------------------------------------------------- 93 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 94 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend 95 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvtrdvor ! v vorticity trend 96 !! 97 INTEGER :: ji, jj ! dummy loop indices 98 INTEGER :: ikbu, ikbv ! local integers 121 99 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 122 100 !!---------------------------------------------------------------------- 123 101 124 102 ! Initialization 125 zudpvor(:,:) = 0. e0126 zvdpvor(:,:) = 0. e0127 128 CALL lbc_lnk( putrdvor, 'U' , -1. ) 103 zudpvor(:,:) = 0._wp 104 zvdpvor(:,:) = 0._wp 105 ! 106 CALL lbc_lnk( putrdvor, 'U' , -1. ) ! lateral boundary condition on input momentum trends 129 107 CALL lbc_lnk( pvtrdvor, 'V' , -1. ) 130 108 … … 134 112 135 113 SELECT CASE (ktrd) 136 114 ! 137 115 CASE (jpvor_bfr) ! bottom friction 138 139 116 DO jj = 2, jpjm1 140 117 DO ji = fs_2, fs_jpim1 141 ikbu = min( mbathy(ji+1,jj), mbathy(ji,jj) ) 142 ikbum1 = max( ikbu-1, 1 ) 143 ikbv = min( mbathy(ji,jj+1), mbathy(ji,jj) ) 144 ikbvm1 = max( ikbv-1, 1 ) 145 146 zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbum1) * e1u(ji,jj) * umask(ji,jj,ikbum1) 147 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbvm1) * e2v(ji,jj) * vmask(ji,jj,ikbvm1) 118 ikbu = mbkv(ji,jj) 119 ikbv = mbkv(ji,jj) 120 zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu) 121 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv) 148 122 END DO 149 123 END DO 150 124 ! 151 125 CASE (jpvor_swf) ! wind stress 152 153 126 zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 154 127 zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 155 128 ! 156 129 END SELECT 157 130 … … 163 136 DO ji=1,jpim1 164 137 DO jj=1,jpjm1 165 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 166 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 167 & / ( e1f(ji,jj) * e2f(ji,jj) ) 138 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 139 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 168 140 END DO 169 141 END DO 170 171 ! Surface mask 172 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 173 174 IF( idebug /= 0 ) THEN 142 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) ! Surface mask 143 144 IF( ndebug /= 0 ) THEN 175 145 IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done' 176 146 CALL FLUSH(numout) … … 185 155 !! 186 156 !! ** Purpose : computation of vertically integrated vorticity budgets 187 !! from ocean surface down to control surface (NetCDF output) 188 !! 189 !! ** Method/usage : 190 !! integration done over nwrite-1 time steps 191 !! 192 !! 193 !! ** Action : 194 !! /comvor/ : 195 !! vor_avr average 196 !! vor_avrb vorticity at kt-1 197 !! vor_avrbb vorticity at begining of the NWRITE-1 198 !! time steps averaging period 199 !! vor_avrbn vorticity at time step after the 200 !! begining of the NWRITE-1 time 201 !! steps averaging period 202 !! 203 !! trends : 204 !! 157 !! from ocean surface down to control surface (NetCDF output) 158 !! 159 !! ** Method/usage : integration done over nwrite-1 time steps 160 !! 161 !! ** Action : trends : 205 162 !! vortrd (,,1) = Pressure Gradient Trend 206 163 !! vortrd (,,2) = KE Gradient Trend … … 219 176 !! 220 177 !! trends output in netCDF format using ioipsl 221 !! 222 !!---------------------------------------------------------------------- 223 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 224 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: & 225 putrdvor, & ! u vorticity trend 226 pvtrdvor ! v vorticity trend 178 !!---------------------------------------------------------------------- 179 INTEGER , INTENT(in ) :: ktrd ! ocean trend index 180 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: putrdvor ! u vorticity trend 181 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvtrdvor ! v vorticity trend 227 182 !! 228 183 INTEGER :: ji, jj, jk 229 REAL(wp), DIMENSION(jpi,jpj) :: & 230 zubet, & ! u Beta.V case 231 zvbet, & ! v Beta.V case 232 zudpvor, & ! total cmulative trends 233 zvdpvor ! " " " 184 REAL(wp), DIMENSION(jpi,jpj) :: zubet , zvbet ! Beta.V 185 REAL(wp), DIMENSION(jpi,jpj) :: zudpvor, zvdpvor ! total cmulative trends 234 186 !!---------------------------------------------------------------------- 235 187 236 188 ! Initialization 237 zubet(:,:) = 0.e0 238 zvbet(:,:) = 0.e0 239 zudpvor(:,:) = 0.e0 240 zvdpvor(:,:) = 0.e0 189 zubet (:,:) = 0._wp 190 zvbet (:,:) = 0._wp 191 zudpvor(:,:) = 0._wp 192 zvdpvor(:,:) = 0._wp 193 ! 194 CALL lbc_lnk( putrdvor, 'U' , -1. ) ! lateral boundary condition on input momentum trends 195 CALL lbc_lnk( pvtrdvor, 'V' , -1. ) 241 196 242 197 ! ===================================== 243 198 ! I vertical integration of 3D trends 244 199 ! ===================================== 245 246 CALL lbc_lnk( putrdvor, 'U' , -1. )247 CALL lbc_lnk( pvtrdvor, 'V' , -1. )248 249 200 ! putrdvor and pvtrdvor terms 250 201 DO jk = 1,jpk … … 267 218 DO ji=1,jpim1 268 219 DO jj=1,jpjm1 269 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) - & 270 & ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 271 & / ( e1f(ji,jj) * e2f(ji,jj) ) 220 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 221 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 272 222 END DO 273 223 END DO … … 281 231 DO ji=1,jpim1 282 232 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) ) ) & 285 & / ( e1f(ji,jj) * e2f(ji,jj) ) 233 vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) & 234 & - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 286 235 END DO 287 236 END DO … … 294 243 ENDIF 295 244 296 IF( idebug /= 0 ) THEN245 IF( ndebug /= 0 ) THEN 297 246 IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done' 298 247 CALL FLUSH(numout) … … 309 258 !! and make outputs (NetCDF or DIMG format) 310 259 !!---------------------------------------------------------------------- 311 INTEGER, INTENT( in ) :: kt ! ocean time-step index 312 !! 313 INTEGER :: ji, jj, jk, jl, it, itmod 314 REAL(wp) :: zmean 315 REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn 260 INTEGER, INTENT(in) :: kt ! ocean time-step index 261 !! 262 INTEGER :: ji, jj, jk, jl ! dummy loop indices 263 INTEGER :: it, itmod ! local integers 264 REAL(wp) :: zmean ! local scalars 265 REAL(wp), DIMENSION(jpi,jpj) :: zun, zvn ! 2D workspace 316 266 !!---------------------------------------------------------------------- 317 267 … … 324 274 ! --------------------------------------------------- 325 275 326 IF( kt > nit000 ) THEN 327 vor_avrb(:,:) = vor_avr(:,:) 328 ENDIF 329 330 IF( idebug /= 0 ) THEN 276 IF( kt > nit000 ) vor_avrb(:,:) = vor_avr(:,:) 277 278 IF( ndebug /= 0 ) THEN 331 279 WRITE(numout,*) ' debuging trd_vor: I.1 done ' 332 280 CALL FLUSH(numout) … … 336 284 ! ---------------------------------- 337 285 338 vor_avr (:,:) = 0.339 zun (:,:)=0340 zvn (:,:)=0341 vor_avrtot(:,:) =0342 vor_avrres(:,:) =0286 vor_avr (:,:) = 0._wp 287 zun (:,:) = 0._wp 288 zvn (:,:) = 0._wp 289 vor_avrtot(:,:) = 0._wp 290 vor_avrres(:,:) = 0._wp 343 291 344 292 ! Vertically averaged velocity 345 293 DO jk = 1, jpk - 1 346 zun(:,:) =zun(:,:) + e1u(:,:)*un(:,:,jk)*fse3u(:,:,jk)347 zvn(:,:) =zvn(:,:) + e2v(:,:)*vn(:,:,jk)*fse3v(:,:,jk)294 zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk) 295 zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk) 348 296 END DO 349 297 350 zun(:,:) =zun(:,:)*hur(:,:)351 zvn(:,:) =zvn(:,:)*hvr(:,:)298 zun(:,:) = zun(:,:) * hur(:,:) 299 zvn(:,:) = zvn(:,:) * hvr(:,:) 352 300 353 301 ! Curl 354 302 DO ji=1,jpim1 355 303 DO jj=1,jpjm1 356 vor_avr(ji,jj) = ((zvn(ji+1,jj)-zvn(ji,jj))- & 357 (zun(ji,jj+1)-zun(ji,jj))) & 358 /( e1f(ji,jj) * e2f(ji,jj) ) 359 vor_avr(ji,jj) = vor_avr(ji,jj)*fmask(ji,jj,1) 304 vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) & 305 & - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 360 306 END DO 361 307 END DO 362 308 363 IF( idebug /= 0) THEN309 IF( ndebug /= 0 ) THEN 364 310 WRITE(numout,*) ' debuging trd_vor: I.2 done' 365 311 CALL FLUSH(numout) … … 377 323 ENDIF 378 324 379 IF( idebug /= 0 ) THEN325 IF( ndebug /= 0 ) THEN 380 326 WRITE(numout,*) ' debuging trd_vor: I1.1 done' 381 327 CALL FLUSH(numout) … … 395 341 ENDIF 396 342 397 IF( idebug /= 0 ) THEN343 IF( ndebug /= 0 ) THEN 398 344 WRITE(numout,*) ' debuging trd_vor: II.2 done' 399 345 CALL FLUSH(numout) … … 405 351 406 352 ! define time axis 407 it = kt353 it = kt 408 354 itmod = kt - nit000 + 1 409 355 … … 412 358 ! III.1 compute total trend 413 359 ! ------------------------ 414 zmean = float(nmoydpvor) 415 416 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - & 417 vor_avrbb(:,:) ) / (zmean * 2. * rdt) 418 419 IF( idebug /= 0 ) THEN 360 zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rdt ) 361 vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 362 363 IF( ndebug /= 0 ) THEN 420 364 WRITE(numout,*) ' zmean = ',zmean 421 365 WRITE(numout,*) ' debuging trd_vor: III.1 done' … … 425 369 ! III.2 compute residual 426 370 ! --------------------- 371 zmean = 1._wp / REAL( nmoydpvor, wp ) 427 372 vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean 428 373 … … 431 376 CALL lbc_lnk( vor_avrres, 'F', 1. ) 432 377 433 IF( idebug /= 0 ) THEN378 IF( ndebug /= 0 ) THEN 434 379 WRITE(numout,*) ' debuging trd_vor: III.2 done' 435 380 CALL FLUSH(numout) … … 439 384 ! ------------------------------ 440 385 vor_avrbb(:,:) = vor_avrb(:,:) 441 vor_avrbn(:,:) = vor_avr (:,:)442 443 IF( idebug /= 0 ) THEN386 vor_avrbn(:,:) = vor_avr (:,:) 387 388 IF( ndebug /= 0 ) THEN 444 389 WRITE(numout,*) ' debuging trd_vor: III.3 done' 445 390 CALL FLUSH(numout) 446 391 ENDIF 447 448 nmoydpvor =0449 392 ! 393 nmoydpvor = 0 394 ! 450 395 ENDIF 451 396 … … 475 420 CALL histwrite( nidvor,"sovorgap",it,vor_avrres ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre 476 421 ! 477 IF( idebug /= 0 ) THEN422 IF( ndebug /= 0 ) THEN 478 423 WRITE(numout,*) ' debuging trd_vor: III.4 done' 479 424 CALL FLUSH(numout) … … 508 453 509 454 ! Open specifier 510 idebug = 0 ! set it to 1 in case of problem to have more Print455 ndebug = 0 ! set it to 1 in case of problem to have more Print 511 456 512 457 IF(lwp) THEN … … 528 473 vor_avrres(:,:)=0 529 474 530 IF( idebug /= 0 ) THEN475 IF( ndebug /= 0 ) THEN 531 476 WRITE(numout,*) ' debuging trd_vor_init: I. done' 532 477 CALL FLUSH(numout) … … 600 545 CALL histend( nidvor, snc4set ) 601 546 602 IF( idebug /= 0 ) THEN547 IF( ndebug /= 0 ) THEN 603 548 WRITE(numout,*) ' debuging trd_vor_init: II. done' 604 549 CALL FLUSH(numout) … … 621 566 REAL, DIMENSION(:,:), INTENT( inout ) :: putrdvor, pvtrdvor 622 567 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 623 WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1) 624 WRITE(*,*) ' " " : You should not have seen this print! error?', pvtrdvor(1,1) 625 WRITE(*,*) ' " " : You should not have seen this print! error?', ktrd 568 WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd 626 569 END SUBROUTINE trd_vor_zint_2d 627 570 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 628 571 REAL, DIMENSION(:,:,:), INTENT( inout ) :: putrdvor, pvtrdvor 629 572 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 630 WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1) 631 WRITE(*,*) ' " " : You should not have seen this print! error?', pvtrdvor(1,1,1) 632 WRITE(*,*) ' " " : You should not have seen this print! error?', ktrd 573 WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd 633 574 END SUBROUTINE trd_vor_zint_3d 634 575 SUBROUTINE trd_vor_init ! Empty routine
Note: See TracChangeset
for help on using the changeset viewer.
