Changeset 1870 for branches/DEV_r1837_MLF/NEMO/OPA_SRC/SBC/sbcmod.F90
- Timestamp:
- 2010-05-12T17:36:00+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1837_MLF/NEMO/OPA_SRC/SBC/sbcmod.F90
r1792 r1870 4 4 !! Surface module : provide to the ocean its surface boundary condition 5 5 !!====================================================================== 6 !! History : 3.0 ! 07-2006 (G. Madec) Original code 7 !! - ! 08-2008 (S. Masson, E. .... ) coupled interface 6 !! History : 3.0 ! 2006-07 (G. Madec) Original code 7 !! 3.1 ! 2008-08 (S. Masson, E. Maisonnave, G. Madec) coupled interface 8 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 8 9 !!---------------------------------------------------------------------- 9 10 … … 49 50 # include "domzgr_substitute.h90" 50 51 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)52 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 52 53 !! $Id$ 53 54 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 86 87 !!gm IF( lk_sbc_cpl ) THEN ; ln_cpl = .TRUE. ; ELSE ; ln_cpl = .FALSE. ; ENDIF 87 88 88 IF 89 IF( Agrif_Root() ) THEN 89 90 IF( lk_lim2 ) nn_ice = 2 90 91 IF( lk_lim3 ) nn_ice = 3 … … 179 180 !! CAUTION : never mask the surface stress field (tke sbc) 180 181 !! 181 !! ** Action : - set the ocean surface boundary condition, i.e. 182 !! utau, vtau, qns, qsr, emp, emps, qrp, erp 182 !! ** Action : - set the ocean surface boundary condition at before and now 183 !! time step, i.e. 184 !! utau_b, vtau_b, qns_b, qsr_b, emp_n, emps_b, qrp_b, erp_b 185 !! utau , vtau , qns , qsr , emp , emps , qrp , erp 183 186 !! - updte the ice fraction : fr_i 184 187 !!---------------------------------------------------------------------- … … 186 189 !!--------------------------------------------------------------------- 187 190 188 CALL iom_setkt( kt + nn_fsbc - 1 ) ! in sbc, iom_put is called every nn_fsbc time step 189 ! 190 ! ocean to sbc mean sea surface variables (ss._m) 191 ! --------------------------------------- 192 CALL sbc_ssm( kt ) ! sea surface mean currents (at U- and V-points), 193 ! ! temperature and salinity (at T-point) over nf_sbc time-step 194 ! ! (i.e. sst_m, sss_m, ssu_m, ssv_m) 195 196 ! sbc formulation 197 ! --------------- 198 199 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 200 ! ! (i.e. utau,vtau, qns, qsr, emp, emps) 191 ! ! ---------------------------------------- ! 192 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 193 ! ! ---------------------------------------- ! 194 utau_b(:,:) = utau(:,:) ! Swap the ocean forcing fields 195 utau_b(:,:) = utau(:,:) ! (except at nitOOO where before fields 196 qns_b (:,:) = qns (:,:) ! are set the end of the routine) 197 qsr_b (:,:) = qsr (:,:) 198 emp_b (:,:) = emp (:,:) 199 emps_b(:,:) = emps(:,:) 200 ENDIF 201 202 ! ! ---------------------------------------- ! 203 ! ! forcing field computation ! 204 ! ! ---------------------------------------- ! 205 206 CALL iom_setkt( kt + nn_fsbc - 1 ) ! in sbc, iom_put is called every nn_fsbc time step 207 ! 208 CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) 209 ! ! averaged over nf_sbc time-step 210 211 !== sbc formulation ==! 212 213 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 214 ! ! (i.e. utau,vtau, qns, qsr, emp, emps) 201 215 CASE( 0 ) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration 202 216 CASE( 1 ) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc … … 214 228 END SELECT 215 229 216 ! Misc. Options 217 ! ------------- 230 ! !== Misc. Options ==! 218 231 219 232 !!gm IF( ln_dm2dc ) CALL sbc_dcy( kt ) ! Daily mean qsr distributed over the Diurnal Cycle … … 236 249 ! ! (update freshwater fluxes) 237 250 ! 251 ! ! ---------------------------------------- ! 252 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 253 ! ! ---------------------------------------- ! 254 IF( ln_rstart .AND. & !* Restart: read in restart file 255 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 256 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 257 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point) 258 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before j-stress (V-point) 259 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point) 260 CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point) 261 CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b ) ! before freshwater flux (T-point) 262 CALL iom_get( numror, jpdom_autoglo, 'emps_b', emp_b ) ! before C/D freshwater flux (T-point) 263 ! 264 ELSE !* no restart: set from nit000 values 265 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' 266 utau_b(:,:) = utau(:,:) 267 utau_b(:,:) = utau(:,:) 268 qns_b (:,:) = qns (:,:) 269 qsr_b (:,:) = qsr (:,:) 270 emp_b (:,:) = emp (:,:) 271 emps_b(:,:) = emps(:,:) 272 ENDIF 273 ENDIF 274 275 ! ! ---------------------------------------- ! 276 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 277 ! ! ---------------------------------------- ! 278 IF(lwp) WRITE(numout,*) 279 IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ', & 280 & 'at it= ', kt,' date= ', ndastp 281 IF(lwp) WRITE(numout,*) '~~~~' 282 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) ! 283 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , vtau ) 284 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns ) 285 CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 286 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 287 CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emp ) 288 ! 289 ENDIF 290 291 ! ! ---------------------------------------- ! 292 ! ! Outputs and control print ! 293 ! ! ---------------------------------------- ! 238 294 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 239 295 CALL iom_put( "emp" , emp ) ! upward water flux … … 242 298 CALL iom_put( "qns" , qns ) ! solar heat flux moved after the call to iom_setkt) 243 299 CALL iom_put( "qsr" , qsr ) ! solar heat flux moved after the call to iom_setkt) 244 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i )! ice fraction300 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 245 301 ENDIF 246 302 !
Note: See TracChangeset
for help on using the changeset viewer.
