- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5643 r7351 46 46 REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends 47 47 ! 48 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 48 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 49 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini ! 49 50 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini ! 50 51 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 51 52 52 53 !! * Substitutions 53 # include "domzgr_substitute.h90"54 54 # include "vectopt_loop_substitute.h90" 55 55 !!---------------------------------------------------------------------- … … 100 100 IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 101 101 ! Add ice shelf heat & salt input 102 IF( nn_isf .GE. 1 ) THEN 103 z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 104 z_frc_trd_s = z_frc_trd_s + glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) ) 105 ENDIF 106 102 IF( ln_isf ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 107 103 ! Add penetrative solar radiation 108 104 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) ) … … 110 106 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) ) 111 107 ! 112 IF( .NOT. lk_vvl) THEN113 IF 108 IF( ln_linssh ) THEN 109 IF( ln_isfcav ) THEN 114 110 DO ji=1,jpi 115 111 DO jj=1,jpj 116 112 z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem) 117 113 z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal) 118 END DO119 END DO114 END DO 115 END DO 120 116 ELSE 121 117 z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) … … 130 126 frc_s = frc_s + z_frc_trd_s * rdt 131 127 ! ! Advection flux through fixed surface (z=0) 132 IF( .NOT. lk_vvl) THEN128 IF( ln_linssh ) THEN 133 129 frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 134 130 frc_wn_s = frc_wn_s + z_wn_trd_s * rdt … … 138 134 ! 2 - Content variations ! 139 135 ! ------------------------ ! 136 ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl) 140 137 zdiff_v2 = 0._wp 141 138 zdiff_hc = 0._wp … … 143 140 144 141 ! volume variation (calculated with ssh) 145 zdiff_v1 = glob_sum ( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:)) )142 zdiff_v1 = glob_sum_full( surf(:,:) * sshn(:,:) - surf_ini(:,:) * ssh_ini(:,:) ) 146 143 147 144 ! heat & salt content variation (associated with ssh) 148 IF( .NOT. lk_vvl) THEN149 IF 145 IF( ln_linssh ) THEN 146 IF( ln_isfcav ) THEN 150 147 DO ji = 1, jpi 151 148 DO jj = 1, jpj … … 158 155 z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 159 156 END IF 160 z_ssh_hc = glob_sum ( z2d0 )161 z_ssh_sc = glob_sum ( z2d1 )157 z_ssh_hc = glob_sum_full( z2d0 ) 158 z_ssh_sc = glob_sum_full( z2d1 ) 162 159 ENDIF 163 160 164 161 DO jk = 1, jpkm1 165 162 ! volume variation (calculated with scale factors) 166 zdiff_v2 = zdiff_v2 + glob_sum ( surf(:,:) * tmask(:,:,jk)&167 & * ( 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) ) 168 165 ! heat content variation 169 zdiff_hc = zdiff_hc + glob_sum ( surf(:,:) * tmask(:,:,jk)&170 & * ( 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) ) 171 168 ! salt content variation 172 zdiff_sc = zdiff_sc + glob_sum ( surf(:,:) * tmask(:,:,jk)&173 & * ( 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) ) 174 171 ENDDO 175 172 176 173 ! Substract forcing from heat content, salt content and volume variations 177 174 zdiff_v1 = zdiff_v1 - frc_v 178 IF( lk_vvl) zdiff_v2 = zdiff_v2 - frc_v175 IF( .NOT.ln_linssh ) zdiff_v2 = zdiff_v2 - frc_v 179 176 zdiff_hc = zdiff_hc - frc_t 180 177 zdiff_sc = zdiff_sc - frc_s 181 IF( .NOT. lk_vvl) THEN178 IF( ln_linssh ) THEN 182 179 zdiff_hc1 = zdiff_hc + z_ssh_hc 183 180 zdiff_sc1 = zdiff_sc + z_ssh_sc … … 191 188 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) 192 189 DO jk = 1, jpkm1 193 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) ) 194 191 END DO 195 192 196 193 !!gm to be added ? 197 ! IF( .NOT. lk_vvl) THEN ! fixed volume, add the ssh contribution194 ! IF( ln_linssh ) THEN ! fixed volume, add the ssh contribution 198 195 ! zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) ) 199 196 ! ENDIF 200 197 !!gm end 201 198 202 IF( lk_vvl ) THEN 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 203 211 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) 204 212 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu) … … 210 218 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 211 219 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 212 ELSE213 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C)214 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu)215 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J)216 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3)217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3)218 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3)219 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C)220 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu)221 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C)222 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu)223 220 ENDIF 224 221 ! 225 222 IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' ) 226 223 ! 227 224 CALL wrk_dealloc( jpi,jpj, z2d0, z2d1 ) 228 225 ! 229 226 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') 230 227 ! … … 257 254 CALL iom_get( numror, 'frc_t', frc_t ) 258 255 CALL iom_get( numror, 'frc_s', frc_s ) 259 IF( .NOT. lk_vvl) THEN256 IF( ln_linssh ) THEN 260 257 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 261 258 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 262 259 ENDIF 260 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 263 261 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 264 262 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 265 263 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 266 264 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 267 IF( .NOT. lk_vvl) THEN265 IF( ln_linssh ) THEN 268 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 269 267 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) … … 273 271 IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 274 272 IF(lwp) WRITE(numout,*) '~~~~~~~' 275 ssh_ini(:,:) = sshn(:,:) ! initial ssh 273 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 274 ssh_ini(:,:) = sshn(:,:) ! initial ssh 276 275 DO jk = 1, jpk 277 e3t_ini (:,:,jk) = fse3t_n(:,:,jk) ! initial vertical scale factors 278 hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk) ! initial heat content 279 sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk) ! initial salt content 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 280 END DO 281 281 frc_v = 0._wp ! volume trend due to forcing 282 282 frc_t = 0._wp ! heat content - - - - 283 283 frc_s = 0._wp ! salt content - - - - 284 IF( .NOT. lk_vvl) THEN284 IF( ln_linssh ) THEN 285 285 IF ( ln_isfcav ) THEN 286 286 DO ji=1,jpi … … 308 308 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 309 309 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 310 IF( .NOT. lk_vvl) THEN310 IF( ln_linssh ) THEN 311 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 312 312 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 313 313 ENDIF 314 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 314 315 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 315 316 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 316 317 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 317 318 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 318 IF( .NOT. lk_vvl) THEN319 IF( ln_linssh ) THEN 319 320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 320 321 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) … … 379 380 ! 1 - Allocate memory ! 380 381 ! ------------------- ! 381 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), &382 & 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 ) 383 384 IF( ierror > 0 ) THEN 384 385 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 385 386 ENDIF 386 387 387 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 ) 388 389 IF( ierror > 0 ) THEN 389 390 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN
Note: See TracChangeset
for help on using the changeset viewer.