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/trunk/tests/BENCH/MY_SRC – NEMO

source: NEMO/trunk/tests/BENCH/MY_SRC/usrdef_sbc.F90 @ 13295

Last change on this file since 13295 was 13295, checked in by acc, 4 years ago

Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision
File size: 8.6 KB
Line 
1MODULE usrdef_sbc
2   !!======================================================================
3   !!                       ***  MODULE  usrdef_sbc  ***
4   !!
5   !!                      ===  BENCH configuration  ===
6   !!
7   !! User defined :   surface forcing of a user configuration
8   !!======================================================================
9   !! History :  4.0   !
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   usr_def_sbc    : user defined surface bounday conditions in BENCH case
14   !!----------------------------------------------------------------------
15   USE par_oce        ! ocean space and time domain
16   USE dom_oce       
17   USE oce             ! ocean dynamics and tracers
18   USE sbc_oce         ! Surface boundary condition: ocean fields
19   USE sbc_ice         ! Surface boundary condition: ocean fields
20   USE in_out_manager  ! I/O manager
21   USE phycst          ! physical constants
22   USE lib_mpp         ! MPP library
23   USE lbclnk          ! lateral boundary conditions - mpp exchanges
24
25#if defined key_si3
26   USE ice, ONLY       : at_i_b, a_i_b
27#endif
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   usrdef_sbc_oce      ! routine called in sbcmod module
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 "do_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, Kbb )
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 BENCH 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      INTEGER, INTENT(in) ::   Kbb  ! ocean time index
61      !!---------------------------------------------------------------------
62      !     
63      IF( kt == nit000 ) THEN
64         !
65         IF(lwp) WRITE(numout,*)' usr_sbc : BENCH case: surface forcing'
66         IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   vtau = taum = wndm = qns = qsr = emp = sfx = 0'
67         !
68         utau(:,:) = 0._wp
69         vtau(:,:) = 0._wp
70         taum(:,:) = 0._wp
71         wndm(:,:) = 0._wp
72         !
73         emp (:,:) = 0._wp
74         sfx (:,:) = 0._wp
75         qns (:,:) = 0._wp
76         qsr (:,:) = 0._wp
77         !
78         utau_b(:,:) = 0._wp 
79         vtau_b(:,:) = 0._wp
80         emp_b (:,:) = 0._wp
81         sfx_b (:,:) = 0._wp
82         qns_b (:,:) = 0._wp
83         !
84      ENDIF
85     
86      !
87   END SUBROUTINE usrdef_sbc_oce
88
89   
90   SUBROUTINE usrdef_sbc_ice_tau( kt )
91      !!---------------------------------------------------------------------
92      !!                     ***  ROUTINE usrdef_sbc_ice_tau  ***
93      !!
94      !! ** Purpose :   provide the surface boundary (momentum) condition over
95      !sea-ice
96      !!---------------------------------------------------------------------
97      INTEGER, INTENT(in) ::   kt   ! ocean time step
98      !
99      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
100      INTEGER  ::   ji, jj
101      INTEGER  ::   igloi, igloj   ! to be removed in the future, see comment bellow
102      !!---------------------------------------------------------------------
103#if defined key_si3
104      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : BENCH case: constant stress forcing'
105      !
106      ! define unique value on each point. z2d ranging from 0.05 to -0.05
107      !
108      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,
109      ! we must define z2d as bellow.
110      ! Once we decide to forget trunk compatibility, we must simply define z2d as:
111!!$      DO_2D( 0, 0, 0, 0 )
112!!$         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) )
113!!$      END_2D
114      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) )
115      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) )
116      DO_2D( 0, 0, 0, 0 )
117         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) )
118      END_2D
119      utau_ice(:,:) = 0.1_wp + z2d(:,:)
120      vtau_ice(:,:) = 0.1_wp + z2d(:,:)
121
122      CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
123#endif
124      !
125   END SUBROUTINE usrdef_sbc_ice_tau
126
127   
128   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
129      !!---------------------------------------------------------------------
130      !!                     ***  ROUTINE usrdef_sbc_ice_flx  ***
131      !!
132      !! ** Purpose :   provide the surface boundary (flux) condition over
133      !sea-ice
134      !!---------------------------------------------------------------------
135      INTEGER, INTENT(in) ::   kt   ! ocean time step
136      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
137      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
138      !!
139      REAL(wp) ::   zfr1, zfr2                 ! local variables
140      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing
141      !!---------------------------------------------------------------------
142      !
143#if defined key_si3
144      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : BENCH case: NO flux forcing'
145      !
146      ! ocean variables (renaming)
147      emp_oce (:,:)   = 0._wp   ! uniform value for freshwater budget (E-P)
148      qsr_oce (:,:)   = 0._wp   ! uniform value for     solar radiation
149      qns_oce (:,:)   = 0._wp   ! uniform value for non-solar radiation
150
151      ! ice variables
152      alb_ice (:,:,:) = 0.7_wp  ! useless
153      qsr_ice (:,:,:) = 0._wp   ! uniform value for     solar radiation
154      qns_ice (:,:,:) = 0._wp   ! uniform value for non-solar radiation
155      sprecip (:,:)   = 0._wp   ! uniform value for snow precip
156      evap_ice(:,:,:) = 0._wp   ! uniform value for sublimation
157
158      ! ice fields deduced from above
159      zsnw(:,:) = 1._wp
160      !!CALL lim_thd_snwblow( at_i_b, zsnw )  ! snow distribution over ice after
161      !wind blowing
162      emp_ice  (:,:)   = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
163      emp_oce  (:,:)   = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
164      qevap_ice(:,:,:) =   0._wp
165      qprec_ice(:,:)   =   rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) !  in J/m3
166      qemp_oce (:,:)   = - emp_oce(:,:) * sst_m(:,:) * rcp
167      qemp_ice (:,:)   =   sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
168
169      ! total fluxes
170      emp_tot (:,:) = emp_ice  + emp_oce
171      qns_tot (:,:) = at_i_b(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
172      qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
173
174      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- !
175      zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm
176      zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1
177      !
178      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
179         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )
180      ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm
181         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1
182      ELSEWHERE                                                         ! zero when hs>0
183         qtr_ice_top(:,:,:) = 0._wp 
184      END WHERE
185#endif
186
187   END SUBROUTINE usrdef_sbc_ice_flx
188
189   !!======================================================================
190END MODULE usrdef_sbc
Note: See TracBrowser for help on using the repository browser.