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

Last change on this file since 12377 was 12377, checked in by acc, 7 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

File size: 7.8 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   !!----------------------------------------------------------------------
37   !! NEMO/OPA 4.0 , NEMO Consortium (2016)
38   !! $Id$
39   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
40   !!----------------------------------------------------------------------
41CONTAINS
42
43   SUBROUTINE usrdef_sbc_oce( kt, Kbb )
44      !!---------------------------------------------------------------------
45      !!                    ***  ROUTINE usr_def_sbc  ***
46      !!             
47      !! ** Purpose :   provide at each time-step the surface boundary
48      !!              condition, i.e. the momentum, heat and freshwater fluxes.
49      !!
50      !! ** Method  :   all 0 fields, for BENCH case
51      !!                CAUTION : never mask the surface stress field !
52      !!
53      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.   
54      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx
55      !!
56      !!----------------------------------------------------------------------
57      INTEGER, INTENT(in) ::   kt   ! ocean time step
58      INTEGER, INTENT(in) ::   Kbb  ! ocean time index
59      !!---------------------------------------------------------------------
60      !     
61      IF( kt == nit000 ) THEN
62         !
63         IF(lwp) WRITE(numout,*)' usr_sbc : BENCH case: surface forcing'
64         IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   vtau = taum = wndm = qns = qsr = emp = sfx = 0'
65         !
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         utau_b(:,:) = 0._wp 
77         vtau_b(:,:) = 0._wp
78         emp_b (:,:) = 0._wp
79         sfx_b (:,:) = 0._wp
80         qns_b (:,:) = 0._wp
81         !
82      ENDIF
83     
84      !
85   END SUBROUTINE usrdef_sbc_oce
86
87   
88   SUBROUTINE usrdef_sbc_ice_tau( kt )
89      !!---------------------------------------------------------------------
90      !!                     ***  ROUTINE usrdef_sbc_ice_tau  ***
91      !!
92      !! ** Purpose :   provide the surface boundary (momentum) condition over
93      !sea-ice
94      !!---------------------------------------------------------------------
95      INTEGER, INTENT(in) ::   kt   ! ocean time step
96      !
97      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
98      INTEGER  ::   ji, jj
99      !!---------------------------------------------------------------------
100#if defined key_si3
101      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : BENCH case: constant stress forcing'
102      !
103      ! define unique value on each point. z2d ranging from 0.05 to -0.05
104      DO jj = 1, jpj
105         DO ji = 1, jpi
106            z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) )
107         ENDDO
108      ENDDO
109      utau_ice(:,:) = 0.1_wp +  z2d(:,:)
110      vtau_ice(:,:) = 0.1_wp +  z2d(:,:)
111
112      CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. )
113#endif
114      !
115   END SUBROUTINE usrdef_sbc_ice_tau
116
117   
118   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi )
119      !!---------------------------------------------------------------------
120      !!                     ***  ROUTINE usrdef_sbc_ice_flx  ***
121      !!
122      !! ** Purpose :   provide the surface boundary (flux) condition over
123      !sea-ice
124      !!---------------------------------------------------------------------
125      INTEGER, INTENT(in) ::   kt   ! ocean time step
126      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness
127      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness
128      !!
129      REAL(wp) ::   zfr1, zfr2                 ! local variables
130      REAL(wp), DIMENSION(jpi,jpj) ::   zsnw   ! snw distribution after wind blowing
131      !!---------------------------------------------------------------------
132      !
133#if defined key_si3
134      IF( kt==nit000 .AND. lwp)   WRITE(numout,*)' usrdef_sbc_ice : BENCH case: NO flux forcing'
135      !
136      ! ocean variables (renaming)
137      emp_oce (:,:)   = 0._wp   ! uniform value for freshwater budget (E-P)
138      qsr_oce (:,:)   = 0._wp   ! uniform value for     solar radiation
139      qns_oce (:,:)   = 0._wp   ! uniform value for non-solar radiation
140
141      ! ice variables
142      alb_ice (:,:,:) = 0.7_wp  ! useless
143      qsr_ice (:,:,:) = 0._wp   ! uniform value for     solar radiation
144      qns_ice (:,:,:) = 0._wp   ! uniform value for non-solar radiation
145      sprecip (:,:)   = 0._wp   ! uniform value for snow precip
146      evap_ice(:,:,:) = 0._wp   ! uniform value for sublimation
147
148      ! ice fields deduced from above
149      zsnw(:,:) = 1._wp
150      !!CALL lim_thd_snwblow( at_i_b, zsnw )  ! snow distribution over ice after
151      !wind blowing
152      emp_ice  (:,:)   = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw(:,:)
153      emp_oce  (:,:)   = emp_oce(:,:) - sprecip(:,:) * (1._wp - zsnw(:,:) )
154      qevap_ice(:,:,:) =   0._wp
155      qprec_ice(:,:)   =   rhos * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) !  in J/m3
156      qemp_oce (:,:)   = - emp_oce(:,:) * sst_m(:,:) * rcp
157      qemp_ice (:,:)   =   sprecip(:,:) * zsnw * ( sst_m(:,:) * rcpi - rLfus ) * tmask(:,:,1) ! solid precip (only)
158
159      ! total fluxes
160      emp_tot (:,:) = emp_ice  + emp_oce
161      qns_tot (:,:) = at_i_b(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:)
162      qsr_tot (:,:) = at_i_b(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 )
163
164      ! --- shortwave radiation transmitted below the surface (W/m2, see Grenfell Maykut 77) --- !
165      zfr1 = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice )            ! transmission when hi>10cm
166      zfr2 = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice )            ! zfr2 such that zfr1 + zfr2 to equal 1
167      !
168      WHERE    ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) <  0.1_wp )       ! linear decrease from hi=0 to 10cm 
169         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( zfr1 + zfr2 * ( 1._wp - phi(:,:,:) * 10._wp ) )
170      ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp )       ! constant (zfr1) when hi>10cm
171         qtr_ice_top(:,:,:) = qsr_ice(:,:,:) * zfr1
172      ELSEWHERE                                                         ! zero when hs>0
173         qtr_ice_top(:,:,:) = 0._wp 
174      END WHERE
175#endif
176
177   END SUBROUTINE usrdef_sbc_ice_flx
178
179   !!======================================================================
180END MODULE usrdef_sbc
Note: See TracBrowser for help on using the repository browser.