- Timestamp:
- 2010-11-27T09:55:23+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r2287 r2438 4 4 !! Ocean fluxes : domain averaged freshwater budget 5 5 !!====================================================================== 6 !! History : 8.2 !01-02 (E. Durand) Original code7 !! 8.5 !02-06 (G. Madec) F90: Free form and module8 !! 9.0 !06-08 (G. Madec) Surface module9 !! 9.2 !09-07 (C. Talandier) emp mean s spread over erp area6 !! History : OPA ! 2001-02 (E. Durand) Original code 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! 3.0 ! 2006-08 (G. Madec) Surface module 9 !! 3.2 ! 2009-07 (C. Talandier) emp mean s spread over erp area 10 10 !!---------------------------------------------------------------------- 11 11 … … 43 43 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 44 44 !! $Id$ 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- 47 47 CONTAINS … … 73 73 ! 74 74 IF( kt == nit000 ) THEN 75 !76 75 IF(lwp) THEN 77 76 WRITE(numout,*) … … 81 80 IF( kn_fwb == 2 ) WRITE(numout,*) ' adjusted from previous year budget' 82 81 IF( kn_fwb == 3 ) WRITE(numout,*) ' fwf set to zero and spread out over erp area' 83 !84 IF( kn_fwb == 3 .AND. nn_sssr /= 2 ) &85 & CALL ctl_stop( 'The option nn_fwb = 3 must be associated to nn_sssr = 2 ' )86 87 82 ENDIF 88 83 ! 84 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(:,:) 90 area = glob_sum( e1e2(:,:) ) ! sum over the global domain 91 ! 87 area = glob_sum( e1e2(:,:) ) ! interior global domain surface 92 88 ENDIF 93 89 … … 95 91 SELECT CASE ( kn_fwb ) 96 92 ! 97 CASE ( 0 ) 98 WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not yet associated to an option, choose either 1/2' 99 CALL ctl_stop( ctmp1 ) 93 CASE ( 1 ) !== global mean fwf set to zero ==! 100 94 ! 101 102 !103 CASE ( 1 ) ! global mean fwf set to zero104 95 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 105 96 z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area ! sum over the global domain … … 108 99 ENDIF 109 100 ! 110 CASE ( 2 ) ! fwf budget adjusted from the previous year111 ! initialisation112 IF( kt == nit000 ) THEN 113 ! Read the corrective factor on precipitations (fwfold)101 CASE ( 2 ) !== fwf budget adjusted from the previous year ==! 102 ! 103 IF( kt == nit000 ) THEN ! initialisation 104 ! ! Read the corrective factor on precipitations (fwfold) 114 105 CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 115 106 READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb 116 107 CLOSE( inum ) 117 fwfold = a_fwb ! current year freshwater budget correction118 ! ! estimate from the previous year budget108 fwfold = a_fwb ! current year freshwater budget correction 109 ! ! estimate from the previous year budget 119 110 IF(lwp)WRITE(numout,*) 120 111 IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear , ' freshwater budget correction = ', fwfold … … 122 113 IF(lwp)WRITE(numout,*)' year = ',iyear-2, ' freshwater budget read = ', a_fwb_b 123 114 ENDIF 124 ! 125 ! Update fwfold if new year start 115 ! ! Update fwfold if new year start 126 116 ikty = 365 * 86400 / rdttra(1) !!bug use of 365 days leap year or 360d year !!!!!!! 127 117 IF( MOD( kt, ikty ) == 0 ) THEN … … 130 120 a_fwb = a_fwb * 1.e+3 / ( area * 86400. * 365. ) ! convert in Kg/m3/s = mm/s 131 121 !!gm ! !!bug 365d year 132 fwfold = a_fwb ! current year freshwater budget correction133 ! ! estimate from the previous year budget122 fwfold = a_fwb ! current year freshwater budget correction 123 ! ! estimate from the previous year budget 134 124 ENDIF 135 125 ! 136 ! correct the freshwater fluxes 137 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 126 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes 138 127 emp (:,:) = emp (:,:) + fwfold 139 128 emps(:,:) = emps(:,:) + fwfold 140 129 ENDIF 141 130 ! 142 ! save fwfold value in a file 143 IF( kt == nitend .AND. lwp ) THEN 131 IF( kt == nitend .AND. lwp ) THEN ! save fwfold value in a file 144 132 CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 145 133 WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb … … 147 135 ENDIF 148 136 ! 149 CASE ( 3 ) ! global fwf set to zero and spread out over erp area137 CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==! 150 138 ! 151 139 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 152 ! Select <0 and >0 area of erp 153 ztmsk_pos(:,:) = tmask_i(:,:) 154 WHERE( erp < 0.e0 ) ztmsk_pos = 0.e0 140 ztmsk_pos(:,:) = tmask_i(:,:) ! Select <0 and >0 area of erp 141 WHERE( erp < 0._wp ) ztmsk_pos = 0._wp 155 142 ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 156 157 ! Area filled by <0 and >0 erp 158 zsurf_neg = glob_sum( e1e2(:,:)*ztmsk_neg(:,:) ) 143 ! 144 zsurf_neg = glob_sum( e1e2(:,:)*ztmsk_neg(:,:) ) ! Area filled by <0 and >0 erp 159 145 zsurf_pos = glob_sum( e1e2(:,:)*ztmsk_pos(:,:) ) 160 161 ! fwf global mean 146 ! ! fwf global mean 162 147 z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 163 164 IF( z_fwf < 0.e0 ) THEN 165 ! to spread out over >0 erp area to increase evaporation damping process 166 zsurf_tospread = zsurf_pos 148 ! 149 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation 150 zsurf_tospread = zsurf_pos 167 151 ztmsk_tospread(:,:) = ztmsk_pos(:,:) 168 ELSE 169 ! to spread out over <0 erp area to increase precipitation damping process 170 zsurf_tospread = zsurf_neg 152 ELSE ! spread out over <0 erp area to increase precipitation 153 zsurf_tospread = zsurf_neg 171 154 ztmsk_tospread(:,:) = ztmsk_neg(:,:) 172 155 ENDIF 173 174 ! fwf global mean over <0 or >0 erp area175 zsum_fwf = glob_sum( e1e2(:,:) * z_fwf ) 156 ! 157 zsum_fwf = glob_sum( e1e2(:,:) * z_fwf ) ! fwf global mean over <0 or >0 erp area 158 !!gm : zsum_fwf = z_fwf * area ??? it is right? I think so.... 176 159 z_fwf_nsrf = zsum_fwf / ( zsurf_tospread + rsmall ) 177 ! weight to respect erp field 2D structure160 ! ! weight to respect erp field 2D structure 178 161 zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2(:,:) ) 179 162 z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 180 181 ! final correction term to apply 163 ! ! final correction term to apply 182 164 zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 183 165 ! 166 !!gm ===>>>> lbc_lnk should be useless as all the computation is done over the whole domain ! 184 167 CALL lbc_lnk( zerp_cor, 'T', 1. ) 185 168 ! 186 169 emp (:,:) = emp (:,:) + zerp_cor(:,:) 187 170 emps(:,:) = emps(:,:) + zerp_cor(:,:) 188 171 erp (:,:) = erp (:,:) + zerp_cor(:,:) 189 190 IF( nprint == 1 .AND. lwp ) THEN 191 IF( z_fwf < 0. e0) THEN192 WRITE(numout,*)' 193 WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-3,' m3.s-1'172 ! 173 IF( nprint == 1 .AND. lwp ) THEN ! control print 174 IF( z_fwf < 0._wp ) THEN 175 WRITE(numout,*)' z_fwf < 0' 176 WRITE(numout,*)' SUM(erp+) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv' 194 177 ELSE 195 WRITE(numout,*)'z_fwf >= 0'196 WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-3,' m3.s-1'178 WRITE(numout,*)' z_fwf >= 0' 179 WRITE(numout,*)' SUM(erp-) = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv' 197 180 ENDIF 198 WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2(:,:) )*1.e-3,' m3.s-1'199 WRITE(numout,*)' z_fwf = ', z_fwf ,' mm.s-1'200 WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' mm.s-1'201 WRITE(numout,*)' MIN(zerp_cor)= ', MINVAL(zerp_cor)202 WRITE(numout,*)' MAX(zerp_cor)= ', MAXVAL(zerp_cor)181 WRITE(numout,*)' SUM(empG) = ', SUM( z_fwf*e1e2(:,:) )*1.e-9,' Sv' 182 WRITE(numout,*)' z_fwf = ', z_fwf ,' Kg/m2/s' 183 WRITE(numout,*)' z_fwf_nsrf = ', z_fwf_nsrf ,' Kg/m2/s' 184 WRITE(numout,*)' MIN(zerp_cor) = ', MINVAL(zerp_cor) 185 WRITE(numout,*)' MAX(zerp_cor) = ', MAXVAL(zerp_cor) 203 186 ENDIF 204 !205 187 ENDIF 206 188 ! 207 CASE DEFAULT ! you should never be there 208 WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not permitted for the FreshWater Budget correction, choose either 1/2' 209 CALL ctl_stop( ctmp1 ) 189 CASE DEFAULT !== you should never be there ==! 190 CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) 210 191 ! 211 192 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.
