- Timestamp:
- 2010-10-11T18:51:54+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2191_3partymerge2010/NEMO/OPA_SRC/SBC/sbcfwb.F90
r1822 r2207 31 31 REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget 32 32 REAL(wp) :: a_fwb ! for 2 year before (_b) and before year. 33 REAL(wp) :: empold ! empold to be suppressed33 REAL(wp) :: fwfold ! fwfold to be suppressed 34 34 REAL(wp) :: area ! global mean ocean surface (interior domain) 35 35 … … 65 65 INTEGER :: inum ! temporary logical unit 66 66 INTEGER :: ikty, iyear ! 67 REAL(wp) :: z_ emp, z_emp_nsrf, zsum_emp, zsum_erp ! temporary scalars67 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! temporary scalars 68 68 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread 69 69 REAL(wp), DIMENSION(jpi,jpj) :: ztmsk_neg, ztmsk_pos, ztmsk_tospread … … 79 79 IF( kn_fwb == 1 ) WRITE(numout,*) ' instantaneously set to zero' 80 80 IF( kn_fwb == 2 ) WRITE(numout,*) ' adjusted from previous year budget' 81 IF( kn_fwb == 3 ) WRITE(numout,*) ' empset to zero and spread out over erp area'81 IF( kn_fwb == 3 ) WRITE(numout,*) ' fwf set to zero and spread out over erp area' 82 82 ! 83 83 IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) & … … 101 101 102 102 ! 103 CASE ( 1 ) ! global mean empset to zero103 CASE ( 1 ) ! global mean fwf set to zero 104 104 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 105 z_ emp = SUM( e1e2_i(:,:) * emp(:,:) ) / area106 IF( lk_mpp ) CALL mpp_sum( z_ emp ) ! sum over the global domain107 emp (:,:) = emp (:,:) - z_ emp108 emps(:,:) = emps(:,:) - z_ emp109 ENDIF 110 ! 111 CASE ( 2 ) ! empbudget adjusted from the previous year105 z_fwf = SUM( e1e2_i(:,:) * ( emp(:,:)-rnf(:,:) ) ) / area 106 IF( lk_mpp ) CALL mpp_sum( z_fwf ) ! sum over the global domain 107 emp (:,:) = emp (:,:) - z_fwf 108 emps(:,:) = emps(:,:) - z_fwf 109 ENDIF 110 ! 111 CASE ( 2 ) ! fwf budget adjusted from the previous year 112 112 ! initialisation 113 113 IF( kt == nit000 ) THEN 114 ! Read the corrective factor on precipitations ( empold)114 ! Read the corrective factor on precipitations (fwfold) 115 115 CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 116 116 READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb 117 117 CLOSE( inum ) 118 empold = a_fwb ! current year freshwater budget correction118 fwfold = a_fwb ! current year freshwater budget correction 119 119 ! ! estimate from the previous year budget 120 120 IF(lwp)WRITE(numout,*) 121 IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear , ' freshwater budget correction = ', empold121 IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear , ' freshwater budget correction = ', fwfold 122 122 IF(lwp)WRITE(numout,*)' year = ',iyear-1, ' freshwater budget read = ', a_fwb 123 123 IF(lwp)WRITE(numout,*)' year = ',iyear-2, ' freshwater budget read = ', a_fwb_b 124 124 ENDIF 125 125 ! 126 ! Update empold if new year start126 ! Update fwfold if new year start 127 127 ikty = 365 * 86400 / rdttra(1) !!bug use of 365 days leap year or 360d year !!!!!!! 128 128 IF( MOD( kt, ikty ) == 0 ) THEN … … 132 132 a_fwb = a_fwb * 1.e+3 / ( area * 86400. * 365. ) ! convert in Kg/m3/s = mm/s 133 133 !!gm ! !!bug 365d year 134 empold = a_fwb ! current year freshwater budget correction134 fwfold = a_fwb ! current year freshwater budget correction 135 135 ! ! estimate from the previous year budget 136 136 ENDIF … … 138 138 ! correct the freshwater fluxes 139 139 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 140 emp (:,:) = emp (:,:) + empold141 emps(:,:) = emps(:,:) + empold142 ENDIF 143 ! 144 ! save empold value in a file140 emp (:,:) = emp (:,:) + fwfold 141 emps(:,:) = emps(:,:) + fwfold 142 ENDIF 143 ! 144 ! save fwfold value in a file 145 145 IF( kt == nitend .AND. lwp ) THEN 146 146 CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) … … 149 149 ENDIF 150 150 ! 151 CASE ( 3 ) ! global empset to zero and spread out over erp area151 CASE ( 3 ) ! global fwf set to zero and spread out over erp area 152 152 ! 153 153 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN … … 161 161 zsurf_pos = SUM( e1e2_i(:,:)*ztmsk_pos(:,:) ) 162 162 163 ! empglobal mean164 z_ emp = SUM( e1e2_i(:,:) * emp(:,:) ) / area163 ! fwf global mean 164 z_fwf = SUM( e1e2_i(:,:) * ( emp(:,:)-rnf(:,:) ) ) / area 165 165 ! 166 IF( lk_mpp ) CALL mpp_sum( z_ emp)166 IF( lk_mpp ) CALL mpp_sum( z_fwf ) 167 167 IF( lk_mpp ) CALL mpp_sum( zsurf_neg ) 168 168 IF( lk_mpp ) CALL mpp_sum( zsurf_pos ) 169 169 170 IF( z_ emp< 0.e0 ) THEN170 IF( z_fwf < 0.e0 ) THEN 171 171 ! to spread out over >0 erp area to increase evaporation damping process 172 172 zsurf_tospread = zsurf_pos … … 178 178 ENDIF 179 179 180 ! empglobal mean over <0 or >0 erp area181 zsum_ emp = SUM( e1e2_i(:,:) * z_emp)182 IF( lk_mpp ) CALL mpp_sum( zsum_ emp)183 z_ emp_nsrf = zsum_emp/ ( zsurf_tospread + rsmall )180 ! fwf global mean over <0 or >0 erp area 181 zsum_fwf = SUM( e1e2_i(:,:) * z_fwf ) 182 IF( lk_mpp ) CALL mpp_sum( zsum_fwf ) 183 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 184 184 ! weight to respect erp field 2D structure 185 185 zsum_erp = SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) … … 188 188 189 189 ! final correction term to apply 190 zerp_cor(:,:) = -1. * z_ emp_nsrf * zsurf_tospread * z_wgt(:,:)190 zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 191 191 192 192 CALL lbc_lnk( zerp_cor, 'T', 1. ) … … 197 197 198 198 IF( nprint == 1 .AND. lwp ) THEN 199 IF( z_ emp< 0.e0 ) THEN200 WRITE(numout,*)' z_ emp< 0'199 IF( z_fwf < 0.e0 ) THEN 200 WRITE(numout,*)' z_fwf < 0' 201 201 WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1' 202 202 ELSE 203 WRITE(numout,*)' z_ emp>= 0'203 WRITE(numout,*)' z_fwf >= 0' 204 204 WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1' 205 205 ENDIF 206 WRITE(numout,*)' SUM(empG) = ', SUM( z_ emp*e1e2_i(:,:) )*1.e-3,' m3.s-1'207 WRITE(numout,*)' z_ emp = ', z_emp,' mm.s-1'208 WRITE(numout,*)' z_ emp_nsrf = ', z_emp_nsrf ,' mm.s-1'206 WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2_i(:,:) )*1.e-3,' m3.s-1' 207 WRITE(numout,*)' z_fwf = ', z_fwf ,' mm.s-1' 208 WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' mm.s-1' 209 209 WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor) 210 210 WRITE(numout,*)' MAX(zerp_cor) = ', MAXVAL(zerp_cor)
Note: See TracChangeset
for help on using the changeset viewer.