- Timestamp:
- 2013-11-05T12:59:53+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r4147 r4152 21 21 USE bdy_par ! (for lk_bdy) 22 22 USE timing ! preformance summary 23 USE lib_fortran 24 USE sbcrnf 23 25 24 26 IMPLICIT NONE … … 33 35 REAL(dp) :: surf_tot , vol_tot ! 34 36 REAL(dp) :: frc_t , frc_s , frc_v ! global forcing trends 37 REAL(dp) :: frc_wn_t , frc_wn_s ! global forcing trends 35 38 REAL(dp) :: fact1 ! conversion factors 36 39 REAL(dp) :: fact21 , fact22 ! - - … … 38 41 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 39 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 40 44 41 45 !! * Substitutions … … 67 71 INTEGER :: jk ! dummy loop indice 68 72 REAL(dp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 73 REAL(dp) :: zdiff_hc1 , zdiff_sc1 ! heat and salt content variations of ssh 69 74 REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation 70 REAL(dp) :: z 1_rau0 ! local scalars75 REAL(dp) :: zerr_hc1 , zerr_sc1 ! Non conservation due to free surface 71 76 REAL(dp) :: zdeltat ! - - 72 77 REAL(dp) :: z_frc_trd_t , z_frc_trd_s ! - - 73 78 REAL(dp) :: z_frc_trd_v ! - - 79 REAL(dp) :: z_wn_trd_t , z_wn_trd_s ! - - 80 REAL(dp) :: z_ssh_hc , z_ssh_sc ! - - 74 81 !!--------------------------------------------------------------------------- 75 82 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') … … 78 85 ! 1 - Trends due to forcing ! 79 86 ! ------------------------- ! 80 z1_rau0 = 1.e0 / rau0 81 z_frc_trd_v = z1_rau0 * SUM( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes 82 z_frc_trd_t = SUM( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 83 z_frc_trd_s = SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 87 z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes 88 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 89 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 90 ! Add runoff heat & salt input 91 IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) ) 92 IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 84 93 ! Add penetrative solar radiation 85 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qsr (:,:) * surf(:,:) )94 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) ) 86 95 ! Add geothermal heat flux 87 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qgh_trd0(:,:) * surf(:,:) ) 88 IF( lk_mpp ) THEN 89 CALL mpp_sum( z_frc_trd_v ) 90 CALL mpp_sum( z_frc_trd_t ) 91 ENDIF 96 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) ) 97 IF( .NOT. lk_vvl ) THEN 98 z_wn_trd_t = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) ) 99 z_wn_trd_s = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) ) 100 ENDIF 101 92 102 frc_v = frc_v + z_frc_trd_v * rdt 93 103 frc_t = frc_t + z_frc_trd_t * rdt 94 104 frc_s = frc_s + z_frc_trd_s * rdt 105 ! ! Advection flux through fixed surface (z=0) 106 IF( .NOT. lk_vvl ) THEN 107 frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 108 frc_wn_s = frc_wn_s + z_wn_trd_s * rdt 109 ENDIF 95 110 96 111 ! ----------------------- ! … … 100 115 zdiff_hc = 0.d0 101 116 zdiff_sc = 0.d0 117 102 118 ! volume variation (calculated with ssh) 103 zdiff_v1 = SUM( surf(:,:) * tmask(:,:,1) * ( sshn(:,:) - ssh_ini(:,:) ) ) 119 zdiff_v1 = glob_sum( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 120 121 ! heat & salt content variation (associated with ssh) 122 IF( .NOT. lk_vvl ) THEN 123 z_ssh_hc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) ) 124 z_ssh_sc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) ) 125 ENDIF 126 104 127 DO jk = 1, jpkm1 105 106 zdiff_v2 = zdiff_v2 + SUM( surf(:,:) * tmask(:,:,jk) &128 ! volume variation (calculated with scale factors) 129 zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 107 130 & * ( fse3t_n(:,:,jk) & 108 131 & - e3t_ini(:,:,jk) ) ) 109 132 ! heat content variation 110 zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk) &133 zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk) & 111 134 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) & 112 135 & - hc_loc_ini(:,:,jk) ) ) 113 136 ! salt content variation 114 zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk) &137 zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk) & 115 138 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) & 116 139 & - sc_loc_ini(:,:,jk) ) ) 117 140 ENDDO 118 141 119 IF( lk_mpp ) THEN120 CALL mpp_sum( zdiff_hc )121 CALL mpp_sum( zdiff_sc )122 CALL mpp_sum( zdiff_v1 )123 CALL mpp_sum( zdiff_v2 )124 ENDIF125 126 142 ! Substract forcing from heat content, salt content and volume variations 127 143 zdiff_v1 = zdiff_v1 - frc_v 128 zdiff_v2 = zdiff_v2 - frc_v144 IF( lk_vvl ) zdiff_v2 = zdiff_v2 - frc_v 129 145 zdiff_hc = zdiff_hc - frc_t 130 146 zdiff_sc = zdiff_sc - frc_s 147 IF( .NOT. lk_vvl ) THEN 148 zdiff_hc1 = zdiff_hc + z_ssh_hc 149 zdiff_sc1 = zdiff_sc + z_ssh_sc 150 zerr_hc1 = z_ssh_hc - frc_wn_t 151 zerr_sc1 = z_ssh_sc - frc_wn_s 152 ENDIF 131 153 132 154 ! ----------------------- ! … … 134 156 ! ----------------------- ! 135 157 zdeltat = 1.e0 / ( ( kt - nit000 + 1 ) * rdt ) 136 WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1 * zdeltat, & 137 & zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat, & 138 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 139 & zdiff_v2 , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 158 IF( lk_vvl ) THEN 159 WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1 * zdeltat, & 160 & zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat, & 161 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 162 & zdiff_v2 , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 163 ELSE 164 WRITE(numhsb , 9030) kt , zdiff_hc1 / vol_tot , zdiff_hc1 * fact1 * zdeltat, & 165 & zdiff_sc1 / vol_tot , zdiff_sc1 * fact21 * zdeltat, zdiff_sc1 * fact22 * zdeltat, & 166 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 167 & zerr_hc1 / vol_tot , zerr_sc1 / vol_tot 168 ENDIF 140 169 141 170 IF ( kt == nitend ) CLOSE( numhsb ) … … 144 173 145 174 9020 FORMAT(I5,11D15.7) 175 9030 FORMAT(I5,10D15.7) 146 176 ! 147 177 END SUBROUTINE dia_hsb … … 186 216 187 217 IF( .NOT. ln_diahsb ) RETURN 218 IF( .NOT. lk_mpp_rep ) & 219 CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 220 & ' whereas the global sum to be precise must be done in double precision ',& 221 & ' please add key_mpp_rep') 188 222 189 223 ! ------------------- ! 190 224 ! 1 - Allocate memory ! 191 225 ! ------------------- ! 192 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 226 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 227 & ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj), & 228 & e3t_ini(jpi,jpj,jpk) , & 229 & surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 193 230 IF( ierror > 0 ) THEN 194 231 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 195 ENDIF196 ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror )197 IF( ierror > 0 ) THEN198 CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' ) ; RETURN199 ENDIF200 ALLOCATE( e3t_ini(jpi,jpj,jpk) , STAT=ierror )201 IF( ierror > 0 ) THEN202 CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' ) ; RETURN203 ENDIF204 ALLOCATE( surf(jpi,jpj) , STAT=ierror )205 IF( ierror > 0 ) THEN206 CALL ctl_stop( 'dia_hsb: unable to allocate surf' ) ; RETURN207 ENDIF208 ALLOCATE( ssh_ini(jpi,jpj) , STAT=ierror )209 IF( ierror > 0 ) THEN210 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' ) ; RETURN211 232 ENDIF 212 233 … … 221 242 cl_name = 'heat_salt_volume_budgets.txt' ! name of output file 222 243 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:) ! masked surface grid cell area 223 surf_tot = SUM( surf(:,:) ) ! total ocean surface area244 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 224 245 vol_tot = 0.d0 ! total ocean volume 225 246 DO jk = 1, jpkm1 226 vol_tot = vol_tot + SUM( surf(:,:) * tmask(:,:,jk) &227 & * fse3t_n(:,:,jk) )247 vol_tot = vol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) & 248 & * fse3t_n(:,:,jk) ) 228 249 END DO 229 IF( lk_mpp ) THEN230 CALL mpp_sum( vol_tot )231 CALL mpp_sum( surf_tot )232 ENDIF233 250 234 251 CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 ) 235 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 236 WRITE( numhsb, 9010 ) "kt | heat content budget | salt content budget ", & 237 ! 123456789012345678901234567890123456789012345 -> 45 238 & "| volume budget (ssh) ", & 239 ! 678901234567890123456789012345678901234567890 -> 45 240 & "| volume budget (e3t) " 241 WRITE( numhsb, 9010 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 242 & "| [m3] [mmm/s] [SV] ", & 243 & "| [m3] [mmm/s] [SV] " 244 252 IF( lk_vvl ) THEN 253 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 254 WRITE( numhsb, 9010 ) "kt | heat content budget | salt content budget ", & 255 ! 123456789012345678901234567890123456789012345 -> 45 256 & "| volume budget (ssh) ", & 257 ! 678901234567890123456789012345678901234567890 -> 45 258 & "| volume budget (e3t) " 259 WRITE( numhsb, 9010 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 260 & "| [m3] [mmm/s] [SV] ", & 261 & "| [m3] [mmm/s] [SV] " 262 ELSE 263 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 264 WRITE( numhsb, 9011 ) "kt | heat content budget | salt content budget ", & 265 ! 123456789012345678901234567890123456789012345 -> 45 266 & "| volume budget (ssh) ", & 267 ! 678901234567890123456789012345678901234567890 -> 45 268 & "| Non conservation due to free surface " 269 WRITE( numhsb, 9011 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 270 & "| [m3] [mmm/s] [SV] ", & 271 & "| [heat - C] [salt - psu] " 272 ENDIF 245 273 ! --------------- ! 246 274 ! 3 - Conversions ! (factors will be multiplied by duration afterwards) … … 268 296 frc_t = 0.d0 ! heat content - - - - 269 297 frc_s = 0.d0 ! salt content - - - - 298 IF( .NOT. lk_vvl ) THEN 299 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * ssh_ini(:,:) ! initial heat content associated with ssh 300 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * ssh_ini(:,:) ! initial salt content associated with ssh 301 frc_wn_t = 0.d0 302 frc_wn_s = 0.d0 303 ENDIF 270 304 ! 271 305 9010 FORMAT(A80,A45,A45) 306 9011 FORMAT(A80,A45,A45) 272 307 ! 273 308 END SUBROUTINE dia_hsb_init
Note: See TracChangeset
for help on using the changeset viewer.
