- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r4624 r6225 9 9 10 10 !!---------------------------------------------------------------------- 11 !! dia_hsb : Diagnose the conservation of ocean heat and salt contents, and volume 12 !! dia_hsb_rst : Read or write DIA file in restart file 13 !! dia_hsb_init : Initialization of the conservation diagnostic 14 !!---------------------------------------------------------------------- 11 15 USE oce ! ocean dynamics and tracers 12 16 USE dom_oce ! ocean space and time domain 13 17 USE phycst ! physical constants 14 18 USE sbc_oce ! surface thermohaline fluxes 15 USE in_out_manager ! I/O manager 19 USE sbcrnf ! river runoff 20 USE sbcisf ! ice shelves 16 21 USE domvvl ! vertical scale factors 17 22 USE traqsr ! penetrative solar radiation 18 23 USE trabbc ! bottom boundary condition 19 USE lib_mpp ! distributed memory computing library20 24 USE trabbc ! bottom boundary condition 21 25 USE bdy_par ! (for lk_bdy) 26 USE restart ! ocean restart 27 ! 28 USE iom ! I/O manager 29 USE in_out_manager ! I/O manager 30 USE lib_fortran ! glob_sum 31 USE lib_mpp ! distributed memory computing library 22 32 USE timing ! preformance summary 23 USE iom ! I/O manager 24 USE lib_fortran ! glob_sum 25 USE restart ! ocean restart 26 USE wrk_nemo ! work arrays 27 USE sbcrnf ! river runoffd 33 USE wrk_nemo ! work arrays 28 34 29 35 IMPLICIT NONE … … 36 42 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets 37 43 38 REAL(dp) :: surf_tot ! 39 REAL(dp) :: frc_t , frc_s , frc_v ! global forcing trends 40 REAL(dp) :: frc_wn_t , frc_wn_s ! global forcing trends 41 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 42 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 43 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini 44 REAL(wp) :: surf_tot ! ocean surface 45 REAL(wp) :: frc_t, frc_s, frc_v ! global forcing trends 46 REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends 47 ! 48 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 49 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini ! 50 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini ! 51 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 44 52 45 53 !! * Substitutions 46 # include "domzgr_substitute.h90"47 54 # include "vectopt_loop_substitute.h90" 48 49 55 !!---------------------------------------------------------------------- 50 56 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 52 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 53 59 !!---------------------------------------------------------------------- 54 55 60 CONTAINS 56 61 … … 67 72 !!--------------------------------------------------------------------------- 68 73 INTEGER, INTENT(in) :: kt ! ocean time-step index 69 !! 70 INTEGER :: jk ! dummy loop indice 71 REAL(dp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 72 REAL(dp) :: zdiff_hc1 , zdiff_sc1 ! - - - - - - - - 73 REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation 74 REAL(dp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit 75 REAL(dp) :: zvol_tot ! volume 76 REAL(dp) :: z_frc_trd_t , z_frc_trd_s ! - - 77 REAL(dp) :: z_frc_trd_v ! - - 78 REAL(dp) :: z_wn_trd_t , z_wn_trd_s ! - - 79 REAL(dp) :: z_ssh_hc , z_ssh_sc ! - - 74 ! 75 INTEGER :: ji, jj, jk ! dummy loop indice 76 REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 77 REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - 78 REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation 79 REAL(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit 80 REAL(wp) :: zvol_tot ! volume 81 REAL(wp) :: z_frc_trd_t , z_frc_trd_s ! - - 82 REAL(wp) :: z_frc_trd_v ! - - 83 REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - - 84 REAL(wp) :: z_ssh_hc , z_ssh_sc ! - - 85 REAL(wp), DIMENSION(:,:), POINTER :: z2d0, z2d1 80 86 !!--------------------------------------------------------------------------- 81 87 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 82 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 ! 90 tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 91 tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 83 92 ! ------------------------- ! 84 93 ! 1 - Trends due to forcing ! 85 94 ! ------------------------- ! 86 z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes87 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes88 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes89 ! Add runoff heat & salt input95 z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * surf(:,:) ) ! volume fluxes 96 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 97 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 98 ! Add runoff heat & salt input 90 99 IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) ) 91 100 IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 92 101 ! Add ice shelf heat & salt input 102 IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 93 103 ! Add penetrative solar radiation 94 104 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) ) … … 96 106 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) ) 97 107 ! 98 IF( .NOT. lk_vvl ) THEN 99 z_wn_trd_t = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) ) 100 z_wn_trd_s = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) ) 108 IF( ln_linssh ) THEN 109 IF( ln_isfcav ) THEN 110 DO ji=1,jpi 111 DO jj=1,jpj 112 z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem) 113 z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal) 114 END DO 115 END DO 116 ELSE 117 z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 118 z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 119 END IF 120 z_wn_trd_t = - glob_sum( z2d0 ) 121 z_wn_trd_s = - glob_sum( z2d1 ) 101 122 ENDIF 102 123 … … 105 126 frc_s = frc_s + z_frc_trd_s * rdt 106 127 ! ! Advection flux through fixed surface (z=0) 107 IF( .NOT. lk_vvl) THEN128 IF( ln_linssh ) THEN 108 129 frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 109 130 frc_wn_s = frc_wn_s + z_wn_trd_s * rdt … … 113 134 ! 2 - Content variations ! 114 135 ! ------------------------ ! 115 zdiff_v2 = 0.d0 116 zdiff_hc = 0.d0 117 zdiff_sc = 0.d0 136 ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl) 137 zdiff_v2 = 0._wp 138 zdiff_hc = 0._wp 139 zdiff_sc = 0._wp 118 140 119 141 ! volume variation (calculated with ssh) 120 zdiff_v1 = glob_sum ( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:)) )142 zdiff_v1 = glob_sum_full( surf(:,:) * sshn(:,:) - surf_ini(:,:) * ssh_ini(:,:) ) 121 143 122 144 ! heat & salt content variation (associated with ssh) 123 IF( .NOT. lk_vvl ) THEN 124 z_ssh_hc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) ) 125 z_ssh_sc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) ) 145 IF( ln_linssh ) THEN 146 IF( ln_isfcav ) THEN 147 DO ji = 1, jpi 148 DO jj = 1, jpj 149 z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 150 z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 151 END DO 152 END DO 153 ELSE 154 z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 155 z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 156 END IF 157 z_ssh_hc = glob_sum_full( z2d0 ) 158 z_ssh_sc = glob_sum_full( z2d1 ) 126 159 ENDIF 127 160 128 161 DO jk = 1, jpkm1 129 162 ! volume variation (calculated with scale factors) 130 zdiff_v2 = zdiff_v2 + glob_sum ( surf(:,:) * tmask(:,:,jk)&131 & * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk)) )163 zdiff_v2 = zdiff_v2 + glob_sum_full( surf(:,:) * tmask(:,:,jk) & 164 & * e3t_n(:,:,jk) - surf_ini(:,:) * e3t_ini(:,:,jk) ) 132 165 ! heat content variation 133 zdiff_hc = zdiff_hc + glob_sum ( surf(:,:) * tmask(:,:,jk)&134 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) )166 zdiff_hc = zdiff_hc + glob_sum_full( surf(:,:) * tmask(:,:,jk) & 167 & * e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - surf_ini(:,:) * hc_loc_ini(:,:,jk) ) 135 168 ! salt content variation 136 zdiff_sc = zdiff_sc + glob_sum ( surf(:,:) * tmask(:,:,jk)&137 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk)) )169 zdiff_sc = zdiff_sc + glob_sum_full( surf (:,:) * tmask(:,:,jk) & 170 * e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - surf_ini(:,:) * sc_loc_ini(:,:,jk) ) 138 171 ENDDO 139 172 140 173 ! Substract forcing from heat content, salt content and volume variations 141 174 zdiff_v1 = zdiff_v1 - frc_v 142 IF( lk_vvl) zdiff_v2 = zdiff_v2 - frc_v175 IF( .NOT.ln_linssh ) zdiff_v2 = zdiff_v2 - frc_v 143 176 zdiff_hc = zdiff_hc - frc_t 144 177 zdiff_sc = zdiff_sc - frc_s 145 IF( .NOT. lk_vvl) THEN178 IF( ln_linssh ) THEN 146 179 zdiff_hc1 = zdiff_hc + z_ssh_hc 147 180 zdiff_sc1 = zdiff_sc + z_ssh_sc … … 153 186 ! 3 - Diagnostics writing ! 154 187 ! ----------------------- ! 155 zvol_tot = 0.d0 ! total ocean volume188 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) 156 189 DO jk = 1, jpkm1 157 zvol_tot = zvol_tot + glob_sum ( surf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) )190 zvol_tot = zvol_tot + glob_sum_full( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) ) 158 191 END DO 159 192 160 IF( lk_vvl ) THEN 193 !!gm to be added ? 194 ! IF( ln_linssh ) THEN ! fixed volume, add the ssh contribution 195 ! zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) ) 196 ! ENDIF 197 !!gm end 198 199 IF( ln_linssh ) THEN 200 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C) 201 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) 202 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 203 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3) 204 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 205 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 206 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 207 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 208 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 209 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) 210 ELSE 161 211 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) 162 212 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu) … … 168 218 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 169 219 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 170 ELSE171 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C)172 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu)173 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J)174 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3)175 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3)176 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3)177 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C)178 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu)179 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C)180 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu)181 220 ENDIF 182 221 ! 183 222 IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' ) 184 223 ! 224 CALL wrk_dealloc( jpi,jpj, z2d0, z2d1 ) 225 ! 185 226 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') 186 !227 ! 187 228 END SUBROUTINE dia_hsb 229 230 231 SUBROUTINE dia_hsb_rst( kt, cdrw ) 232 !!--------------------------------------------------------------------- 233 !! *** ROUTINE limdia_rst *** 234 !! 235 !! ** Purpose : Read or write DIA file in restart file 236 !! 237 !! ** Method : use of IOM library 238 !!---------------------------------------------------------------------- 239 INTEGER , INTENT(in) :: kt ! ocean time-step 240 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 241 ! 242 INTEGER :: ji, jj, jk ! dummy loop indices 243 INTEGER :: id1 ! local integers 244 !!---------------------------------------------------------------------- 245 ! 246 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 247 IF( ln_rstart ) THEN !* Read the restart file 248 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. ) 249 ! 250 IF(lwp) WRITE(numout,*) '~~~~~~~' 251 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 252 IF(lwp) WRITE(numout,*) '~~~~~~~' 253 CALL iom_get( numror, 'frc_v', frc_v ) 254 CALL iom_get( numror, 'frc_t', frc_t ) 255 CALL iom_get( numror, 'frc_s', frc_s ) 256 IF( ln_linssh ) THEN 257 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 258 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 259 ENDIF 260 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 261 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 262 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 263 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 264 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 265 IF( ln_linssh ) THEN 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 267 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 268 ENDIF 269 ELSE 270 IF(lwp) WRITE(numout,*) '~~~~~~~' 271 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 272 IF(lwp) WRITE(numout,*) '~~~~~~~' 273 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 274 ssh_ini(:,:) = sshn(:,:) ! initial ssh 275 DO jk = 1, jpk 276 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 277 e3t_ini (:,:,jk) = e3t_n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors 278 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content 279 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content 280 END DO 281 frc_v = 0._wp ! volume trend due to forcing 282 frc_t = 0._wp ! heat content - - - - 283 frc_s = 0._wp ! salt content - - - - 284 IF( ln_linssh ) THEN 285 IF ( ln_isfcav ) THEN 286 DO ji=1,jpi 287 DO jj=1,jpj 288 ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh 289 ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh 290 ENDDO 291 ENDDO 292 ELSE 293 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 294 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 295 END IF 296 frc_wn_t = 0._wp ! initial heat content misfit due to free surface 297 frc_wn_s = 0._wp ! initial salt content misfit due to free surface 298 ENDIF 299 ENDIF 300 301 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 302 ! ! ------------------- 303 IF(lwp) WRITE(numout,*) '~~~~~~~' 304 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 305 IF(lwp) WRITE(numout,*) '~~~~~~~' 306 307 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 308 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 309 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 310 IF( ln_linssh ) THEN 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 312 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 313 ENDIF 314 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 315 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 316 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 317 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 318 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 319 IF( ln_linssh ) THEN 320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 321 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 322 ENDIF 323 ! 324 ENDIF 325 ! 326 END SUBROUTINE dia_hsb_rst 188 327 189 328 … … 200 339 !! - Compute coefficients for conversion 201 340 !!--------------------------------------------------------------------------- 202 INTEGER :: jk ! dummy loop indice 203 INTEGER :: ierror ! local integer 204 !! 341 INTEGER :: jk ! dummy loop indice 342 INTEGER :: ierror ! local integer 343 INTEGER :: ios 344 ! 205 345 NAMELIST/namhsb/ ln_diahsb 206 !207 INTEGER :: ios208 346 !!---------------------------------------------------------------------- 209 347 … … 234 372 235 373 IF( .NOT. ln_diahsb ) RETURN 236 ! IF( .NOT. lk_mpp_rep ) &237 ! CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', &238 ! & ' whereas the global sum to be precise must be done in double precision ',&239 ! & ' please add key_mpp_rep')374 ! IF( .NOT. lk_mpp_rep ) & 375 ! CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 376 ! & ' whereas the global sum to be precise must be done in double precision ',& 377 ! & ' please add key_mpp_rep') 240 378 241 379 ! ------------------- ! 242 380 ! 1 - Allocate memory ! 243 381 ! ------------------- ! 244 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), &245 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror )382 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), & 383 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 246 384 IF( ierror > 0 ) THEN 247 385 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 248 386 ENDIF 249 387 250 IF( .NOT. lk_vvl )ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )388 IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 251 389 IF( ierror > 0 ) THEN 252 390 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN … … 258 396 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 259 397 IF(lwp) WRITE(numout,*) '~~~~~~~' 260 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask (:,:,1) * tmask_i(:,:) ! masked surface grid cell area398 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 261 399 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 262 400 … … 270 408 END SUBROUTINE dia_hsb_init 271 409 272 SUBROUTINE dia_hsb_rst( kt, cdrw )273 !!---------------------------------------------------------------------274 !! *** ROUTINE limdia_rst ***275 !!276 !! ** Purpose : Read or write DIA file in restart file277 !!278 !! ** Method : use of IOM library279 !!----------------------------------------------------------------------280 INTEGER , INTENT(in) :: kt ! ocean time-step281 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag282 !283 INTEGER :: jk !284 INTEGER :: id1 ! local integers285 !!----------------------------------------------------------------------286 !287 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise288 IF( ln_rstart ) THEN !* Read the restart file289 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. )290 !291 IF(lwp) WRITE(numout,*) '~~~~~~~'292 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp293 IF(lwp) WRITE(numout,*) '~~~~~~~'294 CALL iom_get( numror, 'frc_v', frc_v )295 CALL iom_get( numror, 'frc_t', frc_t )296 CALL iom_get( numror, 'frc_s', frc_s )297 IF( .NOT. lk_vvl ) THEN298 CALL iom_get( numror, 'frc_wn_t', frc_wn_t )299 CALL iom_get( numror, 'frc_wn_s', frc_wn_s )300 ENDIF301 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )302 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )303 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )304 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )305 IF( .NOT. lk_vvl ) THEN306 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )307 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )308 ENDIF309 ELSE310 IF(lwp) WRITE(numout,*) '~~~~~~~'311 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state '312 IF(lwp) WRITE(numout,*) '~~~~~~~'313 ssh_ini(:,:) = sshn(:,:) ! initial ssh314 DO jk = 1, jpk315 e3t_ini (:,:,jk) = fse3t_n(:,:,jk) ! initial vertical scale factors316 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk) ! initial heat content317 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk) ! initial salt content318 END DO319 frc_v = 0.d0 ! volume trend due to forcing320 frc_t = 0.d0 ! heat content - - - -321 frc_s = 0.d0 ! salt content - - - -322 IF( .NOT. lk_vvl ) THEN323 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh324 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh325 frc_wn_t = 0.d0 ! initial heat content misfit due to free surface326 frc_wn_s = 0.d0 ! initial salt content misfit due to free surface327 ENDIF328 ENDIF329 330 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file331 ! ! -------------------332 IF(lwp) WRITE(numout,*) '~~~~~~~'333 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp334 IF(lwp) WRITE(numout,*) '~~~~~~~'335 336 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v )337 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t )338 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s )339 IF( .NOT. lk_vvl ) THEN340 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t )341 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s )342 ENDIF343 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini )344 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini )345 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini )346 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini )347 IF( .NOT. lk_vvl ) THEN348 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini )349 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini )350 ENDIF351 !352 ENDIF353 !354 END SUBROUTINE dia_hsb_rst355 356 410 !!====================================================================== 357 411 END MODULE diahsb
Note: See TracChangeset
for help on using the changeset viewer.
