- Timestamp:
- 2021-10-21T11:19:25+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/r14075_India_uncoupled/src/OCE/DIA/diaharm.F90
r14075 r15422 5 5 !!====================================================================== 6 6 !! History : 3.1 ! 2007 (O. Le Galloudec, J. Chanut) Original code 7 !! 8 !! NB: 2017-12 : add 3D harmonic analysis of velocities 9 !! integration of Maria Luneva's development 10 !! 'key_3Ddiaharm 7 11 !!---------------------------------------------------------------------- 8 12 USE oce ! ocean dynamics and tracers variables … … 13 17 USE sbctide ! Tidal forcing or not 14 18 ! 19 # if defined key_3Ddiaharm 20 USE zdf_oce 21 #endif 22 ! 15 23 USE in_out_manager ! I/O units 16 24 USE iom ! I/0 library … … 33 41 INTEGER :: nb_ana ! Number of harmonics to analyse 34 42 35 INTEGER , ALLOCATABLE, DIMENSION(:) :: name 36 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ana_temp 37 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ana_freq, ut, vt, ft 38 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: out_eta, out_u, out_v 43 INTEGER , ALLOCATABLE, DIMENSION(:) :: name 44 REAL(wp), ALLOCATABLE, DIMENSION(:) :: ana_freq, ut, vt, ft 45 # if defined key_3Ddiaharm 46 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: ana_temp 47 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: out_eta, out_u, out_v, out_w, out_dzi 48 # else 49 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ana_temp 50 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: out_eta, out_u, out_v 51 # endif 39 52 40 53 INTEGER :: ninco, nsparse … … 76 89 WRITE(numout,*) 77 90 WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization' 91 # if defined key_3Ddiaharm 92 WRITE(numout,*) ' - 3D harmonic analysis of currents activated (key_3Ddiaharm)' 93 #endif 78 94 WRITE(numout,*) '~~~~~~~~~~~~~ ' 79 95 ENDIF … … 155 171 ! Initialize temporary arrays: 156 172 ! ---------------------------- 157 ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 158 ana_temp(:,:,:,:) = 0._wp 173 # if defined key_3Ddiaharm 174 ALLOCATE( ana_temp( jpi, jpj, 2*nb_ana, 5, jpk ) ) 175 ana_temp(:,:,:,:,:) = 0._wp 176 # else 177 ALLOCATE( ana_temp( jpi, jpj, 2*nb_ana, 3 ) ) 178 ana_temp(:,:,:,: ) = 0._wp 179 #endif 159 180 160 181 ENDIF … … 175 196 ! 176 197 INTEGER :: ji, jj, jh, jc, nhc 198 # if defined key_3Ddiaharm 199 INTEGER :: jk 200 # endif 177 201 REAL(wp) :: ztime, ztemp 178 202 !!-------------------------------------------------------------------- … … 190 214 & +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 191 215 ! 216 ! ssh, ub, vb are stored at the last level of 5d array 192 217 DO jj = 2, jpjm1 193 218 DO ji = 2, jpim1 194 ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp * sshn(ji,jj) * ssmask (ji,jj) ! elevation 195 ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp * un_b(ji,jj) * ssumask(ji,jj) ! u-vel 196 ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp * vn_b(ji,jj) * ssvmask(ji,jj) ! v-vel 219 ! Elevation and currents 220 # if defined key_3Ddiaharm 221 ana_temp(ji,jj,nhc,1,jpk) = ana_temp(ji,jj,nhc,1,jpk) + ztemp*sshn(ji,jj)*ssmask (ji,jj) 222 ana_temp(ji,jj,nhc,2,jpk) = ana_temp(ji,jj,nhc,2,jpk) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 223 ana_temp(ji,jj,nhc,3,jpk) = ana_temp(ji,jj,nhc,3,jpk) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 224 225 ana_temp(ji,jj,nhc,5,jpk) = ana_temp(ji,jj,nhc,5,jpk) & 226 & + ztemp*bfrva(ji,jj)*vn(ji,jj,mbkv(ji,jj))*ssvmask(ji,jj) 227 ana_temp(ji,jj,nhc,4,jpk) = ana_temp(ji,jj,nhc,4,jpk) & 228 & + ztemp*bfrua(ji,jj)*un(ji,jj,mbku(ji,jj))*ssumask(ji,jj) 229 # else 230 ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztemp*sshn(ji,jj)*ssmask (ji,jj) 231 ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztemp*un_b(ji,jj)*ssumask(ji,jj) 232 ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztemp*vn_b(ji,jj)*ssvmask(ji,jj) 233 # endif 197 234 END DO 198 235 END DO 236 ! 237 # if defined key_3Ddiaharm 238 ! 3d velocity and density: 239 DO jk=1,jpk-1 240 DO jj = 1,jpj 241 DO ji = 1,jpi 242 ! density and velocity 243 ana_temp(ji,jj,nhc,1,jk) = ana_temp(ji,jj,nhc,1,jk) + ztemp*rhd(ji,jj,jk) 244 ana_temp(ji,jj,nhc,2,jk) = ana_temp(ji,jj,nhc,2,jk) + ztemp*(un(ji,jj,jk)-un_b(ji,jj)) & 245 & *umask(ji,jj,jk) 246 ana_temp(ji,jj,nhc,3,jk) = ana_temp(ji,jj,nhc,3,jk) + ztemp*(vn(ji,jj,jk)-vn_b(ji,jj)) & 247 & *vmask(ji,jj,jk) 248 ana_temp(ji,jj,nhc,4,jk) = ana_temp(ji,jj,nhc,4,jk) + ztemp*wn(ji,jj,jk) 249 250 ana_temp(ji,jj,nhc,5,jk) = ana_temp(ji,jj,nhc,5,jk) - 0.5*grav*ztemp*(rhd(ji,jj,jk)+rhd(ji,jj,jk+1))/max(rn2(ji,jj,jk),1.e-8_wp) 251 END DO 252 END DO 253 ENDDO 254 # endif 199 255 END DO 200 256 END DO … … 218 274 !!-------------------------------------------------------------------- 219 275 INTEGER :: ji, jj, jh, jc, jn, nhan 276 # if defined key_3Ddiaharm 277 INTEGER :: jk 278 # endif 220 279 INTEGER :: ksp, kun, keq 221 280 REAL(wp) :: ztime, ztime_ini, ztime_end, z1_han … … 226 285 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 227 286 228 ALLOCATE( out_eta(jpi,jpj,2*nb_ana), out_u(jpi,jpj,2*nb_ana), out_v(jpi,jpj,2*nb_ana) )229 230 287 ztime_ini = nit000_han*rdt ! Initial time in seconds at the beginning of analysis 231 288 ztime_end = nitend_han*rdt ! Final time in seconds at the end of analysis … … 233 290 z1_han = 1._wp / REAL(nhan-1) 234 291 292 # if defined key_3Ddiaharm 293 ALLOCATE( out_eta(jpi,jpj,jpk,2*nb_ana), & 294 & out_u (jpi,jpj,jpk,2*nb_ana), & 295 & out_v (jpi,jpj,jpk,2*nb_ana), & 296 & out_w (jpi,jpj,jpk,2*nb_ana), & 297 & out_dzi(jpi,jpj,jpk,2*nb_ana) ) 298 # else 299 ALLOCATE( out_eta(jpi,jpj,2*nb_ana), & 300 & out_u (jpi,jpj,2*nb_ana), & 301 & out_v (jpi,jpj,2*nb_ana) ) 302 # endif 303 304 IF(lwp) WRITE(numout,*) 'ANA F OLD', ft 305 IF(lwp) WRITE(numout,*) 'ANA U OLD', ut 306 IF(lwp) WRITE(numout,*) 'ANA V OLD', vt 307 235 308 ninco = 2*nb_ana 236 309 … … 260 333 CALL SUR_DETERMINE_INIT 261 334 262 ! Elevation: 335 ! Density and Elevation: 336 # if defined key_3Ddiaharm 337 DO jk=1,jpk 338 # endif 263 339 DO jj = 2, jpjm1 264 340 DO ji = 2, jpim1 265 341 266 342 ! Fill input array 343 # if defined key_3Ddiaharm 344 ztmp4(1:nb_ana*2) = ana_temp(ji,jj,1:nb_ana*2,1,jk) 345 # else 267 346 ztmp4(1:nb_ana*2) = ana_temp(ji,jj,1:nb_ana*2,1) 347 # endif 268 348 CALL SUR_DETERMINE 269 349 270 350 ! Fill output array 271 351 DO jh = 1, nb_ana 272 out_eta(ji,jj,jh ) = ztmp7((jh-1)*2+1) * ssmask(ji,jj) 273 out_eta(ji,jj,jh+nb_ana) = -ztmp7((jh-1)*2+2) * ssmask(ji,jj) 352 # if defined key_3Ddiaharm 353 out_eta(ji,jj,jk,jh ) = ztmp7((jh-1)*2+1) * ssmask(ji,jj) 354 out_eta(ji,jj,jk,jh+nb_ana) = -ztmp7((jh-1)*2+2) * ssmask(ji,jj) 355 # else 356 out_eta(ji,jj, jh ) = ztmp7((jh-1)*2+1) * ssmask(ji,jj) 357 out_eta(ji,jj, jh+nb_ana) = -ztmp7((jh-1)*2+2) * ssmask(ji,jj) 358 # endif 274 359 END DO 275 360 END DO … … 281 366 282 367 ! Fill input array 368 # if defined key_3Ddiaharm 369 ztmp4(1:nb_ana*2) = ana_temp(ji,jj,1:nb_ana*2,2,jk) 370 # else 283 371 ztmp4(1:nb_ana*2) = ana_temp(ji,jj,1:nb_ana*2,2) 372 # endif 284 373 CALL SUR_DETERMINE 285 374 286 375 ! Fill output array 287 376 DO jh = 1, nb_ana 288 out_u(ji,jj, jh) = ztmp7((jh-1)*2+1) * ssumask(ji,jj) 289 out_u(ji,jj,nb_ana+jh) = -ztmp7((jh-1)*2+2) * ssumask(ji,jj) 377 # if defined key_3Ddiaharm 378 out_u(ji,jj,jk, jh) = ztmp7((jh-1)*2+1) * ssumask(ji,jj) 379 out_u(ji,jj,jk,nb_ana+jh) = -ztmp7((jh-1)*2+2) * ssumask(ji,jj) 380 # else 381 out_u(ji,jj, jh) = ztmp7((jh-1)*2+1) * ssumask(ji,jj) 382 out_u(ji,jj, nb_ana+jh) = -ztmp7((jh-1)*2+2) * ssumask(ji,jj) 383 # endif 384 290 385 END DO 291 386 … … 298 393 299 394 ! Fill input array 395 # if defined key_3Ddiaharm 396 ztmp4(1:nb_ana*2) = ana_temp(ji,jj,1:nb_ana*2,3,jk) 397 # else 300 398 ztmp4(1:nb_ana*2) = ana_temp(ji,jj,1:nb_ana*2,3) 399 # endif 301 400 CALL SUR_DETERMINE 302 401 303 402 ! Fill output array 304 403 DO jh = 1, nb_ana 305 out_v(ji,jj, jh) = ztmp7((jh-1)*2+1) * ssvmask(ji,jj) 306 out_v(ji,jj,nb_ana+jh) = -ztmp7((jh-1)*2+2) * ssvmask(ji,jj) 404 # if defined key_3Ddiaharm 405 out_v(ji,jj,jk, jh) = ztmp7((jh-1)*2+1) * ssvmask(ji,jj) 406 out_v(ji,jj,jk,nb_ana+jh) = -ztmp7((jh-1)*2+2) * ssvmask(ji,jj) 407 # else 408 out_v(ji,jj, jh) = ztmp7((jh-1)*2+1) * ssvmask(ji,jj) 409 out_v(ji,jj, nb_ana+jh) = -ztmp7((jh-1)*2+2) * ssvmask(ji,jj) 410 # endif 307 411 END DO 308 412 309 413 END DO 310 414 END DO 415 416 # if defined key_3Ddiaharm 417 ! w- velocity 418 DO jj = 1, jpj 419 DO ji = 1, jpi 420 ! Fill input array 421 kun=0 422 DO jh = 1,nb_ana 423 DO jc = 1,2 424 kun = kun + 1 425 ztmp4(kun)=ana_temp(ji,jj,kun,4,jk) 426 END DO 427 END DO 428 429 CALL SUR_DETERMINE(jj+1) 430 431 ! Fill output array 432 DO jh = 1, nb_ana 433 ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 434 ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 435 END DO 436 437 END DO 438 END DO 439 440 DO jj = 1, jpj 441 DO ji = 1, jpi 442 DO jh = 1, nb_ana 443 X1=ana_amp(ji,jj,jh,1) 444 X2=-ana_amp(ji,jj,jh,2) 445 out_w(ji,jj,jk, jh)=X1 * tmask_i(ji,jj) 446 out_w(ji,jj,jk,nb_ana+jh)=X2 * tmask_i(ji,jj) 447 END DO 448 END DO 449 END DO 450 451 ! dzi- isopycnal displacements 452 DO jj = 1, jpj 453 DO ji = 1, jpi 454 ! Fill input array 455 kun=0 456 DO jh = 1,nb_ana 457 DO jc = 1,2 458 kun = kun + 1 459 ztmp4(kun)=ana_temp(ji,jj,kun,5,jk) 460 END DO 461 END DO 462 463 CALL SUR_DETERMINE(jj+1) 464 465 ! Fill output array 466 DO jh = 1, nb_ana 467 ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1) 468 ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2) 469 END DO 470 471 END DO 472 END DO 473 474 DO jj = 1, jpj 475 DO ji = 1, jpi 476 DO jh = 1, nb_ana 477 X1=ana_amp(ji,jj,jh,1) 478 X2=-ana_amp(ji,jj,jh,2) 479 out_dzi(ji,jj,jk, jh)=X1 * tmask_i(ji,jj) 480 out_dzi(ji,jj,jk,nb_ana+jh)=X2 * tmask_i(ji,jj) 481 END DO 482 END DO 483 END DO 484 485 ENDDO ! jk 486 # endif 311 487 ! 312 488 ! clem: we could avoid this call if all the loops were from 1:jpi and 1:jpj … … 328 504 !!-------------------------------------------------------------------- 329 505 INTEGER :: jh 330 !!---------------------------------------------------------------------- 506 507 # if defined key_3Ddiaharm 508 CHARACTER(LEN=lc) :: cdfile_name_W ! name of the file created (W-points) 509 INTEGER :: jk 510 REAL(WP), ALLOCATABLE, DIMENSION (:,:,:) :: z3real, z3im 511 REAL(WP), ALLOCATABLE, DIMENSION (:,:) :: z2real, z2im 512 # endif 513 !!---------------------------------------------------------------------- 514 515 #if defined key_dimgout 516 cdfile_name_T = TRIM(cexper)//'_Tidal_harmonics_gridT.dimgproc' 517 cdfile_name_U = TRIM(cexper)//'_Tidal_harmonics_gridU.dimgproc' 518 cdfile_name_V = TRIM(cexper)//'_Tidal_harmonics_gridV.dimgproc' 519 # if defined key_3Ddiaharm 520 cdfile_name_W = TRIM(cexper)//'_Tidal_harmonics_gridW.dimgproc' 521 # endif 522 #endif 331 523 332 524 IF(lwp) WRITE(numout,*) ' ' 333 525 IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results' 526 #if defined key_dimgout 527 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ Output files: ', TRIM(cdfile_name_T) 528 IF(lwp) WRITE(numout,*) ' ', TRIM(cdfile_name_U) 529 IF(lwp) WRITE(numout,*) ' ', TRIM(cdfile_name_V) 530 # if defined key_3Ddiaharm 531 IF(lwp) WRITE(numout,*) ' ', TRIM(cdfile_name_W) 532 # endif 533 #endif 334 534 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 335 535 336 ! A) Elevation 536 # if defined key_3Ddiaharm 537 ALLOCATE(z3real(jpi,jpj,jpk),z3im(jpi,jpj,jpk),z2real(jpi,jpj),z2im(jpi,jpj)) 538 # endif 539 540 ! A) density and elevation 337 541 !///////////// 542 #if defined key_dimgout 543 cltext='density amplitude and phase; elevation is level=jpk ' 544 CALL dia_wri_dimg(TRIM(cdfile_name_T), TRIM(cltext), out_eta, 2*nb_ana, '2') 545 #else 546 # if defined key_3Ddiaharm 547 z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp 548 # endif 338 549 DO jh = 1, nb_ana 550 # if defined key_3Ddiaharm 551 DO jk=1,jpkm1 552 z3real(:,:,jk)=out_eta(:,:,jk,jh) 553 z3im (:,:,jk)=out_eta(:,:,jk,jh+nb_ana) 554 ENDDO 555 z2real(:,:)=out_eta(:,:,jpk,jh); z2im(:,:)=out_eta(:,:,jpk,jh+nb_ana) 556 CALL iom_put( TRIM(tname(jh))//'x_ro', z3real(:,:,:) ) 557 CALL iom_put( TRIM(tname(jh))//'y_ro', z3im (:,:,:) ) 558 CALL iom_put( TRIM(tname(jh))//'x' , z2real(:,: ) ) 559 CALL iom_put( TRIM(tname(jh))//'y' , z2im (:,: ) ) 560 # else 561 WRITE(numout,*) "OUTPUT ORI: ", TRIM(tname(jh))//'x', ' & ', TRIM(tname(jh))//'y', MAXVAL(out_eta(:,:,jh)) 339 562 CALL iom_put( TRIM(tname(jh))//'x', out_eta(:,:,jh) ) 340 563 CALL iom_put( TRIM(tname(jh))//'y', out_eta(:,:,jh+nb_ana) ) 341 END DO 342 343 ! B) ubar 564 # endif 565 END DO 566 #endif 567 568 ! B) u 344 569 !///////// 570 #if defined key_dimgout 571 cltext='3d u amplitude and phase; ubar is the last level' 572 CALL dia_wri_dimg(TRIM(cdfile_name_U), TRIM(cltext), out_u, 2*nb_ana, '2') 573 #else 574 # if defined key_3Ddiaharm 575 z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp 576 # endif 345 577 DO jh = 1, nb_ana 346 CALL iom_put( TRIM(tname(jh))//'x_u', out_u(:,:,jh) ) 347 CALL iom_put( TRIM(tname(jh))//'y_u', out_u(:,:,jh+nb_ana) ) 348 END DO 349 350 ! C) vbar 578 # if defined key_3Ddiaharm 579 DO jk=1,jpkm1 580 z3real(:,:,jk)=out_u(:,:,jk,jh) 581 z3im (:,:,jk)=out_u(:,:,jk,jh+nb_ana) 582 ENDDO 583 z2real(:,:)=out_u(:,:,jpk,jh); z2im(:,:)=out_u(:,:,jpk,jh+nb_ana) 584 CALL iom_put( TRIM(tname(jh))//'x_u3d', z3real(:,:,:) ) 585 CALL iom_put( TRIM(tname(jh))//'y_u3d', z3im (:,:,:) ) 586 CALL iom_put( TRIM(tname(jh))//'x_u2d', z2real(:,:) ) 587 CALL iom_put( TRIM(tname(jh))//'y_u2d', z2im (:,:) ) 588 z2real(:,:)=out_w(:,:,jpk,jh); z2im(:,:)=out_w(:,:,jpk,jh+nb_ana) 589 CALL iom_put( TRIM(tname(jh))//'x_tabx', z2real(:,:) ) 590 CALL iom_put( TRIM(tname(jh))//'y_tabx', z2im (:,:) ) 591 # else 592 CALL iom_put( TRIM(tname(jh))//'x_u2d', out_u(:,:,jh) ) 593 CALL iom_put( TRIM(tname(jh))//'y_u2d', out_u(:,:,nb_ana+jh) ) 594 # endif 595 END DO 596 #endif 597 598 ! C) v 351 599 !///////// 600 #if defined key_dimgout 601 cltext='3d v amplitude and phase; vbar is the last level' 602 CALL dia_wri_dimg(TRIM(cdfile_name_V), TRIM(cltext), out_v, 2*nb_ana, '2') 603 #else 604 # if defined key_3Ddiaharm 605 z3real(:,:,:) = 0._wp; z3im(:,:,:) = 0._wp 606 # endif 352 607 DO jh = 1, nb_ana 353 CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh ) ) 354 CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) ) 355 END DO 356 ! 608 # if defined key_3Ddiaharm 609 DO jk=1,jpkm1 610 z3real(:,:,jk)=out_v(:,:,jk,jh) 611 z3im (:,:,jk)=out_v(:,:,jk,jh+nb_ana) 612 ENDDO 613 z2real(:,:)=out_v(:,:,jpk,jh); z2im(:,:)=out_v(:,:,jpk,jh+nb_ana) 614 CALL iom_put( TRIM(tname(jh))//'x_v3d', z3real(:,:,:) ) 615 CALL iom_put( TRIM(tname(jh))//'y_v3d', z3im (:,:,:) ) 616 CALL iom_put( TRIM(tname(jh))//'x_v2d' , z2real(:,:) ) 617 CALL iom_put( TRIM(tname(jh))//'y_v2d' , z2im (:,:) ) 618 z2real(:,:)=out_dzi(:,:,jpk,jh); z2im(:,:)=out_dzi(:,:,jpk,jh+nb_ana) 619 CALL iom_put( TRIM(tname(jh))//'x_taby', z2real(:,:) ) 620 CALL iom_put( TRIM(tname(jh))//'y_taby', z2im (:,:) ) 621 # else 622 CALL iom_put( TRIM(tname(jh))//'x_v2d', out_v(:,:,jh ) ) 623 CALL iom_put( TRIM(tname(jh))//'y_v2d', out_v(:,:,jh+nb_ana) ) 624 # endif 625 END DO 626 627 #endif 628 ! D) w 629 # if defined key_3Ddiaharm 630 # if defined key_dimgout 631 cltext='3d w amplitude and phase; vort_baro is the last level' 632 CALL dia_wri_dimg(TRIM(cdfile_name_W), TRIM(cltext), out_w, 2*nb_ana, '2') 633 # else 634 DO jh = 1, nb_ana 635 DO jk=1,jpkm1 636 z3real(:,:,jk)=out_w(:,:,jk,jh) 637 z3im(:,:,jk)=out_w(:,:,jk,jh+nb_ana) 638 ENDDO 639 CALL iom_put( TRIM(tname(jh))//'x_w3d', z3real(:,:,:) ) 640 CALL iom_put( TRIM(tname(jh))//'y_w3d', z3im(:,:,:) ) 641 END DO 642 # endif 643 644 ! E) dzi + tau_bot 645 # if defined key_dimgout 646 cltext='dzi=g*ro/N2 amplitude and phase' 647 CALL dia_wri_dimg(TRIM(cdfile_name_W), TRIM(cltext), out_w, 2*nb_ana, '2') 648 # else 649 DO jh = 1, nb_ana 650 DO jk=1,jpkm1 651 z3real(:,:,jk)=out_dzi(:,:,jk,jh) 652 z3im(:,:,jk)=out_dzi(:,:,jk,jh+nb_ana) 653 ENDDO 654 CALL iom_put( TRIM(tname(jh))//'x_dzi', z3real(:,:,:) ) 655 CALL iom_put( TRIM(tname(jh))//'y_dzi', z3im(:,:,:) ) 656 END DO 657 # endif 658 # endif 659 660 ! 661 # if defined key_3Ddiaharm 662 DEALLOCATE(z3real, z3im, z2real,z2im) 663 # endif 664 357 665 END SUBROUTINE dia_wri_harm 358 666
Note: See TracChangeset
for help on using the changeset viewer.
