- Timestamp:
- 2020-06-24T14:38:26+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/DIA/diawri.F90
r12493 r13151 85 85 !! * Substitutions 86 86 # include "do_loop_substitute.h90" 87 # include "domzgr_substitute.h90" 87 88 !!---------------------------------------------------------------------- 88 89 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 136 137 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 137 138 ! 138 CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 139 CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 140 CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 141 CALL iom_put( "e3w" , e3w(:,:,:,Kmm) ) 142 IF( iom_use("e3tdef") ) & 143 CALL iom_put( "e3tdef" , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 144 145 IF( ll_wd ) THEN 146 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) ! sea surface height (brought back to the reference used for wetting and drying) 139 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t 140 DO jk = 1, jpk 141 z3d(:,:,jk) = e3t(:,:,jk,Kmm) 142 END DO 143 CALL iom_put( "e3t" , z3d(:,:,:) ) 144 CALL iom_put( "e3tdef" , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 145 ENDIF 146 IF ( iom_use("e3u") ) THEN ! time-varying e3u 147 DO jk = 1, jpk 148 z3d(:,:,jk) = e3u(:,:,jk,Kmm) 149 END DO 150 CALL iom_put( "e3u" , z3d(:,:,:) ) 151 ENDIF 152 IF ( iom_use("e3v") ) THEN ! time-varying e3v 153 DO jk = 1, jpk 154 z3d(:,:,jk) = e3v(:,:,jk,Kmm) 155 END DO 156 CALL iom_put( "e3v" , z3d(:,:,:) ) 157 ENDIF 158 IF ( iom_use("e3w") ) THEN ! time-varying e3w 159 DO jk = 1, jpk 160 z3d(:,:,jk) = e3w(:,:,jk,Kmm) 161 END DO 162 CALL iom_put( "e3w" , z3d(:,:,:) ) 163 ENDIF 164 165 IF( ll_wd ) THEN ! sea surface height (brought back to the reference used for wetting and drying) 166 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) 147 167 ELSE 148 168 CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height … … 208 228 209 229 IF( ln_zad_Aimp ) ww = ww + wi ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 210 !211 230 CALL iom_put( "woce", ww ) ! vertical velocity 231 212 232 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 213 233 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. … … 415 435 ! 416 436 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 417 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace437 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t, zgdept ! 3D workspace 418 438 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 419 439 !!---------------------------------------------------------------------- … … 455 475 it = kt 456 476 itmod = kt - nit000 + 1 477 478 ! store e3t for subsitute 479 DO jk = 1, jpk 480 ze3t (:,:,jk) = e3t (:,:,jk,Kmm) 481 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 482 END DO 457 483 458 484 … … 569 595 DEALLOCATE(zw3d_abl) 570 596 ENDIF 597 ! 571 598 572 599 ! Declare all the output fields as NETCDF variables … … 578 605 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 579 606 IF( .NOT.ln_linssh ) THEN 580 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t (:,:,:,Kmm)607 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t n 581 608 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 582 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t (:,:,:,Kmm)609 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t n 583 610 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 584 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t (:,:,:,Kmm)611 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t n 585 612 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 586 613 ENDIF … … 766 793 767 794 IF( .NOT.ln_linssh ) THEN 768 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! heat content769 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! salt content770 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface heat content771 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface salinity content795 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! heat content 796 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! salt content 797 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content 798 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content 772 799 ELSE 773 800 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T ) ! temperature … … 777 804 ENDIF 778 805 IF( .NOT.ln_linssh ) THEN 779 zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2780 CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm), ndim_T , ndex_T ) ! level thickness781 CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T ) ! t-point depth806 zw3d(:,:,:) = ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 807 CALL histwrite( nid_T, "vovvle3t", it, ze3t (:,:,:) , ndim_T , ndex_T ) ! level thickness 808 CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T ) ! t-point depth 782 809 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 783 810 ENDIF … … 918 945 !! 919 946 INTEGER :: inum, jk 947 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace !!st patch to use substitution 920 948 !!---------------------------------------------------------------------- 921 949 ! 922 IF(lwp) WRITE(numout,*) 923 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 924 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 925 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 926 927 #if defined key_si3 928 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 929 #else 930 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 931 #endif 932 950 IF(lwp) THEN 951 WRITE(numout,*) 952 WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 953 WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 954 WRITE(numout,*) ' and named :', cdfile_name, '...nc' 955 ENDIF 956 ! 957 DO jk = 1, jpk 958 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 959 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 960 END DO 961 ! 962 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 963 ! 933 964 CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature 934 965 CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity 935 CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,: ,Kmm)) ! sea surface height936 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,: ,Kmm)) ! now i-velocity937 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,: ,Kmm)) ! now j-velocity966 CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,: ,Kmm) ) ! sea surface height 967 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,: ,Kmm) ) ! now i-velocity 968 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,: ,Kmm) ) ! now j-velocity 938 969 IF( ln_zad_Aimp ) THEN 939 970 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi ) ! now k-velocity … … 942 973 ENDIF 943 974 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 944 CALL iom_rstput( 0, 0, inum, 'ht' , ht 945 975 CALL iom_rstput( 0, 0, inum, 'ht' , ht(:,:) ) ! now water column height 976 ! 946 977 IF ( ln_isf ) THEN 947 978 IF (ln_isfcav_mlt) THEN … … 949 980 CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav ) ! now k-velocity 950 981 CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav ) ! now k-velocity 951 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav, 8)) ! now k-velocity952 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav, 8)) ! now k-velocity953 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav, 8), ktype = jp_i1 )982 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) ) ! now k-velocity 983 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) ) ! now k-velocity 984 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 954 985 END IF 955 986 IF (ln_isfpar_mlt) THEN 956 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par, 8)) ! now k-velocity987 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) ) ! now k-velocity 957 988 CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par ) ! now k-velocity 958 989 CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par ) ! now k-velocity 959 990 CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par ) ! now k-velocity 960 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par, 8)) ! now k-velocity961 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par, 8)) ! now k-velocity962 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par, 8), ktype = jp_i1 )991 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) ) ! now k-velocity 992 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) ) ! now k-velocity 993 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 963 994 END IF 964 995 END IF 965 996 ! 966 997 IF( ALLOCATED(ahtu) ) THEN 967 998 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point … … 978 1009 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 979 1010 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 980 IF( .NOT.ln_linssh ) THEN 981 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)) ! T-cell depth982 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)) ! T-cell thickness1011 IF( .NOT.ln_linssh ) THEN 1012 CALL iom_rstput( 0, 0, inum, 'vovvldep', zgdept ) ! T-cell depth 1013 CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t ) ! T-cell thickness 983 1014 END IF 984 1015 IF( ln_wave .AND. ln_sdw ) THEN … … 993 1024 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 994 1025 ENDIF 995 1026 ! 1027 CALL iom_close( inum ) 1028 ! 996 1029 #if defined key_si3 997 1030 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 1031 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 998 1032 CALL ice_wri_state( inum ) 1033 CALL iom_close( inum ) 999 1034 ENDIF 1000 1035 #endif 1001 ! 1002 CALL iom_close( inum ) 1003 ! 1036 1004 1037 END SUBROUTINE dia_wri_state 1005 1038
Note: See TracChangeset
for help on using the changeset viewer.
