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