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 NEMO/branches/2020/dev_r2052_ENHANCE-09_rbourdal_massfluxconvection/tests/ICE_ADV2D/MY_SRC – NEMO

source: NEMO/branches/2020/dev_r2052_ENHANCE-09_rbourdal_massfluxconvection/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90 @ 14009

Last change on this file since 14009 was 14009, checked in by gsamson, 3 years ago

dev_r2052_ENHANCE-09_rbourdal_massfluxconvection update with trunk@r14008
File size: 7.6 KB
Line 
1MODULE usrdef_sbc
2   !!======================================================================
3   !!                       ***  MODULE  usrdef_sbc  ***
4   !!
5   !!                      ===  ICE_ADV2D 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 ICE_ADV2D 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       : jpl, 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
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   usrdef_sbc_oce      ! routine called by sbcmod.F90 for sbc ocean
32   PUBLIC   usrdef_sbc_ice_tau  ! routine called by icestp.F90 for ice dynamics
33   PUBLIC   usrdef_sbc_ice_flx  ! routine called by icestp.F90 for ice thermo
34
35   !!----------------------------------------------------------------------
36   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
37   !! $Id: usrdef_sbc.F90 10074 2018-08-28 16:15:49Z nicolasmartin $
38   !! Software governed by the CeCILL license (see ./LICENSE)
39   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE usrdef_sbc_oce( kt, Kbb )
43      !!---------------------------------------------------------------------
44      !!                    ***  ROUTINE usr_def_sbc  ***
45      !!             
46      !! ** Purpose :   provide at each time-step the surface boundary
47      !!              condition, i.e. the momentum, heat and freshwater fluxes.
48      !!
49      !! ** Method  :   all 0 fields, for ICE_ADV2D case
50      !!                CAUTION : never mask the surface stress field !
51      !!
52      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
53      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
54      !!
55      !!----------------------------------------------------------------------
56      INTEGER, INTENT(in) ::   kt   ! ocean time step
57      INTEGER, INTENT(in) ::   Kbb  ! ocean time index
58      !!---------------------------------------------------------------------
59      !
60      IF( kt == nit000 ) THEN
61         !
62         IF(lwp)   WRITE(numout,*)' usrdef_sbc_oce : ICE_ADV2D case: NO surface forcing'
63         ! --- oce variables --- !
64         utau(:,:) = 0._wp 
65         vtau(:,:) = 0._wp
66         taum(:,:) = 0._wp
67         wndm(:,:) = 0._wp
68         !
69         emp (:,:) = 0._wp
70         sfx (:,:) = 0._wp
71         qns (:,:) = 0._wp
72         qsr (:,:) = 0._wp
73         !
74         utau_b(:,:) = 0._wp 
75         vtau_b(:,:) = 0._wp
76         emp_b (:,:) = 0._wp
77         sfx_b (:,:) = 0._wp
78         qns_b (:,:) = 0._wp
79         !
80      ENDIF
81      !
82   END SUBROUTINE usrdef_sbc_oce
83
84   SUBROUTINE usrdef_sbc_ice_tau( kt )
85      !!---------------------------------------------------------------------
86      !!                     ***  ROUTINE usrdef_sbc_ice_tau  ***
87      !!
88      !! ** Purpose :   provide the surface boundary (momentum) condition over sea-ice
89      !!---------------------------------------------------------------------
90      INTEGER, INTENT(in) ::   kt   ! ocean time step
91      !!---------------------------------------------------------------------
92      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : ICE_ADV2D case: constant stress forcing'
93      !
94      utau_ice(:,:) = 1.3_wp   ! <=> 0.5 m/s
95      vtau_ice(:,:) = 0._wp
96      !
97   END SUBROUTINE usrdef_sbc_ice_tau
98
99   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
100      !!---------------------------------------------------------------------
101      !!                     ***  ROUTINE usrdef_sbc_ice_flx  ***
102      !!
103      !! ** Purpose :   provide the surface boundary (flux) condition over sea-ice
104      !!---------------------------------------------------------------------
105      INTEGER, INTENT(in) ::   kt   ! ocean time step
106      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   phs    ! snow thickness
107      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   phi    ! ice thickness
108      !!
109      INTEGER  ::   jl
110      REAL(wp) ::   zfr1, zfr2                 ! local variables
111      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing
112      REAL(wp), DIMENSION(jpi,jpj) ::   ztri
113      !!---------------------------------------------------------------------
114      !
115      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : ICE_ADV2D case: NO flux forcing'
116      !
117      ! ocean variables (renaming)
118      emp_oce (:,:)   = 0._wp   ! uniform value for freshwater budget (E-P)
119      qsr_oce (:,:)   = 0._wp   ! uniform value for     solar radiation
120      qns_oce (:,:)   = 0._wp   ! uniform value for non-solar radiation
121
122      ! ice variables
123      alb_ice (:,:,:) = 0.7_wp  ! useless
124      qsr_ice (:,:,:) = 0._wp   ! uniform value for     solar radiation
125      qns_ice (:,:,:) = 0._wp   ! uniform value for non-solar radiation
126      sprecip (:,:)   = 0._wp   ! uniform value for snow precip
127      evap_ice(:,:,:) = 0._wp   ! uniform value for sublimation
128
129      ! ice fields deduced from above
130      zsnw(:,:) = 1._wp
131      !!CALL lim_thd_snwblow( at_i_b, zsnw )  ! snow distribution over ice after wind blowing
132      emp_ice  (:,:)   = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
133      emp_oce  (:,:)   = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
134      qevap_ice(:,:,:) =   0._wp
135      qprec_ice(:,:)   =   rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) !  in J/m3
136      qemp_oce (:,:)   = - emp_oce(:,:) * sst_m(:,:) * rcp
137      qemp_ice (:,:)   =   sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
138
139      ! total fluxes
140      emp_tot (:,:) = emp_ice  + emp_oce
141      qns_tot (:,:) = at_i_b(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
142      qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
143
144      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- !
145      cloud_fra(:,:) = pp_cldf
146      ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:)  ! surface transmission when hi>10cm
147      !
148      DO jl = 1, jpl
149         WHERE    ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) <  0.1_wp )     ! linear decrease from hi=0 to 10cm 
150            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) )
151         ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp )     ! constant (ztri) when hi>10cm
152            qtr_ice_top(:,:,jl) = qsr_ice(:,:,jl) * ztri(:,:)
153         ELSEWHERE                                                         ! zero when hs>0
154            qtr_ice_top(:,:,jl) = 0._wp
155         END WHERE
156      ENDDO
157         
158 
159   END SUBROUTINE usrdef_sbc_ice_flx
160
161
162   !!======================================================================
163END MODULE usrdef_sbc
Note: See TracBrowser for help on using the repository browser.