Changeset 216 for trunk/NEMO/OPA_SRC/TRD/trdvor.F90
- Timestamp:
- 2005-03-17T15:02:38+01:00 (19 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/TRD/trdvor.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRD/trdvor.F90
r129 r216 5 5 !!===================================================================== 6 6 7 #if defined key_trd _vor || defined key_esopa7 #if defined key_trdvor || defined key_esopa 8 8 !!---------------------------------------------------------------------- 9 !! 'key_trd _vor' : momentum trend diagnostics9 !! 'key_trdvor' : momentum trend diagnostics 10 10 !!---------------------------------------------------------------------- 11 11 !! trd_vor : momentum trends averaged over the depth 12 !! trd_vor_zint : vorticity vertical integration 13 !! trd_vor_init : initialization step 12 14 !!---------------------------------------------------------------------- 13 15 !! * Modules used 14 16 USE oce ! ocean dynamics and tracers variables 15 17 USE dom_oce ! ocean space and time domain variables 16 USE trd dyn_oce ! ocean active tracer trend variables18 USE trdmod_oce ! ocean variables trends 17 19 USE zdf_oce ! ocean vertical physics 18 20 USE in_out_manager ! I/O manager 19 20 21 USE phycst ! Define parameters for the routines 21 22 USE ldfdyn_oce ! ocean active tracers: lateral physics … … 23 24 USE dianam ! build the name of file (routine) 24 25 USE ldfslp ! iso-neutral slopes 25 USE zdfmxl 26 USE ioipsl 27 USE lbclnk 26 USE zdfmxl ! mixed layer depth 27 USE ioipsl ! NetCDF library 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 28 30 29 31 IMPLICIT NONE 30 32 PRIVATE 31 33 34 !! * Interfaces 35 INTERFACE trd_vor_zint 36 MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d 37 END INTERFACE 32 38 33 39 !! * Accessibility 34 PUBLIC trd_vor ! routine called by step.F90 40 PUBLIC trd_vor ! routine called by step.F90 41 PUBLIC trd_vor_zint ! routine called by dynamics routines 42 PUBLIC trd_vor_init ! routine called by opa.F90 35 43 36 44 !! * Shared module variables … … 38 46 39 47 !! * Module variables 40 INTEGER,PARAMETER :: jplvor=1141 48 INTEGER :: & 42 49 nh_t, nmoydpvor , & 43 50 nidvor, nhoridvor, & 44 51 ndexvor1(jpi*jpj), & 45 ndimvor1 52 ndimvor1, icount, & 53 idebug ! (0/1) set it to 1 in case of problem to have more print 46 54 47 55 REAL(wp), DIMENSION(jpi,jpj) :: & … … 49 57 vor_avrb , & ! before vorticity (kt-1) 50 58 vor_avrbb , & ! vorticity at begining of the nwrite-1 timestep averaging period 51 vor_avrbn, & ! after vorticity at time step after the52 rotot, & ! begining of the NWRITE-1 timesteps53 udpvor , & ! total cumulative trends54 vdpvor ! " " "59 vor_avrbn , & ! after vorticity at time step after the 60 rotot , & ! begining of the NWRITE-1 timesteps 61 vor_avrtot , & 62 vor_avrres 55 63 56 64 REAL(wp), DIMENSION(jpi,jpj,jplvor):: & !: curl of trends 57 65 vortrd 66 67 CHARACTER(len=12) :: cvort 58 68 59 69 !! * Substitutions … … 68 78 CONTAINS 69 79 70 SUBROUTINE trd_vor ( kt)80 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 71 81 !!---------------------------------------------------------------------------- 72 !! *** ROUTINE trd_vor ***82 !! *** ROUTINE trd_vor_zint *** 73 83 !! 74 84 !! ** Purpose : computation of vertically integrated vorticity budgets … … 80 90 !! 81 91 !! ** Action : 82 !! /com mld/ :92 !! /comvor/ : 83 93 !! vor_avr average 84 94 !! vor_avrb vorticity at kt-1 … … 107 117 !! 108 118 !! trends output in netCDF format using ioipsl 119 !! 120 !! History : 121 !! 9.0 ! 04-06 (L. Brunier, A-M. Treguier) Original code 122 !! ! 04-08 (C. Talandier) New trends organization 109 123 !!---------------------------------------------------------------------- 110 124 !! * Arguments 111 INTEGER, INTENT( in ) :: kt ! ocean time-step index 125 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 126 127 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: & 128 putrdvor, & ! u vorticity trend 129 pvtrdvor ! v vorticity trend 112 130 113 131 !! * Local declarations 114 INTEGER ilseq 115 INTEGER ji, jj, jk, jl, idebug, it 132 INTEGER :: ji, jj 133 INTEGER :: ikbu, ikbum1, ikbv, ikbvm1 134 REAL(wp), DIMENSION(jpi,jpj) :: & 135 zudpvor, & ! total cmulative trends 136 zvdpvor ! " " " 137 !!---------------------------------------------------------------------- 138 139 ! Initialization 140 zudpvor(:,:) = 0.e0 141 zvdpvor(:,:) = 0.e0 142 143 CALL lbc_lnk( putrdvor, 'U' , -1. ) 144 CALL lbc_lnk( pvtrdvor, 'V' , -1. ) 145 146 ! ===================================== 147 ! I vertical integration of 2D trends 148 ! ===================================== 149 150 SELECT CASE (ktrd) 151 152 CASE (jpvorbfr) ! bottom friction 153 154 DO jj = 2, jpjm1 155 DO ji = fs_2, fs_jpim1 156 ikbu = min( mbathy(ji+1,jj), mbathy(ji,jj) ) 157 ikbum1 = max( ikbu-1, 1 ) 158 ikbv = min( mbathy(ji,jj+1), mbathy(ji,jj) ) 159 ikbvm1 = max( ikbv-1, 1 ) 160 161 zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbum1) * e1u(ji,jj) * umask(ji,jj,ikbum1) 162 zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbvm1) * e2v(ji,jj) * vmask(ji,jj,ikbvm1) 163 END DO 164 END DO 165 166 CASE (jpvorswf) ! wind stress 167 168 zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 169 zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 170 171 END SELECT 172 173 ! Average except for Beta.V 174 zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 175 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 176 177 ! Curl 178 DO ji=1,jpim1 179 DO jj=1,jpjm1 180 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) & 181 & - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 182 & / ( e1f(ji,jj) * e2f(ji,jj) ) 183 END DO 184 END DO 185 186 ! Surface mask 187 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 188 189 IF( idebug /= 0 ) THEN 190 IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done' 191 CALL FLUSH(numout) 192 ENDIF 193 194 END SUBROUTINE trd_vor_zint_2d 195 196 197 198 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 199 !!---------------------------------------------------------------------------- 200 !! *** ROUTINE trd_vor_zint *** 201 !! 202 !! ** Purpose : computation of vertically integrated vorticity budgets 203 !! from ocean surface down to control surface (NetCDF output) 204 !! 205 !! ** Method/usage : 206 !! integration done over nwrite-1 time steps 207 !! 208 !! 209 !! ** Action : 210 !! /comvor/ : 211 !! vor_avr average 212 !! vor_avrb vorticity at kt-1 213 !! vor_avrbb vorticity at begining of the NWRITE-1 214 !! time steps averaging period 215 !! vor_avrbn vorticity at time step after the 216 !! begining of the NWRITE-1 time 217 !! steps averaging period 218 !! 219 !! trends : 220 !! 221 !! vortrd (,,1) = Pressure Gradient Trend 222 !! vortrd (,,2) = KE Gradient Trend 223 !! vortrd (,,3) = Relative Vorticity Trend 224 !! vortrd (,,4) = Coriolis Term Trend 225 !! vortrd (,,5) = Horizontal Diffusion Trend 226 !! vortrd (,,6) = Vertical Advection Trend 227 !! vortrd (,,7) = Vertical Diffusion Trend 228 !! vortrd (,,8) = Surface Pressure Grad. Trend 229 !! vortrd (,,9) = Beta V 230 !! vortrd (,,10) = forcing term 231 !! vortrd (,,11) = bottom friction term 232 !! rotot(,) : total cumulative trends over nwrite-1 time steps 233 !! vor_avrtot(,) : first membre of vrticity equation 234 !! vor_avrres(,) : residual = dh/dt entrainment 235 !! 236 !! trends output in netCDF format using ioipsl 237 !! 238 !! History : 239 !! 9.0 ! 04-06 (L. Brunier, A-M. Treguier) Original code 240 !! ! 04-08 (C. Talandier) New trends organization 241 !!---------------------------------------------------------------------- 242 !! * Arguments 243 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 244 245 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: & 246 putrdvor, & ! u vorticity trend 247 pvtrdvor ! v vorticity trend 248 249 !! * Local declarations 250 INTEGER :: ji, jj, jk 251 252 REAL(wp), DIMENSION(jpi,jpj) :: & 253 zubet, & ! u Beta.V case 254 zvbet, & ! v Beta.V case 255 zudpvor, & ! total cmulative trends 256 zvdpvor ! " " " 257 !!---------------------------------------------------------------------- 258 259 ! Initialization 260 zubet(:,:) = 0.e0 261 zvbet(:,:) = 0.e0 262 zudpvor(:,:) = 0.e0 263 zvdpvor(:,:) = 0.e0 264 265 ! ===================================== 266 ! I vertical integration of 3D trends 267 ! ===================================== 268 269 CALL lbc_lnk( putrdvor, 'U' , -1. ) 270 CALL lbc_lnk( pvtrdvor, 'V' , -1. ) 271 272 ! putrdvor and pvtrdvor terms 273 DO jk = 1,jpk 274 zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk) 275 zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk) 276 END DO 277 278 ! Save Beta.V term to avoid average before Curl 279 ! Beta.V : intergration, no average 280 IF( ktrd == jpvorbev ) THEN 281 zubet(:,:) = zudpvor(:,:) 282 zvbet(:,:) = zvdpvor(:,:) 283 ENDIF 284 285 ! Average except for Beta.V 286 zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 287 zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 288 289 ! Curl 290 DO ji=1,jpim1 291 DO jj=1,jpjm1 292 vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) - & 293 & ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) & 294 & / ( e1f(ji,jj) * e2f(ji,jj) ) 295 END DO 296 END DO 297 298 ! Surface mask 299 vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 300 301 ! Special treatement for the Beta.V term 302 ! Compute the Curl of the Beta.V term which is not averaged 303 IF( ktrd == jpvorbev ) THEN 304 DO ji=1,jpim1 305 DO jj=1,jpjm1 306 vortrd(ji,jj,jpvorbev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) - & 307 & ( zubet(ji,jj+1) - zubet(ji,jj) ) ) & 308 & / ( e1f(ji,jj) * e2f(ji,jj) ) 309 END DO 310 END DO 311 312 ! Average on the Curl 313 vortrd(:,:,jpvorbev) = vortrd(:,:,jpvorbev) * hur(:,:) 314 315 ! Surface mask 316 vortrd(:,:,jpvorbev) = vortrd(:,:,jpvorbev) * fmask(:,:,1) 317 ENDIF 318 319 IF( idebug /= 0 ) THEN 320 IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done' 321 CALL FLUSH(numout) 322 ENDIF 323 324 END SUBROUTINE trd_vor_zint_3d 325 326 327 328 SUBROUTINE trd_vor( kt ) 329 !!---------------------------------------------------------------------- 330 !! *** ROUTINE trd_vor *** 331 !! 332 !! ** Purpose : computation of cumulated trends over analysis period 333 !! and make outputs (NetCDF or DIMG format) 334 !! 335 !! ** Method/usage : 336 !! 337 !! History : 338 !! 9.0 ! 04-06 (L. Brunier, A-M. Treguier) Original code 339 !! ! 04-08 (C. Talandier) New trends organization 340 !!---------------------------------------------------------------------- 341 !! * Arguments 342 INTEGER, INTENT( in ) :: kt ! ocean time-step index 343 344 !! * Local declarations 345 INTEGER :: ji, jj, jk, jl, it 116 346 117 347 REAL(wp) :: zmean 118 REAL(wp) :: zun(jpi,jpj), zvn(jpi,jpj) 119 REAL(wp) :: zjulian, zsto, zout 120 REAL(wp) :: vor_avrtot(jpi,jpj), vor_avrres(jpi,jpj) 121 INTEGER(wp) :: ikbu,ikbum1,ikbv,ikbvm1 122 CHARACTER (len=12) :: cvort 123 CHARACTER (len=40) :: clhstnam 124 CHARACTER (len=40) :: clop 125 126 NAMELIST/namtrd/ ntrd,nctls 127 !!---------------------------------------------------------------------- 348 349 REAL(wp) ,DIMENSION(jpi,jpj) :: & 350 zun, zvn 351 !!---------------------------------------------------------------------- 352 353 ! ================= 354 ! I. Initialization 355 ! ================= 128 356 129 ! =================== 130 ! 0. initialization 131 ! =================== 132 133 cvort='averaged-vor' 134 135 ! Open specifier 136 ilseq = 1 137 idebug = 0 ! set it to 1 in case of problem to have more Print 138 139 IF( kt == nit000 ) THEN 140 141 ! namelist namtrd : trend diagnostic 142 REWIND( numnam ) 143 READ ( numnam, namtrd ) 144 145 IF(lwp) THEN 146 WRITE(numout,*) 'namtrd' 147 WRITE(numout,*) ' ' 148 WRITE(numout,*) ' time step frequency trend ntrd = ',ntrd 149 WRITE(numout,*) ' ' 150 ENDIF 151 152 ! cumulated trends array init 153 nmoydpvor = 0 154 rotot(:,:)=0 155 vor_avrtot(:,:)=0 156 vor_avrres(:,:)=0 157 ENDIF 158 159 ! set before values of vertically average u and v 357 358 ! I.1 set before values of vertically average u and v 359 ! --------------------------------------------------- 160 360 161 361 IF( kt > nit000 ) THEN … … 164 364 165 365 IF( idebug /= 0 ) THEN 166 WRITE(numout,*) ' debuging trd_vor: 0.done '366 WRITE(numout,*) ' debuging trd_vor: I.1 done ' 167 367 CALL FLUSH(numout) 168 368 ENDIF 169 369 170 ! ================================= 171 ! I. vertically integrated vorticity 172 ! ================================= 370 ! I.2 vertically integrated vorticity 371 ! ---------------------------------- 173 372 174 373 vor_avr(:,:) = 0. … … 178 377 vor_avrres(:,:)=0 179 378 180 ! vertically averaged velocity379 ! Vertically averaged velocity 181 380 DO jk = 1, jpk - 1 182 381 zun(:,:)=zun(:,:) + e1u(:,:)*un(:,:,jk)*fse3u(:,:,jk) 183 382 zvn(:,:)=zvn(:,:) + e2v(:,:)*vn(:,:,jk)*fse3v(:,:,jk) 184 383 END DO 185 186 384 187 385 zun(:,:)=zun(:,:)*hur(:,:) 188 386 zvn(:,:)=zvn(:,:)*hvr(:,:) 189 387 190 ! Curl388 ! Curl 191 389 DO ji=1,jpim1 192 390 DO jj=1,jpjm1 … … 198 396 END DO 199 397 200 201 398 IF(idebug /= 0) THEN 202 WRITE(numout,*) ' debuging trd_vor: I done'399 WRITE(numout,*) ' debuging trd_vor: I.2 done' 203 400 CALL FLUSH(numout) 204 401 ENDIF 205 402 206 403 ! ================================= 207 ! II. netCDF output initialization404 ! II. Cumulated trends 208 405 ! ================================= 209 406 210 # include "trdvor_ncinit.h90" 211 212 IF( idebug /= 0 ) THEN 213 WRITE(numout,*) ' debuging trd_vor: II. done' 214 CALL FLUSH(numout) 215 ENDIF 216 217 ! ===================================== 218 ! III vertical integration of 3D trends 219 ! ===================================== 220 ! Beta.V : intergration, no average 221 utrd(:,:,:,9)=utrd(:,:,:,4) 222 vtrd(:,:,:,9)=vtrd(:,:,:,4) 223 224 DO jl=1,jplvor 225 226 udpvor(:,:)=0 227 vdpvor(:,:)=0 228 229 !bottom friction 230 IF( jl == jplvor ) THEN 231 232 CALL lbc_lnk( tautrd(:,:,3), 'U' , -1. ) 233 CALL lbc_lnk( tautrd(:,:,4), 'V' , -1. ) 234 235 DO jj = 2, jpjm1 236 DO ji = fs_2, fs_jpim1 237 ikbu = min( mbathy(ji+1,jj), mbathy(ji,jj) ) 238 ikbum1 = max( ikbu-1, 1 ) 239 ikbv = min( mbathy(ji,jj+1), mbathy(ji,jj) ) 240 ikbvm1 = max( ikbv-1, 1 ) 241 242 udpvor(ji,jj)=tautrd(ji,jj,3)*fse3u(ji,jj,ikbum1)*e1u(ji,jj)*umask(ji,jj,ikbum1) 243 vdpvor(ji,jj)=tautrd(ji,jj,4)*fse3v(ji,jj,ikbvm1)*e2v(ji,jj)*vmask(ji,jj,ikbvm1) 244 END DO 245 END DO 246 247 !wind stress 248 ELSE IF( jl == (jplvor-1) ) THEN 249 250 CALL lbc_lnk( tautrd(:,:,1), 'U' , -1. ) 251 CALL lbc_lnk( tautrd(:,:,2), 'V' , -1. ) 252 253 udpvor(:,:)=tautrd(:,:,1)*fse3u(:,:,1)*e1u(:,:)*umask(:,:,1) 254 vdpvor(:,:)=tautrd(:,:,2)*fse3v(:,:,1)*e2v(:,:)*vmask(:,:,1) 255 256 ELSE 257 258 CALL lbc_lnk( utrd(:,:,:,jl), 'U' , -1. ) 259 CALL lbc_lnk( vtrd(:,:,:,jl), 'V' , -1. ) 260 261 !utrd and vtrd terms 262 DO jk = 1,jpk 263 udpvor(:,:)=udpvor(:,:)+utrd(:,:,jk,jl)*fse3u(:,:,jk)*e1u(:,:)*umask(:,:,jk) 264 vdpvor(:,:)=vdpvor(:,:)+vtrd(:,:,jk,jl)*fse3v(:,:,jk)*e2v(:,:)*vmask(:,:,jk) 265 END DO 266 267 ENDIF 268 269 !average except for Beta.V 270 IF (jl/=9) THEN 271 udpvor(:,:) = udpvor(:,:) * hur(:,:) 272 vdpvor(:,:) = vdpvor(:,:) * hvr(:,:) 273 ENDIF 274 275 !Curl 276 DO ji=1,jpim1 277 DO jj=1,jpjm1 278 vortrd(ji,jj,jl)=( vdpvor(ji+1,jj)-vdpvor(ji,jj) & 279 - ( udpvor(ji,jj+1)-udpvor(ji,jj) ) ) & 280 / ( e1f(ji,jj) * e2f(ji,jj) ) 281 END DO 282 END DO 283 284 vortrd(:,:,9)=vortrd(:,:,9)*hur(:,:) 285 286 !surface mask 287 DO ji=1,jpi 288 DO jj=1,jpj 289 vortrd(ji,jj,jl)=vortrd(ji,jj,jl)*fmask(ji,jj,1) !surface mask 290 END DO 291 END DO 292 293 END DO 294 295 IF( idebug /= 0 ) THEN 296 IF(lwp) WRITE(numout,*) ' debuging trd_vor: III done' 297 CALL FLUSH(numout) 298 ENDIF 299 300 ! ================================= 301 ! IV. Cumulated trends 302 ! ================================= 303 304 ! IV.1 set `before' mixed layer values for kt = nit000+1 305 ! -------------------------------------------------------- 407 ! II.1 set `before' mixed layer values for kt = nit000+1 408 ! ------------------------------------------------------ 306 409 IF( kt == nit000+1 ) THEN 307 410 vor_avrbb(:,:) = vor_avrb(:,:) … … 310 413 311 414 IF( idebug /= 0 ) THEN 312 WRITE(numout,*) ' debuging trd_vor: I V.1 done'415 WRITE(numout,*) ' debuging trd_vor: I1.1 done' 313 416 CALL FLUSH(numout) 314 417 ENDIF 315 418 316 ! I V.2 cumulated trends over analysis period (kt=2 to nwrite)419 ! II.2 cumulated trends over analysis period (kt=2 to nwrite) 317 420 ! ---------------------- 318 421 ! trends cumulated over nwrite-2 time steps … … 328 431 329 432 IF( idebug /= 0 ) THEN 330 WRITE(numout,*) ' debuging trd_vor: I V.2 done'433 WRITE(numout,*) ' debuging trd_vor: II.2 done' 331 434 CALL FLUSH(numout) 332 435 ENDIF 333 436 334 437 ! ============================================= 335 ! V. Output in netCDF + residual computation438 ! III. Output in netCDF + residual computation 336 439 ! ============================================= 440 337 441 IF( MOD( kt - nit000+1, ntrd ) == 0 ) THEN 338 442 339 ! V.1 compute total trend443 ! III.1 compute total trend 340 444 ! ------------------------ 341 445 zmean = float(nmoydpvor) … … 346 450 IF( idebug /= 0 ) THEN 347 451 WRITE(numout,*) ' zmean = ',zmean 348 WRITE(numout,*) ' debuging trd_vor: V.1 done'452 WRITE(numout,*) ' debuging trd_vor: III.1 done' 349 453 CALL FLUSH(numout) 350 454 ENDIF 351 455 352 ! V.2 compute residual456 ! III.2 compute residual 353 457 ! --------------------- 354 458 vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean … … 359 463 360 464 IF( idebug /= 0 ) THEN 361 WRITE(numout,*) ' debuging trd_vor: V.2 done'465 WRITE(numout,*) ' debuging trd_vor: III.2 done' 362 466 CALL FLUSH(numout) 363 467 ENDIF 364 468 365 ! V.3 time evolution array swap469 ! III.3 time evolution array swap 366 470 ! ------------------------------ 367 471 vor_avrbb(:,:) = vor_avrb(:,:) … … 369 473 370 474 IF( idebug /= 0 ) THEN 371 WRITE(numout,*) ' debuging trd_vor: V.3 done'475 WRITE(numout,*) ' debuging trd_vor: III.3 done' 372 476 CALL FLUSH(numout) 373 477 ENDIF … … 377 481 ENDIF 378 482 379 ! V.5write trends to output483 ! III.4 write trends to output 380 484 ! --------------------------- 485 381 486 IF( kt >= nit000+1 ) THEN 382 487 383 #include "trdvor_ncwrite.h90" 488 ! define time axis 489 it= kt-nit000+1 490 IF( lwp .AND. MOD( kt, ntrd ) == 0 ) THEN 491 WRITE(numout,*) ' trdvor_ncwrite : write NetCDF fields' 492 ENDIF 493 494 CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,1),ndimvor1,ndexvor1) ! grad Ph 495 CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,2),ndimvor1,ndexvor1) ! Energy 496 CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,3),ndimvor1,ndexvor1) ! rel vorticity 497 CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,4),ndimvor1,ndexvor1) ! coriolis 498 CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,5),ndimvor1,ndexvor1) ! lat diff 499 CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,6),ndimvor1,ndexvor1) ! vert adv 500 CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,7),ndimvor1,ndexvor1) ! vert diff 501 CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,8),ndimvor1,ndexvor1) ! grad Ps 502 CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,9),ndimvor1,ndexvor1) ! beta.V 503 CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,10),ndimvor1,ndexvor1) ! wind stress 504 CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,11),ndimvor1,ndexvor1) ! bottom friction 505 CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot ,ndimvor1,ndexvor1) ! First membre 506 CALL histwrite( nidvor,"sovorgap",it,vor_avrres ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre 384 507 385 508 IF( idebug /= 0 ) THEN 386 WRITE(numout,*) ' debuging trd_vor: I V.5done'509 WRITE(numout,*) ' debuging trd_vor: III.4 done' 387 510 CALL FLUSH(numout) 388 511 ENDIF … … 390 513 ENDIF 391 514 392 IF( MOD( kt - nit000+1, ntrd ) == 0 ) THEN 393 rotot(:,:)=0 394 ENDIF 395 396 IF( kt == nitend ) THEN 397 CALL histclo( nidvor ) 398 ENDIF 515 IF( MOD( kt - nit000+1, ntrd ) == 0 ) rotot(:,:)=0 516 517 IF( kt == nitend ) CALL histclo( nidvor ) 399 518 400 519 END SUBROUTINE trd_vor 520 521 522 523 SUBROUTINE trd_vor_init 524 !!---------------------------------------------------------------------- 525 !! *** ROUTINE trd_vor_init *** 526 !! 527 !! ** Purpose : computation of vertically integrated T and S budgets 528 !! from ocean surface down to control surface (NetCDF output) 529 !! 530 !! ** Method/usage : 531 !! 532 !! History : 533 !! 9.0 ! 04-06 (L. Brunier, A-M. Treguier) Original code 534 !! ! 04-08 (C. Talandier) New trends organization 535 !!---------------------------------------------------------------------- 536 !! * Local declarations 537 REAL(wp) :: zjulian, zsto, zout 538 539 CHARACTER (len=40) :: clhstnam 540 CHARACTER (len=40) :: clop 541 542 NAMELIST/namtrd/ ntrd,nctls 543 !!---------------------------------------------------------------------- 544 545 ! =================== 546 ! I. initialization 547 ! =================== 548 549 cvort='averaged-vor' 550 551 ! Open specifier 552 idebug = 0 ! set it to 1 in case of problem to have more Print 553 554 ! namelist namtrd : trend diagnostic 555 REWIND( numnam ) 556 READ ( numnam, namtrd ) 557 558 IF(lwp) THEN 559 WRITE(numout,*) ' ' 560 WRITE(numout,*) 'trd_vor_init: vorticity trends' 561 WRITE(numout,*) '~~~~~~~~~~~~~' 562 WRITE(numout,*) ' ' 563 WRITE(numout,*) ' Namelist namtrd : ' 564 WRITE(numout,*) ' time step frequency trend ntrd = ',ntrd 565 WRITE(numout,*) ' ' 566 WRITE(numout,*) '##########################################################################' 567 WRITE(numout,*) ' CAUTION: The interpretation of the vorticity trends is' 568 WRITE(numout,*) ' not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr ' 569 WRITE(numout,*) '##########################################################################' 570 WRITE(numout,*) ' ' 571 ENDIF 572 573 ! cumulated trends array init 574 nmoydpvor = 0 575 rotot(:,:)=0 576 vor_avrtot(:,:)=0 577 vor_avrres(:,:)=0 578 579 IF( idebug /= 0 ) THEN 580 WRITE(numout,*) ' debuging trd_vor_init: I. done' 581 CALL FLUSH(numout) 582 ENDIF 583 584 ! ================================= 585 ! II. netCDF output initialization 586 ! ================================= 587 588 !----------------------------------------- 589 ! II.1 Define frequency of output and means 590 ! ----------------------------------------- 591 #if defined key_diainstant 592 zsto = nwrite*rdt 593 clop ="inst(x)" 594 #else 595 zsto = rdt 596 clop ="ave(x)" 597 #endif 598 zout = ntrd*rdt 599 600 IF(lwp) WRITE (numout,*) ' trdvor_ncinit: netCDF initialization' 601 602 ! II.2 Compute julian date from starting date of the run 603 ! ------------------------ 604 CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian ) 605 IF (lwp) WRITE(numout,*)' ' 606 IF (lwp) WRITE(numout,*)' Date 0 used :',nit000 & 607 ,' YEAR ', nyear,' MONTH ', nmonth,' DAY ', nday & 608 ,'Julian day : ', zjulian 609 610 ! II.3 Define the T grid trend file (nidvor) 611 ! --------------------------------- 612 CALL dia_nam( clhstnam, ntrd, 'vort' ) ! filename 613 IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 614 CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit 615 & 1, jpj, 0, zjulian, rdt, nh_t, nidvor) 616 CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface 617 618 ! Declare output fields as netCDF variables 619 CALL histdef( nidvor, "sovortPh", cvort//"grad Ph" , "s-2", & ! grad Ph 620 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 621 CALL histdef( nidvor, "sovortEk", cvort//"Energy", "s-2", & ! Energy 622 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 623 CALL histdef( nidvor, "sovozeta", cvort//"rel vorticity", "s-2", & ! rel vorticity 624 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 625 CALL histdef( nidvor, "sovortif", cvort//"coriolis", "s-2", & ! coriolis 626 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 627 CALL histdef( nidvor, "sovodifl", cvort//"lat diff ", "s-2", & ! lat diff 628 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 629 CALL histdef( nidvor, "sovoadvv", cvort//"vert adv", "s-2", & ! vert adv 630 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 631 CALL histdef( nidvor, "sovodifv", cvort//"vert diff" , "s-2", & ! vert diff 632 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 633 CALL histdef( nidvor, "sovortPs", cvort//"grad Ps", "s-2", & ! grad Ps 634 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 635 CALL histdef( nidvor, "sovortbv", cvort//"Beta V", "s-2", & ! beta.V 636 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 637 CALL histdef( nidvor, "sovowind", cvort//"wind stress", "s-2", & ! wind stress 638 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 639 CALL histdef( nidvor, "sovobfri", cvort//"bottom friction", "s-2", & ! bottom friction 640 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 641 CALL histdef( nidvor, "1st_mbre", cvort//"1st mbre", "s-2", & ! First membre 642 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 643 CALL histdef( nidvor, "sovorgap", cvort//"gap", "s-2", & ! gap between 1st and 2 nd mbre 644 & jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout) 645 CALL histend( nidvor ) 646 647 IF( idebug /= 0 ) THEN 648 WRITE(numout,*) ' debuging trd_vor_init: II. done' 649 CALL FLUSH(numout) 650 ENDIF 651 652 END SUBROUTINE trd_vor_init 401 653 402 654 #else … … 405 657 !!---------------------------------------------------------------------- 406 658 LOGICAL, PUBLIC :: lk_trdvor = .FALSE. ! momentum trend flag 659 660 !! * Interfaces 661 INTERFACE trd_vor_zint 662 MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d 663 END INTERFACE 664 407 665 CONTAINS 408 666 SUBROUTINE trd_vor( kt ) ! Empty routine 409 667 WRITE(*,*) 'trd_vor: You should not have seen this print! error?', kt 410 668 END SUBROUTINE trd_vor 669 SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 670 REAL, DIMENSION(:,:), INTENT( inout ) :: & 671 putrdvor, pvtrdvor ! U and V momentum trends 672 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 673 WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1) 674 WRITE(*,*) ' " " : You should not have seen this print! error?', pvtrdvor(1,1) 675 WRITE(*,*) ' " " : You should not have seen this print! error?', ktrd 676 END SUBROUTINE trd_vor_zint_2d 677 SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 678 REAL, DIMENSION(:,:,:), INTENT( inout ) :: & 679 putrdvor, pvtrdvor ! U and V momentum trends 680 INTEGER, INTENT( in ) :: ktrd ! ocean trend index 681 WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1) 682 WRITE(*,*) ' " " : You should not have seen this print! error?', pvtrdvor(1,1,1) 683 WRITE(*,*) ' " " : You should not have seen this print! error?', ktrd 684 END SUBROUTINE trd_vor_zint_3d 685 SUBROUTINE trd_vor_init ! Empty routine 686 WRITE(*,*) 'trd_vor_init: You should not have seen this print! error?' 687 END SUBROUTINE trd_vor_init 411 688 #endif 412 413 689 !!====================================================================== 414 690 END MODULE trdvor
Note: See TracChangeset
for help on using the changeset viewer.
