New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
usrdef_sbc.F90 in branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC – NEMO

source: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/MY_SRC/usrdef_sbc.F90 @ 8696

Last change on this file since 8696 was 8696, checked in by clem, 6 years ago

debug sas_biper
File size: 6.8 KB
Line 
1MODULE usrdef_sbc
2   !!======================================================================
3   !!                       ***  MODULE  usrdef_sbc  ***
4   !!
5   !!                     ===  SAS_BIPER configuration  ===
6   !!
7   !! User defined :   surface forcing of a user configuration
8   !!======================================================================
9   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   usr_def_sbc    : user defined surface bounday conditions in SAS_BIPER case
14   !!----------------------------------------------------------------------
15   USE oce             ! ocean dynamics and tracers
16   USE dom_oce         ! ocean space and time domain
17   USE sbc_oce         ! Surface boundary condition: ocean fields
18   USE sbc_ice         ! Surface boundary condition: ice fields
19   USE phycst          ! physical constants
20   USE ice, ONLY       : at_i_b, a_i_b
21   USE icethd_dh       ! for CALL ice_thd_snwblow
22   !
23   USE in_out_manager  ! I/O manager
24   USE lib_mpp         ! distribued memory computing library
25   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
26   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
27   USE wrk_nemo
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   usrdef_sbc_oce      ! routine called by sbcmod.F90 for sbc ocean
33   PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics
34   PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo
35
36   !! * Substitutions
37#  include "vectopt_loop_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
40   !! $Id$
41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43CONTAINS
44
45   SUBROUTINE usrdef_sbc_oce( kt )
46      !!---------------------------------------------------------------------
47      !!                    ***  ROUTINE usr_def_sbc  ***
48      !!             
49      !! ** Purpose :   provide at each time-step the surface boundary
50      !!              condition, i.e. the momentum, heat and freshwater fluxes.
51      !!
52      !! ** Method  :   all 0 fields, for SAS_BIPER case
53      !!                CAUTION : never mask the surface stress field !
54      !!
55      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
56      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
57      !!
58      !!----------------------------------------------------------------------
59      INTEGER, INTENT(in) ::   kt   ! ocean time step
60      !!---------------------------------------------------------------------
61      !
62      IF( kt == nit000 ) THEN
63         !
64         IF(lwp)   WRITE(numout,*)' usrdef_sbc_oce : SAS_BIPER case: NO surface forcing'
65         ! --- oce variables --- !
66         utau(:,:) = 0._wp
67         vtau(:,:) = 0._wp
68         taum(:,:) = 0._wp
69         wndm(:,:) = 0._wp
70         !
71         emp (:,:) = 0._wp
72         sfx (:,:) = 0._wp
73         qns (:,:) = 0._wp
74         qsr (:,:) = 0._wp
75         !
76      ENDIF
77      !
78   END SUBROUTINE usrdef_sbc_oce
79
80   SUBROUTINE usrdef_sbc_ice_tau( kt )
81      !!---------------------------------------------------------------------
82      !!                     ***  ROUTINE usrdef_sbc_ice_tau  ***
83      !!
84      !! ** Purpose :   provide the surface boundary (momentum) condition over sea-ice
85      !!---------------------------------------------------------------------
86      INTEGER, INTENT(in) ::   kt   ! ocean time step
87      !!---------------------------------------------------------------------
88      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : SAS_BIPER case: NO stress forcing'
89      !
90      utau_ice(:,:) = 0._wp
91      vtau_ice(:,:) = 0._wp
92      !
93   END SUBROUTINE usrdef_sbc_ice_tau
94
95   SUBROUTINE usrdef_sbc_ice_flx( kt )
96      !!---------------------------------------------------------------------
97      !!                     ***  ROUTINE usrdef_sbc_ice_flx  ***
98      !!
99      !! ** Purpose :   provide the surface boundary (flux) condition over sea-ice
100      !!---------------------------------------------------------------------
101      REAL(wp), DIMENSION(:,:), POINTER ::   zsnw       ! snw distribution after wind blowing
102      INTEGER, INTENT(in) ::   kt   ! ocean time step
103      !!---------------------------------------------------------------------
104      CALL wrk_alloc( jpi,jpj, zsnw )
105      !
106      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : SAS_BIPER case: NO flux forcing'
107      !
108      ! ocean variables (renaming)
109      emp_oce (:,:)   = 0._wp   ! uniform value for freshwater budget (E-P)
110      qsr_oce (:,:)   = 0._wp   ! uniform value for     solar radiation
111      qns_oce (:,:)   = 0._wp   ! uniform value for non-solar radiation
112
113      ! ice variables
114      alb_ice (:,:,:) = 0.7_wp  ! useless
115      qsr_ice (:,:,:) = 0._wp   ! uniform value for     solar radiation
116      qns_ice (:,:,:) = 0._wp   ! uniform value for non-solar radiation
117      sprecip (:,:)   = 0._wp   ! uniform value for snow precip
118      evap_ice(:,:,:) = 0._wp   ! uniform value for sublimation
119
120      ! ice fields deduced from above
121      zsnw(:,:) = 1._wp
122      !!CALL lim_thd_snwblow( at_i_b, zsnw )  ! snow distribution over ice after wind blowing
123      emp_ice  (:,:)   = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
124      emp_oce  (:,:)   = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
125      qevap_ice(:,:,:) =   0._wp
126      qprec_ice(:,:)   =   rhosn * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) !  in J/m3
127      qemp_oce (:,:)   = - emp_oce(:,:) * sst_m(:,:) * rcp
128      qemp_ice (:,:)   =   sprecip(:,:) * zsnw * ( sst_m(:,:) * cpic - lfus ) * tmask(:,:,1) ! solid precip (only)
129
130      ! total fluxes
131      emp_tot (:,:) = emp_ice  + emp_oce
132      qns_tot (:,:) = at_i_b(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
133      qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
134
135      !--------------------------------------------------------------------
136      ! FRACTIONs of net shortwave radiation which is not absorbed in the
137      ! thin surface layer and penetrates inside the ice cover
138      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 )
139      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )
140      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )
141
142      CALL wrk_dealloc( jpi,jpj, zsnw )
143
144   END SUBROUTINE usrdef_sbc_ice_flx
145
146
147   !!======================================================================
148END MODULE usrdef_sbc
Note: See TracBrowser for help on using the repository browser.