Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r2528 r2715 28 28 PRIVATE 29 29 30 PUBLIC sbc_fwb ! routine called by step 31 32 REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget 33 REAL(wp) :: a_fwb ! for 2 year before (_b) and before year. 34 REAL(wp) :: fwfold ! fwfold to be suppressed 35 REAL(wp) :: area ! global mean ocean surface (interior domain) 36 37 REAL(wp), DIMENSION(jpi,jpj) :: e1e2 ! area of the interior domain (e1t*e2t) 30 PUBLIC sbc_fwb ! routine called by step 31 32 REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget 33 REAL(wp) :: a_fwb ! for 2 year before (_b) and before year. 34 REAL(wp) :: fwfold ! fwfold to be suppressed 35 REAL(wp) :: area ! global mean ocean surface (interior domain) 38 36 39 37 !! * Substitutions … … 60 58 !! & spread out over erp area depending its sign 61 59 !!---------------------------------------------------------------------- 60 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 61 USE wrk_nemo, ONLY: ztmsk_neg => wrk_2d_1 , ztmsk_pos => wrk_2d_2 62 USE wrk_nemo, ONLY: ztmsk_tospread => wrk_2d_3 63 USE wrk_nemo, ONLY: z_wgt => wrk_2d_4 , zerp_cor => wrk_2d_5 64 ! 62 65 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 66 INTEGER, INTENT( in ) :: kn_fsbc ! 64 67 INTEGER, INTENT( in ) :: kn_fwb ! ocean time-step index 65 !! 66 INTEGER :: inum ! temporary logical unit 67 INTEGER :: ikty, iyear ! 68 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! temporary scalars 69 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread 70 REAL(wp), DIMENSION(jpi,jpj) :: ztmsk_neg, ztmsk_pos, ztmsk_tospread 71 REAL(wp), DIMENSION(jpi,jpj) :: z_wgt, zerp_cor 68 ! 69 INTEGER :: inum, ikty, iyear ! local integers 70 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars 71 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread ! - - 72 72 !!---------------------------------------------------------------------- 73 ! 74 IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 75 CALL ctl_stop('sbc_fwb: requested workspace arrays are unavailable') ; RETURN 76 ENDIF 73 77 ! 74 78 IF( kt == nit000 ) THEN … … 84 88 IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 85 89 ! 86 e1e2(:,:) = e1t(:,:) * e2t(:,:) 87 area = glob_sum( e1e2(:,:) ) ! interior global domain surface 90 area = glob_sum( e1e2t(:,:) ) ! interior global domain surface 88 91 ENDIF 89 92 … … 94 97 ! 95 98 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 96 z_fwf = glob_sum( e1e2 (:,:) * ( emp(:,:) - rnf(:,:) ) ) / area ! sum over the global domain99 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area ! sum over the global domain 97 100 emp (:,:) = emp (:,:) - z_fwf 98 101 emps(:,:) = emps(:,:) - z_fwf … … 117 120 IF( MOD( kt, ikty ) == 0 ) THEN 118 121 a_fwb_b = a_fwb 119 a_fwb = glob_sum( e1e2 (:,:) * sshn(:,:) ) ! sum over the global domain122 a_fwb = glob_sum( e1e2t(:,:) * sshn(:,:) ) ! sum over the global domain 120 123 a_fwb = a_fwb * 1.e+3 / ( area * 86400. * 365. ) ! convert in Kg/m3/s = mm/s 121 124 !!gm ! !!bug 365d year … … 142 145 ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 143 146 ! 144 zsurf_neg = glob_sum( e1e2 (:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp145 zsurf_pos = glob_sum( e1e2 (:,:)*ztmsk_pos(:,:) )147 zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp 148 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 146 149 ! ! fwf global mean 147 z_fwf = glob_sum( e1e2 (:,:) * ( emp(:,:) - rnf(:,:) ) ) / area150 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 148 151 ! 149 152 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation … … 155 158 ENDIF 156 159 ! 157 zsum_fwf = glob_sum( e1e2 (:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area160 zsum_fwf = glob_sum( e1e2t(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area 158 161 !!gm : zsum_fwf = z_fwf * area ??? it is right? I think so.... 159 162 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 160 163 ! ! weight to respect erp field 2D structure 161 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2 (:,:) )164 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 162 165 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 163 166 ! ! final correction term to apply … … 174 177 IF( z_fwf < 0._wp ) THEN 175 178 WRITE(numout,*)' z_fwf < 0' 176 WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2 (:,:) )*1.e-9,' Sv'179 WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 177 180 ELSE 178 181 WRITE(numout,*)' z_fwf >= 0' 179 WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2 (:,:) )*1.e-9,' Sv'182 WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 180 183 ENDIF 181 WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2 (:,:) )*1.e-9,' Sv'184 WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 182 185 WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s' 183 186 WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s' … … 192 195 END SELECT 193 196 ! 197 IF( wrk_not_released(2, 1,2,3,4,5) ) CALL ctl_stop('sbc_fwb: failed to release workspace arrays') 198 ! 194 199 END SUBROUTINE sbc_fwb 195 200
Note: See TracChangeset
for help on using the changeset viewer.