Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r2715 r3294 28 28 USE ldftra_oce ! ocean active tracers: lateral physics 29 29 USE ldfdyn_oce ! ocean dynamics: lateral physics 30 USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv 30 31 USE sol_oce ! solver variables 31 32 USE sbc_oce ! Surface boundary condition: ocean fields … … 46 47 USE limwri_2 47 48 #endif 48 USE dtatem49 USE dtasal50 49 USE lib_mpp ! MPP library 50 USE timing ! preformance summary 51 USE wrk_nemo ! working array 51 52 52 53 IMPLICIT NONE … … 116 117 !! ** Method : use iom_put 117 118 !!---------------------------------------------------------------------- 118 USE oce, ONLY : z3d => ta ! use ta as 3D workspace119 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released120 USE wrk_nemo, ONLY: z2d => wrk_2d_1121 119 !! 122 120 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 124 122 INTEGER :: ji, jj, jk ! dummy loop indices 125 123 REAL(wp) :: zztmp, zztmpx, zztmpy ! 124 !! 125 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 126 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace 126 127 !!---------------------------------------------------------------------- 127 128 ! 128 IF( wrk_in_use(2, 1))THEN129 CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.')130 RETURN131 END IF129 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 130 ! 131 CALL wrk_alloc( jpi , jpj , z2d ) 132 CALL wrk_alloc( jpi , jpj, jpk , z3d ) 132 133 ! 133 134 ! Output the initial state and forcings … … 137 138 ENDIF 138 139 139 CALL iom_put( "toce" , t n) ! temperature140 CALL iom_put( "soce" , sn) ! salinity141 CALL iom_put( "sst" , t n(:,:,1)) ! sea surface temperature142 CALL iom_put( "sst2" , t n(:,:,1) * tn(:,:,1) ) ! square of sea surface temperature143 CALL iom_put( "sss" , sn(:,:,1)) ! sea surface salinity144 CALL iom_put( "sss2" , sn(:,:,1) * sn(:,:,1) ) ! square of sea surface salinity145 CALL iom_put( "uoce" , un ) ! i-current146 CALL iom_put( "voce" , vn ) ! j-current140 CALL iom_put( "toce" , tsn(:,:,:,jp_tem) ) ! temperature 141 CALL iom_put( "soce" , tsn(:,:,:,jp_sal) ) ! salinity 142 CALL iom_put( "sst" , tsn(:,:,1,jp_tem) ) ! sea surface temperature 143 CALL iom_put( "sst2" , tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) ) ! square of sea surface temperature 144 CALL iom_put( "sss" , tsn(:,:,1,jp_sal) ) ! sea surface salinity 145 CALL iom_put( "sss2" , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) ) ! square of sea surface salinity 146 CALL iom_put( "uoce" , un ) ! i-current 147 CALL iom_put( "voce" , vn ) ! j-current 147 148 148 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.149 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef.149 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 150 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 150 151 IF( lk_zdfddm ) THEN 151 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef.152 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. 152 153 ENDIF 153 154 154 155 DO jj = 2, jpjm1 ! sst gradient 155 156 DO ji = fs_2, fs_jpim1 ! vector opt. 156 zztmp = t n(ji,jj,1)157 zztmpx = ( t n(ji+1,jj ,1) - zztmp ) / e1u(ji,jj) + ( zztmp - tn(ji-1,jj ,1) ) / e1u(ji-1,jj )158 zztmpy = ( t n(ji ,jj+1,1) - zztmp ) / e2v(ji,jj) + ( zztmp - tn(ji ,jj-1,1) ) / e2v(ji ,jj-1)157 zztmp = tsn(ji,jj,1,jp_tem) 158 zztmpx = ( tsn(ji+1,jj ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) / e1u(ji-1,jj ) 159 zztmpy = ( tsn(ji ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) / e2v(ji ,jj-1) 159 160 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 160 161 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) … … 178 179 DO jj = 2, jpjm1 179 180 DO ji = fs_2, fs_jpim1 ! vector opt. 180 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( t n(ji,jj,jk) + tn(ji+1,jj,jk) )181 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 181 182 END DO 182 183 END DO … … 192 193 DO jj = 2, jpjm1 193 194 DO ji = fs_2, fs_jpim1 ! vector opt. 194 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( t n(ji,jj,jk) + tn(ji,jj+1,jk) )195 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 195 196 END DO 196 197 END DO … … 200 201 ENDIF 201 202 ! 202 IF( wrk_not_released(2, 1))THEN203 CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.')204 RETURN205 END IF203 CALL wrk_dealloc( jpi , jpj , z2d ) 204 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 205 ! 206 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 206 207 ! 207 208 END SUBROUTINE dia_wri … … 224 225 !! Each nwrite time step, output the instantaneous or mean fields 225 226 !!---------------------------------------------------------------------- 226 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released227 USE wrk_nemo, ONLY: zw2d => wrk_2d_1228 227 !! 229 228 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 232 231 CHARACTER (len=40) :: clhstnam, clop, clmx ! local names 233 232 INTEGER :: inum = 11 ! temporary logical unit 233 INTEGER :: ji, jj, jk ! dummy loop indices 234 INTEGER :: ierr ! error code return from allocation 234 235 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 235 236 REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars 237 !! 238 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace 239 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace 236 240 !!---------------------------------------------------------------------- 237 ! 238 IF( wrk_in_use(2, 1))THEN239 CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.')240 RETURN241 END IF241 ! 242 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 243 ! 244 CALL wrk_alloc( jpi , jpj , zw2d ) 245 IF ( ln_traldf_gdia ) call wrk_alloc( jpi , jpj , jpk , zw3d ) 242 246 ! 243 247 ! Output the initial state and forcings … … 446 450 CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! un 447 451 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 452 IF( ln_traldf_gdia ) THEN 453 CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv 454 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 455 ELSE 448 456 #if defined key_diaeiv 449 CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv457 CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv 450 458 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 451 459 #endif 460 END IF 452 461 ! !!! nid_U : 2D 453 462 CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau … … 459 468 CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! vn 460 469 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 470 IF( ln_traldf_gdia ) THEN 471 CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv 472 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 473 ELSE 461 474 #if defined key_diaeiv 462 CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv475 CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv 463 476 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 464 477 #endif 478 END IF 465 479 ! !!! nid_V : 2D 466 480 CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau … … 472 486 CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! wn 473 487 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 488 IF( ln_traldf_gdia ) THEN 489 CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv 490 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 491 ELSE 474 492 #if defined key_diaeiv 475 CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv 476 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 477 #endif 493 CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv 494 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 495 #endif 496 END IF 478 497 CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt 479 498 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) … … 516 535 517 536 ! Write fields on T grid 518 CALL histwrite( nid_T, "votemper", it, t n, ndim_T , ndex_T ) ! temperature519 CALL histwrite( nid_T, "vosaline", it, sn, ndim_T , ndex_T ) ! salinity520 CALL histwrite( nid_T, "sosstsst", it, t n(:,:,1), ndim_hT, ndex_hT ) ! sea surface temperature521 CALL histwrite( nid_T, "sosaline", it, sn(:,:,1), ndim_hT, ndex_hT ) ! sea surface salinity537 CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem), ndim_T , ndex_T ) ! temperature 538 CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal), ndim_T , ndex_T ) ! salinity 539 CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem), ndim_hT, ndex_hT ) ! sea surface temperature 540 CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT ) ! sea surface salinity 522 541 CALL histwrite( nid_T, "sossheig", it, sshn , ndim_hT, ndex_hT ) ! sea surface height 523 542 !!$#if defined key_lim3 || defined key_lim2 … … 528 547 !!$ CALL histwrite( nid_T, "sorunoff", it, runoff , ndim_hT, ndex_hT ) ! runoff 529 548 CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf ) , ndim_hT, ndex_hT ) ! c/d water flux 530 zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * sn(:,:,1) * tmask(:,:,1)549 zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 531 550 CALL histwrite( nid_T, "sosalflx", it, zw2d , ndim_hT, ndex_hT ) ! c/d salt flux 532 551 CALL histwrite( nid_T, "sohefldo", it, qns + qsr , ndim_hT, ndex_hT ) ! total heat flux … … 539 558 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 540 559 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 541 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)560 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 542 561 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 543 562 #endif … … 545 564 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 546 565 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 547 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)566 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 548 567 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 549 568 #endif … … 570 589 ! Write fields on U grid 571 590 CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current 591 IF( ln_traldf_gdia ) THEN 592 IF (.not. ALLOCATED(psix_eiv))THEN 593 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 594 IF( lk_mpp ) CALL mpp_sum ( ierr ) 595 IF( ierr > 0 ) CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv') 596 psix_eiv(:,:,:) = 0.0_wp 597 psiy_eiv(:,:,:) = 0.0_wp 598 ENDIF 599 DO jk=1,jpkm1 600 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz 601 END DO 602 zw3d(:,:,jpk) = 0._wp 603 CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U ) ! i-eiv current 604 ELSE 572 605 #if defined key_diaeiv 573 CALL histwrite( nid_U, "vozoeivu", it, u_eiv , ndim_U , ndex_U ) ! i-eiv current 574 #endif 606 CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U ) ! i-eiv current 607 #endif 608 ENDIF 575 609 CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress 576 610 577 611 ! Write fields on V grid 578 612 CALL histwrite( nid_V, "vomecrty", it, vn , ndim_V , ndex_V ) ! j-current 613 IF( ln_traldf_gdia ) THEN 614 DO jk=1,jpk-1 615 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz 616 END DO 617 zw3d(:,:,jpk) = 0._wp 618 CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V ) ! j-eiv current 619 ELSE 579 620 #if defined key_diaeiv 580 CALL histwrite( nid_V, "vomeeivv", it, v_eiv , ndim_V , ndex_V ) ! j-eiv current 581 #endif 621 CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V ) ! j-eiv current 622 #endif 623 ENDIF 582 624 CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress 583 625 584 626 ! Write fields on W grid 585 627 CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current 628 IF( ln_traldf_gdia ) THEN 629 DO jk=1,jpk-1 630 DO jj = 2, jpjm1 631 DO ji = fs_2, fs_jpim1 ! vector opt. 632 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + & 633 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 634 END DO 635 END DO 636 END DO 637 zw3d(:,:,jpk) = 0._wp 638 CALL histwrite( nid_W, "voveeivw", it, zw3d , ndim_T, ndex_T ) ! vert. eiv current 639 ELSE 586 640 # if defined key_diaeiv 587 CALL histwrite( nid_W, "voveeivw", it, w_eiv , ndim_T, ndex_T ) ! vert. eiv current641 CALL histwrite( nid_W, "voveeivw", it, w_eiv , ndim_T, ndex_T ) ! vert. eiv current 588 642 # endif 643 ENDIF 589 644 CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef. 590 645 CALL histwrite( nid_W, "votkeavm", it, avmu , ndim_T, ndex_T ) ! T vert. eddy visc. coef. … … 608 663 ENDIF 609 664 ! 610 IF( wrk_not_released(2, 1))THEN611 CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.')612 RETURN613 END IF665 CALL wrk_dealloc( jpi , jpj , zw2d ) 666 IF ( ln_traldf_gdia ) call wrk_dealloc( jpi , jpj , jpk , zw3d ) 667 ! 668 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 614 669 ! 615 670 END SUBROUTINE dia_wri … … 640 695 REAL(wp) :: zsto, zout, zmax, zjulian, zdt 641 696 !!---------------------------------------------------------------------- 697 ! 698 IF( nn_timing == 1 ) CALL timing_start('dia_wri_state') 642 699 643 700 ! 0. Initialisation … … 711 768 712 769 ! Write all fields on T grid 713 CALL histwrite( id_i, "votemper", kt, t n, jpi*jpj*jpk, idex ) ! now temperature714 CALL histwrite( id_i, "vosaline", kt, sn, jpi*jpj*jpk, idex ) ! now salinity715 CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height716 CALL histwrite( id_i, "vozocrtx", kt, un , jpi*jpj*jpk, idex ) ! now i-velocity717 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity718 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity719 CALL histwrite( id_i, "sowaflup", kt, (emp-rnf ), jpi*jpj , idex ) ! freshwater budget720 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux721 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux722 CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction723 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress724 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress770 CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex ) ! now temperature 771 CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex ) ! now salinity 772 CALL histwrite( id_i, "sossheig", kt, sshn , jpi*jpj , idex ) ! sea surface height 773 CALL histwrite( id_i, "vozocrtx", kt, un , jpi*jpj*jpk, idex ) ! now i-velocity 774 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 775 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 776 CALL histwrite( id_i, "sowaflup", kt, (emp-rnf ) , jpi*jpj , idex ) ! freshwater budget 777 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux 778 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux 779 CALL histwrite( id_i, "soicecov", kt, fr_i , jpi*jpj , idex ) ! ice fraction 780 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 781 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 725 782 726 783 ! 3. Close the file … … 735 792 ENDIF 736 793 #endif 794 795 IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') 796 ! 737 797 738 798 END SUBROUTINE dia_wri_state
Note: See TracChangeset
for help on using the changeset viewer.
