- Timestamp:
- 2010-10-04T15:53:42+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/SBC/sbcmod.F90
r2000 r2148 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 vtau_b(:,:) = vtau(:,:) ! (except at nit000 where before fields 196 qns_b (:,:) = qns (:,:) ! are set at the end of the routine) 197 ! The 3D heat content due to qsr forcing is treated in traqsr 198 ! qsr_b (:,:) = qsr (:,:) 199 emp_b (:,:) = emp (:,:) 200 emps_b(:,:) = emps(:,:) 201 ENDIF 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 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 252 ! ! ---------------------------------------- ! 253 IF( ln_rstart .AND. & !* Restart: read in restart file 254 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 255 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 256 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point) 257 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b ) ! before j-stress (V-point) 258 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point) 259 ! The 3D heat content due to qsr forcing is treated in traqsr 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', emps_b ) ! before C/D freshwater flux (T-point) 263 ELSE !* no restart: set from nit000 values 264 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' 265 utau_b(:,:) = utau(:,:) 266 vtau_b(:,:) = vtau(:,:) 267 qns_b (:,:) = qns (:,:) 268 ! qsr_b (:,:) = qsr (:,:) 269 emp_b (:,:) = emp (:,:) 270 emps_b(:,:) = emps(:,:) 271 ENDIF 272 ENDIF 273 ! ! ---------------------------------------- ! 274 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 275 ! ! ---------------------------------------- ! 276 IF(lwp) WRITE(numout,*) 277 IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ', & 278 & 'at it= ', kt,' date= ', ndastp 279 IF(lwp) WRITE(numout,*) '~~~~' 280 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) 281 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau ) 282 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns ) 283 ! The 3D heat content due to qsr forcing is treated in traqsr 284 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 285 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 286 CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emps ) 287 ENDIF 288 289 ! ! ---------------------------------------- ! 290 ! ! Outputs and control print ! 291 ! ! ---------------------------------------- ! 238 292 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 239 CALL iom_put( "emp-rnf" , (emp-rnf) ) ! upward water flux240 CALL iom_put( "emps-rnf" , (emps-rnf) ) ! c/d water flux241 CALL iom_put( "qns+qsr" , qns + qsr )! total heat flux (caution if ln_dm2dc=true, to be242 CALL iom_put( "qns" , qns )! solar heat flux moved after the call to iom_setkt)243 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 fraction293 CALL iom_put( "emp-rnf" , emp - rnf ) ! upward water flux 294 CALL iom_put( "emps-rnf", emps - rnf ) ! c/d water flux 295 CALL iom_put( "qns+qsr" , qns + qsr ) ! total heat flux (caution if ln_dm2dc=true, to be 296 CALL iom_put( "qns" , qns ) ! solar heat flux moved after the call to iom_setkt) 297 CALL iom_put( "qsr" , qsr ) ! solar heat flux moved after the call to iom_setkt) 298 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 245 299 ENDIF 246 300 ! … … 253 307 ! 254 308 IF(ln_ctl) THEN ! print mean trends (used for debugging) 255 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i- : ', mask1=tmask, ovlap=1 )256 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 ) 257 CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 258 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns- : ', mask1=tmask, ovlap=1 )259 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr- : ', mask1=tmask, ovlap=1 )260 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask: ', mask1=tmask, ovlap=1, kdim=jpk )261 CALL prt_ctl(tab3d_1=tn , clinfo1=' sst- : ', mask1=tmask, ovlap=1, kdim=1 )262 CALL prt_ctl(tab3d_1=sn , clinfo1=' sss- : ', mask1=tmask, ovlap=1, kdim=1 )263 CALL prt_ctl(tab2d_1=utau , clinfo1=' utau- : ', mask1=umask, &264 & tab2d_2=vtau , clinfo2=' vtau- : ', mask2=vmask, ovlap=1 )309 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 ) 310 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask, ovlap=1 ) 311 CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 312 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask, ovlap=1 ) 313 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1 ) 314 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, ovlap=1, kdim=jpk ) 315 CALL prt_ctl(tab3d_1=tn , clinfo1=' sst - : ', mask1=tmask, ovlap=1, kdim=1 ) 316 CALL prt_ctl(tab3d_1=sn , clinfo1=' sss - : ', mask1=tmask, ovlap=1, kdim=1 ) 317 CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, & 318 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 ) 265 319 ENDIF 266 320 !
Note: See TracChangeset
for help on using the changeset viewer.