Changeset 10965 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIA/diahsb.F90
- Timestamp:
- 2019-05-10T18:02:51+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIA/diahsb.F90
r10425 r10965 58 58 CONTAINS 59 59 60 SUBROUTINE dia_hsb( kt )60 SUBROUTINE dia_hsb( kt, Kbb, Kmm ) 61 61 !!--------------------------------------------------------------------------- 62 62 !! *** ROUTINE dia_hsb *** … … 69 69 !! 70 70 !!--------------------------------------------------------------------------- 71 INTEGER, INTENT(in) :: kt ! ocean time-step index 71 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 72 73 ! 73 74 INTEGER :: ji, jj, jk ! dummy loop indice … … 86 87 IF( ln_timing ) CALL timing_start('dia_hsb') 87 88 ! 88 ts n(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ;89 ts n(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ;89 ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ; 90 ts(:,:,:,2,Kmm) = ts(:,:,:,2,Kmm) * tmask(:,:,:) ; ts(:,:,:,2,Kbb) = ts(:,:,:,2,Kbb) * tmask(:,:,:) ; 90 91 ! ------------------------- ! 91 92 ! 1 - Trends due to forcing ! … … 108 109 DO ji=1,jpi 109 110 DO jj=1,jpj 110 z2d0(ji,jj) = surf(ji,jj) * w n(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem)111 z2d1(ji,jj) = surf(ji,jj) * w n(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal)111 z2d0(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_tem,Kbb) 112 z2d1(ji,jj) = surf(ji,jj) * ww(ji,jj,mikt(ji,jj)) * ts(ji,jj,mikt(ji,jj),jp_sal,Kbb) 112 113 END DO 113 114 END DO 114 115 ELSE 115 z2d0(:,:) = surf(:,:) * w n(:,:,1) * tsb(:,:,1,jp_tem)116 z2d1(:,:) = surf(:,:) * w n(:,:,1) * tsb(:,:,1,jp_sal)116 z2d0(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_tem,Kbb) 117 z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb) 117 118 END IF 118 119 z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) … … 135 136 136 137 ! ! volume variation (calculated with ssh) 137 zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*ssh n(:,:) - surf_ini(:,:)*ssh_ini(:,:) )138 zdiff_v1 = glob_sum_full( 'diahsb', surf(:,:)*ssh(:,:,Kmm) - surf_ini(:,:)*ssh_ini(:,:) ) 138 139 139 140 ! ! heat & salt content variation (associated with ssh) … … 142 143 DO ji = 1, jpi 143 144 DO jj = 1, jpj 144 z2d0(ji,jj) = surf(ji,jj) * ( ts n(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )145 z2d1(ji,jj) = surf(ji,jj) * ( ts n(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )145 z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 146 z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 146 147 END DO 147 148 END DO 148 149 ELSE ! no under ice-shelf seas 149 z2d0(:,:) = surf(:,:) * ( ts n(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) )150 z2d1(:,:) = surf(:,:) * ( ts n(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )150 z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 151 z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 151 152 END IF 152 153 z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) … … 155 156 ! 156 157 DO jk = 1, jpkm1 ! volume variation (calculated with scale factors) 157 zwrk(:,:,jk) = ( surf(:,:)*e3t _n(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk)158 zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm) - surf_ini(:,:)*e3t_ini(:,:,jk) ) * tmask(:,:,jk) 158 159 END DO 159 160 zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 160 161 DO jk = 1, jpkm1 ! heat content variation 161 zwrk(:,:,jk) = ( surf(:,:)*e3t _n(:,:,jk)*tsn(:,:,jk,jp_tem) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk)162 zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 162 163 END DO 163 164 zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 164 165 DO jk = 1, jpkm1 ! salt content variation 165 zwrk(:,:,jk) = ( surf(:,:)*e3t _n(:,:,jk)*tsn(:,:,jk,jp_sal) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk)166 zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) * tmask(:,:,jk) 166 167 END DO 167 168 zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) … … 185 186 ! ----------------------- ! 186 187 DO jk = 1, jpkm1 ! total ocean volume (calculated with scale factors) 187 zwrk(:,:,jk) = surf(:,:) * e3t _n(:,:,jk) * tmask(:,:,jk)188 zwrk(:,:,jk) = surf(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 188 189 END DO 189 190 zvol_tot = glob_sum_full( 'diahsb', zwrk(:,:,:) ) … … 191 192 !!gm to be added ? 192 193 ! IF( ln_linssh ) THEN ! fixed volume, add the ssh contribution 193 ! zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * ssh n(:,:) )194 ! zvol_tot = zvol_tot + glob_sum( 'diahsb', surf(:,:) * ssh(:,:,Kmm) ) 194 195 ! ENDIF 195 196 !!gm end … … 233 234 ENDIF 234 235 ! 235 IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' )236 IF( lrst_oce ) CALL dia_hsb_rst( kt, Kmm, 'WRITE' ) 236 237 ! 237 238 IF( ln_timing ) CALL timing_stop('dia_hsb') … … 240 241 241 242 242 SUBROUTINE dia_hsb_rst( kt, cdrw )243 SUBROUTINE dia_hsb_rst( kt, Kmm, cdrw ) 243 244 !!--------------------------------------------------------------------- 244 245 !! *** ROUTINE dia_hsb_rst *** … … 249 250 !!---------------------------------------------------------------------- 250 251 INTEGER , INTENT(in) :: kt ! ocean time-step 252 INTEGER , INTENT(in) :: Kmm ! ocean time level index 251 253 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 252 254 ! … … 281 283 IF(lwp) WRITE(numout,*) 282 284 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 283 ssh_ini(:,:) = ssh n(:,:) ! initial ssh285 ssh_ini(:,:) = ssh(:,:,Kmm) ! initial ssh 284 286 DO jk = 1, jpk 285 287 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 286 e3t_ini (:,:,jk) = e3t _n(:,:,jk) * tmask(:,:,jk) ! initial vertical scale factors287 hc_loc_ini(:,:,jk) = ts n(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial heat content288 sc_loc_ini(:,:,jk) = ts n(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk) ! initial salt content288 e3t_ini (:,:,jk) = e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial vertical scale factors 289 hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial heat content 290 sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial salt content 289 291 END DO 290 292 frc_v = 0._wp ! volume trend due to forcing … … 295 297 DO ji = 1, jpi 296 298 DO jj = 1, jpj 297 ssh_hc_loc_ini(ji,jj) = ts n(ji,jj,mikt(ji,jj),jp_tem) * sshn(ji,jj) ! initial heat content in ssh298 ssh_sc_loc_ini(ji,jj) = ts n(ji,jj,mikt(ji,jj),jp_sal) * sshn(ji,jj) ! initial salt content in ssh299 ssh_hc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) ! initial heat content in ssh 300 ssh_sc_loc_ini(ji,jj) = ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) ! initial salt content in ssh 299 301 END DO 300 302 END DO 301 303 ELSE 302 ssh_hc_loc_ini(:,:) = ts n(:,:,1,jp_tem) * sshn(:,:) ! initial heat content in ssh303 ssh_sc_loc_ini(:,:) = ts n(:,:,1,jp_sal) * sshn(:,:) ! initial salt content in ssh304 ssh_hc_loc_ini(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) ! initial heat content in ssh 305 ssh_sc_loc_ini(:,:) = ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) ! initial salt content in ssh 304 306 END IF 305 307 frc_wn_t = 0._wp ! initial heat content misfit due to free surface … … 338 340 339 341 340 SUBROUTINE dia_hsb_init 342 SUBROUTINE dia_hsb_init( Kmm ) 341 343 !!--------------------------------------------------------------------------- 342 344 !! *** ROUTINE dia_hsb *** … … 350 352 !! - Compute coefficients for conversion 351 353 !!--------------------------------------------------------------------------- 354 INTEGER, INTENT(in) :: Kmm ! time level index 355 ! 352 356 INTEGER :: ierror, ios ! local integer 353 357 !! … … 417 421 ! 4 - initial conservation variables ! 418 422 ! ---------------------------------- ! 419 CALL dia_hsb_rst( nit000, 'READ' ) !* read or initialize all required files423 CALL dia_hsb_rst( nit000, Kmm, 'READ' ) !* read or initialize all required files 420 424 ! 421 425 END SUBROUTINE dia_hsb_init
Note: See TracChangeset
for help on using the changeset viewer.