- Timestamp:
- 2013-11-07T11:01:27+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r4152 r4161 5 5 !!====================================================================== 6 6 !! History : 3.3 ! 2010-09 (M. Leclair) Original code 7 !! ! 2012-10 (C. Rousset) add iom_put 7 8 !!---------------------------------------------------------------------- 8 9 … … 21 22 USE bdy_par ! (for lk_bdy) 22 23 USE timing ! preformance summary 23 USE lib_fortran 24 USE sbcrnf 24 USE iom ! I/O manager 25 USE lib_fortran ! glob_sum 26 USE restart ! ocean restart 27 USE wrk_nemo ! work arrays 25 28 26 29 IMPLICIT NONE … … 28 31 29 32 PUBLIC dia_hsb ! routine called by step.F90 30 PUBLIC dia_hsb_init ! routine called by opa.F90 33 PUBLIC dia_hsb_init ! routine called by nemogcm.F90 34 PUBLIC dia_hsb_rst ! routine called by step.F90 31 35 32 36 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets 33 37 34 INTEGER :: numhsb ! 35 REAL(dp) :: surf_tot , vol_tot ! 36 REAL(dp) :: frc_t , frc_s , frc_v ! global forcing trends 37 REAL(dp) :: frc_wn_t , frc_wn_s ! global forcing trends 38 REAL(dp) :: fact1 ! conversion factors 39 REAL(dp) :: fact21 , fact22 ! - - 40 REAL(dp) :: fact31 , fact32 ! - - 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 38 REAL(wp), SAVE :: frc_t , frc_s , frc_v ! global forcing trends 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssh_ini ! 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hc_loc_ini, sc_loc_ini, e3t_ini ! 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: hcssh_loc_ini, scssh_loc_ini ! 44 42 45 43 !! * Substitutions … … 65 63 !! - Compute the contribution of forcing and remove it from these deviations 66 64 !! 67 !! ** Action : Write the results in the 'heat_salt_volume_budgets.txt' ASCII file68 65 !!--------------------------------------------------------------------------- 69 66 INTEGER, INTENT(in) :: kt ! ocean time-step index 70 67 !! 71 68 INTEGER :: jk ! dummy loop indice 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 74 REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation 75 REAL(dp) :: zerr_hc1 , zerr_sc1 ! Non conservation due to free surface 76 REAL(dp) :: zdeltat ! - - 77 REAL(dp) :: z_frc_trd_t , z_frc_trd_s ! - - 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 ! - - 81 !!--------------------------------------------------------------------------- 82 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 83 69 REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 70 REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation 71 REAL(wp) :: z_hc , z_sc ! heat and salt content 72 REAL(wp) :: z_v1 , z_v2 ! volume 73 REAL(wp) :: zdeltat ! - - 74 REAL(wp) :: z_frc_trd_t , z_frc_trd_s ! - - 75 REAL(wp) :: z_frc_trd_v ! - - 76 REAL(wp), POINTER, DIMENSION(:,:) :: zsurf ! 77 !!--------------------------------------------------------------------------- 78 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 79 80 CALL wrk_alloc( jpi, jpj, zsurf ) 81 82 zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:) ! masked surface grid cell area 83 84 84 ! ------------------------- ! 85 85 ! 1 - Trends due to forcing ! 86 86 ! ------------------------- ! 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(:,:) ) 87 z_frc_trd_v = r1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * zsurf(:,:) ) ! volume fluxes 88 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * zsurf(:,:) ) ! heat fluxes 89 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * zsurf(:,:) ) ! salt fluxes 93 90 ! Add penetrative solar radiation 94 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) )91 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * zsurf(:,:) ) 95 92 ! Add geothermal heat flux 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 93 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * zsurf(:,:) ) 94 ! 102 95 frc_v = frc_v + z_frc_trd_v * rdt 103 96 frc_t = frc_t + z_frc_trd_t * rdt 104 97 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 110 111 ! ----------------------- ! 112 ! 2 - Content variations ! 113 ! ----------------------- ! 114 zdiff_v2 = 0.d0 115 zdiff_hc = 0.d0 116 zdiff_sc = 0.d0 117 98 99 ! ------------------------ ! 100 ! 2a - Content variations ! 101 ! ------------------------ ! 102 zdiff_v2 = 0._wp 103 zdiff_hc = 0._wp 104 zdiff_sc = 0._wp 118 105 ! volume variation (calculated with ssh) 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 106 zdiff_v1 = glob_sum( zsurf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 127 107 DO jk = 1, jpkm1 128 ! volume variation (calculated with scale factors) 129 zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 130 & * ( fse3t_n(:,:,jk) & 131 & - e3t_ini(:,:,jk) ) ) 108 ! volume variation (calculated with scale factors) 109 zdiff_v2 = zdiff_v2 + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 132 110 ! heat content variation 133 zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk) & 134 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) & 111 zdiff_hc = zdiff_hc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) & 135 112 & - hc_loc_ini(:,:,jk) ) ) 136 113 ! salt content variation 137 zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk) & 138 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) & 114 zdiff_sc = zdiff_sc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) & 139 115 & - sc_loc_ini(:,:,jk) ) ) 140 116 ENDDO 141 117 142 118 ! Substract forcing from heat content, salt content and volume variations 143 zdiff_v1 = zdiff_v1 - frc_v 144 IF( lk_vvl ) zdiff_v2 = zdiff_v2 - frc_v 145 zdiff_hc = zdiff_hc - frc_t 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 119 !frc_v = zdiff_v2 - frc_v 120 !frc_t = zdiff_hc - frc_t 121 !frc_s = zdiff_sc - frc_s 153 122 123 ! add ssh if not vvl 124 #if ! defined key_vvl 125 zdiff_v2 = zdiff_v2 + zdiff_v1 126 zdiff_hc = zdiff_hc + glob_sum( zsurf(:,:) * ( sshn(:,:) * tsn(:,:,1,jp_tem) & 127 & - hcssh_loc_ini(:,:) ) ) 128 zdiff_sc = zdiff_sc + glob_sum( zsurf(:,:) * ( sshn(:,:) * tsn(:,:,1,jp_sal) & 129 & - scssh_loc_ini(:,:) ) ) 130 #endif 131 ! 132 ! ----------------------- ! 133 ! 2b - Content ! 134 ! ----------------------- ! 135 z_v2 = 0._wp 136 z_hc = 0._wp 137 z_sc = 0._wp 138 ! volume (calculated with ssh) 139 z_v1 = glob_sum( zsurf(:,:) * sshn(:,:) ) 140 DO jk = 1, jpkm1 141 ! volume (calculated with scale factors) 142 z_v2 = z_v2 + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) ) 143 ! heat content 144 z_hc = z_hc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) ) 145 ! salt content 146 z_sc = z_sc + glob_sum( zsurf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) ) 147 ENDDO 148 ! add ssh if not vvl 149 #if ! defined key_vvl 150 z_v2 = z_v2 + z_v1 151 z_hc = z_hc + glob_sum( zsurf(:,:) * sshn(:,:) * tsn(:,:,1,jp_tem) ) 152 z_sc = z_sc + glob_sum( zsurf(:,:) * sshn(:,:) * tsn(:,:,1,jp_sal) ) 153 #endif 154 154 155 ! ----------------------- ! 155 156 ! 3 - Diagnostics writing ! 156 157 ! ----------------------- ! 157 158 zdeltat = 1.e0 / ( ( kt - nit000 + 1 ) * rdt ) 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 * zdeltat163 ELSE164 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_tot168 ENDIF169 170 IF ( kt == nitend ) CLOSE( numhsb)171 159 ! 160 CALL iom_put( 'bgtemper' , z_hc / z_v2 ) ! Temperature (C) 161 CALL iom_put( 'bgsaline' , z_sc / z_v2 ) ! Salinity (psu) 162 CALL iom_put( 'bgheatco' , zdiff_hc * rau0 * rcp * 1.e-9_wp ) ! Heat content variation (10^9 J) 163 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3) 164 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh (km3) 165 CALL iom_put( 'bgsshtot' , zdiff_v1 / glob_sum(zsurf) ) ! ssh (m) 166 CALL iom_put( 'bgvoltot' , zdiff_v2 * 1.e-9 ) ! volume total (km3) 167 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (volume) 168 CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-9_wp ) ! hc - surface forcing (heat content) 169 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (salt content) 170 ! 171 CALL wrk_dealloc( jpi, jpj, zsurf ) 172 ! 172 173 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') 173 174 9020 FORMAT(I5,11D15.7) 175 9030 FORMAT(I5,10D15.7) 176 ! 174 ! 177 175 END SUBROUTINE dia_hsb 178 176 … … 190 188 !! - Compute coefficients for conversion 191 189 !!--------------------------------------------------------------------------- 192 CHARACTER (len=32) :: cl_name ! output file name193 190 INTEGER :: jk ! dummy loop indice 194 191 INTEGER :: ierror ! local integer 195 INTEGER :: ios ! Local integer output status for namelist read196 192 !! 197 193 NAMELIST/namhsb/ ln_diahsb 198 194 !!---------------------------------------------------------------------- 199 195 ! 200 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist : Heat & salt budget 201 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 202 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist', lwp ) 203 204 REWIND( numnam_cfg ) ! Namelist namhsb in configuration namelist : Heat & salt budget 205 READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 206 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist', lwp ) 207 WRITE ( numond, namhsb ) 196 REWIND ( numnam ) ! Read Namelist namhsb 197 READ ( numnam, namhsb ) 208 198 ! 209 199 IF(lwp) THEN ! Control print … … 216 206 217 207 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') 222 223 ! ------------------- ! 224 ! 1 - Allocate memory ! 225 ! ------------------- ! 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 ) 230 IF( ierror > 0 ) THEN 231 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 232 ENDIF 233 234 ! ----------------------------------------------- ! 235 ! 2 - Time independant variables and file opening ! 236 ! ----------------------------------------------- ! 237 WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 238 WRITE(numout,*) "~~~~~~~ output written in the 'heat_salt_volume_budgets.txt' ASCII file" 239 IF( lk_obc .or. lk_bdy ) THEN 240 CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) 241 ENDIF 242 cl_name = 'heat_salt_volume_budgets.txt' ! name of output file 243 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:) ! masked surface grid cell area 244 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 245 vol_tot = 0.d0 ! total ocean volume 246 DO jk = 1, jpkm1 247 vol_tot = vol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) & 248 & * fse3t_n(:,:,jk) ) 249 END DO 250 251 CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 ) 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 273 ! --------------- ! 274 ! 3 - Conversions ! (factors will be multiplied by duration afterwards) 275 ! --------------- ! 276 277 ! heat content variation => equivalent heat flux: 278 fact1 = rau0 * rcp / surf_tot ! [C*m3] -> [W/m2] 279 ! salt content variation => equivalent EMP and equivalent "flow": 280 fact21 = 1.e3 / ( soce * surf_tot ) ! [psu*m3] -> [mm/s] 281 fact22 = 1.e-6 / soce ! [psu*m3] -> [Sv] 282 ! volume variation => equivalent EMP and equivalent "flow": 283 fact31 = 1.e3 / surf_tot ! [m3] -> [mm/s] 284 fact32 = 1.e-6 ! [m3] -> [SV] 285 286 ! ---------------------------------- ! 287 ! 4 - initial conservation variables ! 288 ! ---------------------------------- ! 289 ssh_ini(:,:) = sshn(:,:) ! initial ssh 290 DO jk = 1, jpk 291 e3t_ini (:,:,jk) = fse3t_n(:,:,jk) ! initial vertical scale factors 292 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk) ! initial heat content 293 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk) ! initial salt content 294 END DO 295 frc_v = 0.d0 ! volume trend due to forcing 296 frc_t = 0.d0 ! heat content - - - - 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 304 ! 305 9010 FORMAT(A80,A45,A45) 306 9011 FORMAT(A80,A45,A45) 208 209 ! ------------------- ! 210 ! 1 - Allocate memory ! 211 ! ------------------- ! 212 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 213 IF( ierror > 0 ) THEN 214 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 215 ENDIF 216 ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 217 IF( ierror > 0 ) THEN 218 CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' ) ; RETURN 219 ENDIF 220 ALLOCATE( hcssh_loc_ini(jpi,jpj), STAT=ierror ) 221 IF( ierror > 0 ) THEN 222 CALL ctl_stop( 'dia_hsb: unable to allocate hcssh_loc_ini' ) ; RETURN 223 ENDIF 224 ALLOCATE( scssh_loc_ini(jpi,jpj), STAT=ierror ) 225 IF( ierror > 0 ) THEN 226 CALL ctl_stop( 'dia_hsb: unable to allocate scssh_loc_ini' ) ; RETURN 227 ENDIF 228 ALLOCATE( e3t_ini(jpi,jpj,jpk) , STAT=ierror ) 229 IF( ierror > 0 ) THEN 230 CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' ) ; RETURN 231 ENDIF 232 ALLOCATE( ssh_ini(jpi,jpj) , STAT=ierror ) 233 IF( ierror > 0 ) THEN 234 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' ) ; RETURN 235 ENDIF 236 237 ! ----------------------------------------------- ! 238 ! 2 - Time independant variables and file opening ! 239 ! ----------------------------------------------- ! 240 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 241 IF( lk_obc .or. lk_bdy ) THEN 242 CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) 243 ENDIF 244 245 ! 246 CALL dia_hsb_rst( nit000, 'READ' ) !* read or initialize all required files 307 247 ! 308 248 END SUBROUTINE dia_hsb_init 249 250 SUBROUTINE dia_hsb_rst( kt, cdrw ) 251 !!--------------------------------------------------------------------- 252 !! *** ROUTINE limdia_rst *** 253 !! 254 !! ** Purpose : Read or write DIA file in restart file 255 !! 256 !! ** Method : use of IOM library 257 !!---------------------------------------------------------------------- 258 INTEGER , INTENT(in) :: kt ! ocean time-step 259 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 260 ! 261 INTEGER :: jk ! 262 INTEGER :: id1 ! local integers 263 !!---------------------------------------------------------------------- 264 ! 265 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 266 IF( ln_rstart ) THEN !* Read the restart file 267 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. ) 268 ! 269 CALL iom_get( numror, 'frc_v', frc_v ) 270 CALL iom_get( numror, 'frc_t', frc_t ) 271 CALL iom_get( numror, 'frc_s', frc_s ) 272 273 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 274 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 275 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 276 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 277 CALL iom_get( numror, jpdom_autoglo, 'hcssh_loc_ini', hcssh_loc_ini ) 278 CALL iom_get( numror, jpdom_autoglo, 'scssh_loc_ini', scssh_loc_ini ) 279 ELSE 280 ssh_ini(:,:) = sshn(:,:) ! initial ssh 281 DO jk = 1, jpk 282 e3t_ini (:,:,jk) = fse3t_n(:,:,jk) ! initial vertical scale factors 283 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk) ! initial heat content 284 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk) ! initial salt content 285 END DO 286 hcssh_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh 287 scssh_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh 288 frc_v = 0._wp 289 frc_t = 0._wp 290 frc_s = 0._wp 291 ENDIF 292 293 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 294 ! ! ------------------- 295 IF(lwp) WRITE(numout,*) '---- dia-rst ----' 296 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 297 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 298 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 299 300 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 301 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 302 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 303 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 304 CALL iom_rstput( kt, nitrst, numrow, 'hcssh_loc_ini', hcssh_loc_ini ) 305 CALL iom_rstput( kt, nitrst, numrow, 'scssh_loc_ini', scssh_loc_ini ) 306 ! 307 ENDIF 308 ! 309 END SUBROUTINE dia_hsb_rst 309 310 310 311 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
