Changeset 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
- Timestamp:
- 2015-12-21T12:35:23+01:00 (8 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90 (modified) (35 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5930 r6140 30 30 USE zdf_oce ! ocean vertical physics 31 31 USE ldftra ! lateral physics: eddy diffusivity coef. 32 USE ldfdyn ! lateral physics: eddy viscosity coef. 32 33 USE sbc_oce ! Surface boundary condition: ocean fields 33 34 USE sbc_ice ! Surface boundary condition: ice fields … … 40 41 USE zdfddm ! vertical physics: double diffusion 41 42 USE diahth ! thermocline diagnostics 43 ! 42 44 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 45 USE in_out_manager ! I/O manager 44 USE diadimg ! dimg direct access file format output 46 USE diatmb ! Top,middle,bottom output 47 USE dia25h ! 25h Mean output 45 48 USE iom 46 49 USE ioipsl … … 53 56 USE lib_mpp ! MPP library 54 57 USE timing ! preformance summary 58 USE diurnal_bulk ! diurnal warm layer 59 USE cool_skin ! Cool skin 55 60 USE wrk_nemo ! working array 56 61 … … 74 79 !! * Substitutions 75 80 # include "zdfddm_substitute.h90" 76 # include "domzgr_substitute.h90"77 81 # include "vectopt_loop_substitute.h90" 78 82 !!---------------------------------------------------------------------- … … 97 101 END FUNCTION dia_wri_alloc 98 102 99 #if defined key_dimgout100 !!----------------------------------------------------------------------101 !! 'key_dimgout' DIMG output file102 !!----------------------------------------------------------------------103 # include "diawri_dimg.h90"104 105 #else106 103 !!---------------------------------------------------------------------- 107 104 !! Default option NetCDF output file 108 105 !!---------------------------------------------------------------------- 109 # 106 #if defined key_iomput 110 107 !!---------------------------------------------------------------------- 111 108 !! 'key_iomput' use IOM library … … 143 140 ENDIF 144 141 145 IF( .NOT.lk_vvl) THEN146 CALL iom_put( "e3t" , fse3t_n(:,:,:) )147 CALL iom_put( "e3u" , fse3u_n(:,:,:) )148 CALL iom_put( "e3v" , fse3v_n(:,:,:) )149 CALL iom_put( "e3w" , fse3w_n(:,:,:) )142 IF( ln_linssh ) THEN 143 CALL iom_put( "e3t" , e3t_n(:,:,:) ) 144 CALL iom_put( "e3u" , e3u_n(:,:,:) ) 145 CALL iom_put( "e3v" , e3v_n(:,:,:) ) 146 CALL iom_put( "e3w" , e3w_n(:,:,:) ) 150 147 ENDIF 151 148 … … 204 201 CALL iom_put( "sbu", z2d ) ! bottom i-current 205 202 ENDIF 206 207 IF ( ln_dynspg_ts ) THEN208 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current209 ELSE210 CALL iom_put( "ubar", un_b(:,:) ) ! barotropic i-current211 ENDIF212 203 213 204 CALL iom_put( "voce", vn(:,:,:) ) ! 3D j-current … … 223 214 ENDIF 224 215 225 IF ( ln_dynspg_ts ) THEN226 CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic j-current227 ELSE228 CALL iom_put( "vbar", vn_b(:,:) ) ! barotropic j-current229 ENDIF230 231 216 CALL iom_put( "woce", wn ) ! vertical velocity 232 217 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value … … 266 251 DO jj = 1, jpj 267 252 DO ji = 1, jpi 268 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)253 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 269 254 END DO 270 255 END DO … … 278 263 DO jj = 1, jpj 279 264 DO ji = 1, jpi 280 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk)265 z2d(ji,jj) = z2d(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 281 266 END DO 282 267 END DO … … 290 275 DO jj = 2, jpjm1 291 276 DO ji = fs_2, fs_jpim1 ! vector opt. 292 zztmp = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )293 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) &294 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) &277 zztmp = 1._wp / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 278 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 279 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * e3u_n(ji ,jj,jk) ) & 295 280 & * zztmp 296 281 ! 297 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) &298 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) ) &282 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 283 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) & 299 284 & * zztmp 300 285 ! … … 311 296 z3d(:,:,jpk) = 0.e0 312 297 DO jk = 1, jpkm1 313 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk)298 z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 314 299 END DO 315 300 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction … … 346 331 z3d(:,:,jpk) = 0.e0 347 332 DO jk = 1, jpkm1 348 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk)333 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 349 334 END DO 350 335 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction … … 380 365 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 381 366 ! 367 ! If we want tmb values 368 369 IF (ln_diatmb) THEN 370 CALL dia_tmb 371 ENDIF 372 IF (ln_dia25h) THEN 373 CALL dia_25h( kt ) 374 ENDIF 375 382 376 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 383 377 ! … … 410 404 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 411 405 INTEGER :: jn, ierror ! local integers 412 REAL(wp) :: zsto, zout, zmax, zjulian , zdt! local scalars406 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars 413 407 ! 414 408 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace … … 418 412 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 419 413 ! 420 CALL wrk_alloc( jpi,jpj , zw2d )421 IF( lk_vvl) CALL wrk_alloc( jpi,jpj,jpk , zw3d )414 CALL wrk_alloc( jpi,jpj , zw2d ) 415 IF( .NOT.ln_linssh ) CALL wrk_alloc( jpi,jpj,jpk , zw3d ) 422 416 ! 423 417 ! Output the initial state and forcings … … 435 429 436 430 ! Define frequency of output and means 437 zdt = rdt438 IF( nacc == 1 ) zdt = rdtmin439 431 clop = "x" ! no use of the mask value (require less cpu time and otherwise the model crashes) 440 432 #if defined key_diainstant 441 zsto = nwrite * zdt433 zsto = nwrite * rdt 442 434 clop = "inst("//TRIM(clop)//")" 443 435 #else 444 zsto= zdt436 zsto=rdt 445 437 clop = "ave("//TRIM(clop)//")" 446 438 #endif 447 zout = nwrite * zdt448 zmax = ( nitend - nit000 + 1 ) * zdt439 zout = nwrite * rdt 440 zmax = ( nitend - nit000 + 1 ) * rdt 449 441 450 442 ! Define indices of the horizontal output zoom and vertical limit storage … … 488 480 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 489 481 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 490 & nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )482 & nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 491 483 CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept 492 484 & "m", ipk, gdept_1d, nz_T, "down" ) … … 524 516 CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu 525 517 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 526 & nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )518 & nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 527 519 CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept 528 520 & "m", ipk, gdept_1d, nz_U, "down" ) … … 537 529 CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv 538 530 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 539 & nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )531 & nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 540 532 CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept 541 533 & "m", ipk, gdept_1d, nz_V, "down" ) … … 550 542 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 551 543 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 552 & nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )544 & nit000-1, zjulian, rdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set ) 553 545 CALL histvert( nid_W, "depthw", "Vertical W levels", & ! Vertical grid: gdepw 554 546 & "m", ipk, gdepw_1d, nz_W, "down" ) … … 562 554 CALL histdef( nid_T, "vosaline", "Salinity" , "PSU" , & ! sn 563 555 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 564 IF( lk_vvl) THEN556 IF( .NOT.ln_linssh ) THEN 565 557 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t_n 566 558 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) … … 583 575 CALL histdef( nid_T, "sosfldow", "downward salt flux" , "PSU/m2/s", & ! sfx 584 576 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 585 IF( .NOT. lk_vvl) THEN577 IF( ln_linssh ) THEN 586 578 CALL histdef( nid_T, "sosst_cd", "Concentration/Dilution term on temperature" & ! emp * tsn(:,:,1,jp_tem) 587 579 & , "KgC/m2/s", & ! sosst_cd … … 729 721 ENDIF 730 722 731 IF( lk_vvl) THEN732 CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! heat content733 CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * fse3t_n(:,:,:) , ndim_T , ndex_T ) ! salt content734 CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content735 CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * fse3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content723 IF( .NOT.ln_linssh ) THEN 724 CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) * e3t_n(:,:,:) , ndim_T , ndex_T ) ! heat content 725 CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal) * e3t_n(:,:,:) , ndim_T , ndex_T ) ! salt content 726 CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem) * e3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content 727 CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) * e3t_n(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content 736 728 ELSE 737 729 CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem) , ndim_T , ndex_T ) ! temperature … … 740 732 CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal) , ndim_hT, ndex_hT ) ! sea surface salinity 741 733 ENDIF 742 IF( lk_vvl) THEN743 zw3d(:,:,:) = ( ( fse3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2744 CALL histwrite( nid_T, "vovvle3t", it, fse3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness745 CALL histwrite( nid_T, "vovvldep", it, fsdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth734 IF( .NOT.ln_linssh ) THEN 735 zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 736 CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T ) ! level thickness 737 CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T ) ! t-point depth 746 738 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 747 739 ENDIF … … 752 744 ! (includes virtual salt flux beneath ice 753 745 ! in linear free surface case) 754 IF( .NOT. lk_vvl) THEN746 IF( ln_linssh ) THEN 755 747 zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 756 748 CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT ) ! c/d term on sst … … 837 829 ENDIF 838 830 ! 839 CALL wrk_dealloc( jpi , jpj , zw2d )840 IF( lk_vvl) CALL wrk_dealloc( jpi , jpj , jpk , zw3d )831 CALL wrk_dealloc( jpi , jpj , zw2d ) 832 IF( .NOT.ln_linssh ) CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 841 833 ! 842 834 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') 843 835 ! 844 836 END SUBROUTINE dia_wri 845 # endif846 847 837 #endif 848 838 … … 867 857 INTEGER :: id_i , nz_i, nh_i 868 858 INTEGER, DIMENSION(1) :: idex ! local workspace 869 REAL(wp) :: zsto, zout, zmax, zjulian , zdt859 REAL(wp) :: zsto, zout, zmax, zjulian 870 860 !!---------------------------------------------------------------------- 871 861 ! … … 876 866 clname = cdfile_name 877 867 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 878 zdt = rdt879 868 zsto = rdt 880 869 clop = "inst(x)" ! no use of the mask value (require less cpu time) 881 870 zout = rdt 882 zmax = ( nitend - nit000 + 1 ) * zdt871 zmax = ( nitend - nit000 + 1 ) * rdt 883 872 884 873 IF(lwp) WRITE(numout,*) … … 895 884 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 896 885 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 897 1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit886 1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 898 887 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 899 888 "m", jpk, gdept_1d, nz_i, "down") … … 913 902 CALL histdef( id_i, "vovecrtz", "Vertical Velocity" , "m/s" , & ! vertical current 914 903 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 904 ! 905 CALL histdef( id_i, "ahtu" , "u-eddy diffusivity" , "m2/s" , & ! zonal current 906 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 907 CALL histdef( id_i, "ahtv" , "v-eddy diffusivity" , "m2/s" , & ! meridonal current 908 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 909 CALL histdef( id_i, "ahmt" , "t-eddy viscosity" , "m2/s" , & ! zonal current 910 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 911 CALL histdef( id_i, "ahmf" , "f-eddy viscosity" , "m2/s" , & ! meridonal current 912 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 913 ! 915 914 CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S", & ! net freshwater 916 915 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) … … 925 924 CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2" , & ! j-wind stress 926 925 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 927 IF( lk_vvl ) THEN 928 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 926 IF( .NOT.ln_linssh ) THEN 927 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 928 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 929 CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth 929 930 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 930 931 ENDIF … … 952 953 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 953 954 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 955 ! 956 CALL histwrite( id_i, "ahtu" , kt, ahtu , jpi*jpj*jpk, idex ) ! aht at u-point 957 CALL histwrite( id_i, "ahtv" , kt, ahtv , jpi*jpj*jpk, idex ) ! - at v-point 958 CALL histwrite( id_i, "ahmt" , kt, ahmt , jpi*jpj*jpk, idex ) ! ahm at t-point 959 CALL histwrite( id_i, "ahmf" , kt, ahmf , jpi*jpj*jpk, idex ) ! - at f-point 960 ! 954 961 CALL histwrite( id_i, "sowaflup", kt, emp-rnf , jpi*jpj , idex ) ! freshwater budget 955 962 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux … … 959 966 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 960 967 968 IF( .NOT.ln_linssh ) THEN 969 CALL histwrite( id_i, "vovvldep", kt, gdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth 970 CALL histwrite( id_i, "vovvle3t", kt, e3t_n (:,:,:) , jpi*jpj*jpk, idex )! T-cell thickness 971 END IF 961 972 ! 3. Close the file 962 973 ! ----------------- 963 974 CALL histclo( id_i ) 964 #if ! defined key_iomput && ! defined key_dimgout975 #if ! defined key_iomput 965 976 IF( ninist /= 1 ) THEN 966 977 CALL histclo( nid_T ) … … 972 983 ! 973 984 END SUBROUTINE dia_wri_state 985 974 986 !!====================================================================== 975 987 END MODULE diawri
Note: See TracChangeset
for help on using the changeset viewer.
