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.
sbcice_lim_2.F90 in branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 @ 8877

Last change on this file since 8877 was 8877, checked in by frrh, 6 years ago

Clear out SVN keywords and properties.

File size: 13.5 KB
Line 
1MODULE sbcice_lim_2
2   !!======================================================================
3   !!                       ***  MODULE  sbcice_lim_2  ***
4   !! Surface module :  update surface ocean boundary condition over ice covered area using LIM sea-ice model
5   !! Sea-Ice model  :  LIM-2 Sea ice model time-stepping
6   !!======================================================================
7   !! History :  1.0   !  06-2006  (G. Madec)  from icestp_2.F90
8   !!            3.0   !  08-2008  (S. Masson, E. .... ) coupled interface
9   !!            3.3   !  05-2009  (G.Garric) addition of the lim2_evp case
10   !!----------------------------------------------------------------------
11#if defined key_lim2
12   !!----------------------------------------------------------------------
13   !!   'key_lim2' :                                    LIM-2 sea-ice model
14   !!----------------------------------------------------------------------
15   !!   sbc_ice_lim_2   : sea-ice model time-stepping and update ocean sbc over ice-covered area
16   !!----------------------------------------------------------------------
17   USE oce              ! ocean dynamics and tracers
18   USE dom_oce          ! ocean space and time domain
19   USE ice_2
20   USE par_ice_2
21   USE iceini_2
22   USE dom_ice_2
23
24   USE sbc_oce          ! Surface boundary condition: ocean fields
25   USE sbc_ice          ! Surface boundary condition: ice   fields
26   USE sbcblk           ! Surface boundary condition: bulk
27   USE sbccpl           ! Surface boundary condition: coupled interface
28   USE albedo
29
30   USE phycst           ! Define parameters for the routines
31   USE eosbn2           ! equation of state
32   USE limdyn_2
33   USE limtrp_2
34   USE limdmp_2
35   USE limthd_2
36   USE limsbc_2         ! sea surface boundary condition
37   USE limdia_2
38   USE limwri_2
39   USE limrst_2
40
41   USE c1d              ! 1D vertical configuration
42
43   USE lbclnk           ! lateral boundary condition - MPP link
44   USE lib_mpp          ! MPP library
45   USE wrk_nemo         ! work arrays
46   USE iom              ! I/O manager library
47   USE in_out_manager   ! I/O manager
48   USE prtctl           ! Print control
49
50# if defined key_agrif
51   USE agrif_ice
52   USE agrif_lim2_update
53# endif
54
55   USE bdy_oce   , ONLY: ln_bdy
56   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine)
57
58   IMPLICIT NONE
59   PRIVATE
60
61   PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
62
63   !! * Substitutions
64#  include "vectopt_loop_substitute.h90"
65   !!----------------------------------------------------------------------
66   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
67   !! $Id$
68   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
69   !!----------------------------------------------------------------------
70CONTAINS
71
72   SUBROUTINE sbc_ice_lim_2( kt, ksbc )
73      !!---------------------------------------------------------------------
74      !!                  ***  ROUTINE sbc_ice_lim_2  ***
75      !!                   
76      !! ** Purpose :   update the ocean surface boundary condition via the
77      !!                Louvain la Neuve Sea Ice Model time stepping
78      !!
79      !! ** Method  :   ice model time stepping
80      !!              - call the ice dynamics routine
81      !!              - call the ice advection/diffusion routine
82      !!              - call the ice thermodynamics routine
83      !!              - call the routine that computes mass and
84      !!                heat fluxes at the ice/ocean interface
85      !!              - save the outputs
86      !!              - save the outputs for restart when necessary
87      !!
88      !! ** Action  : - time evolution of the LIM sea-ice model
89      !!              - update all sbc variables below sea-ice:
90      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx
91      !!---------------------------------------------------------------------
92      INTEGER, INTENT(in) ::   kt      ! ocean time step
93      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =4 bulk ; =5 coupled )
94      !!
95      INTEGER  ::   ji, jj   ! dummy loop indices
96      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os   ! ice albedo under overcast sky
97      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs   ! ice albedo under clear sky
98      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice  ! mean ice albedo
99      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist     ! ice surface temperature (K)
100      REAL(wp), DIMENSION(:,:  ), POINTER :: zutau_ice, zvtau_ice 
101      !!----------------------------------------------------------------------
102
103      IF( kt == nit000 ) THEN
104         IF(lwp) WRITE(numout,*)
105         IF(lwp) WRITE(numout,*) 'sbc_ice_lim_2 : update ocean surface boudary condition' 
106         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM) time stepping'
107         !
108         CALL ice_init_2
109         !
110# if defined key_agrif
111         IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2   ! AGRIF: set the meshes
112# endif
113      ENDIF
114
115      !                                        !----------------------!
116      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
117         !                                     !----------------------!
118# if defined key_agrif
119         IF( .NOT. Agrif_Root() ) lim_nbstep = MOD(lim_nbstep,Agrif_rhot()&
120         &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
121# endif
122
123         CALL wrk_alloc( jpi,jpj  , zutau_ice, zvtau_ice)
124         CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
125
126         !  Bulk Formulea !
127         !----------------!
128         ! ... mean surface ocean current at ice dynamics point
129         SELECT CASE( cp_ice_msh )
130         CASE( 'I' )                  !== B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
131            DO jj = 2, jpj
132               DO ji = 2, jpi   ! NO vector opt. possible
133                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) * umask(ji-1,jj  ,1) &
134                     &                    + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
135                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) * vmask(ji  ,jj-1,1) &
136                     &                    + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
137               END DO
138            END DO
139            CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
140            CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
141            !
142         CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
143            u_oce(:,:) = ssu_m(:,:) * umask(:,:,1)                     ! mean surface ocean current at ice velocity point
144            v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
145            !
146         END SELECT
147
148         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
149         CALL eos_fzp( sss_m(:,:), tfu(:,:) )
150         tfu(:,:) = tfu(:,:) + rt0
151
152         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
153
154         ! Ice albedo
155
156         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
157                                 reshape( hsnif, (/jpi,jpj,1/) ), &
158                          zalb_cs, zalb_os )
159
160         SELECT CASE( ksbc )
161         CASE( jp_blk , jp_purecpl )   ! BULK and COUPLED bulk formulations
162
163            ! albedo depends on cloud fraction because of non-linear spectral effects
164            zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
165
166         END SELECT
167
168         ! ... Sea-ice surface boundary conditions output from bulk formulae :
169         !     - utau_ice   ! surface ice stress i-component (I-point)   [N/m2]
170         !     - vtau_ice   ! surface ice stress j-component (I-point)   [N/m2]
171         !     - qns_ice    ! non solar heat flux over ice   (T-point)   [W/m2]
172         !     - qsr_ice    !     solar heat flux over ice   (T-point)   [W/m2]
173         !     - qla_ice    ! latent    heat flux over ice   (T-point)   [W/m2]
174         !     - dqns_ice   ! non solar heat sensistivity    (T-point)   [W/m2]
175         !     - dqla_ice   ! latent    heat sensistivity    (T-point)   [W/m2]
176         !     - tprecip    ! total precipitation            (T-point)   [Kg/m2/s]
177         !     - sprecip    ! solid precipitation            (T-point)   [Kg/m2/s]
178         !     - fr1_i0     ! 1sr fraction of qsr penetration in ice     [%]
179         !     - fr2_i0     ! 2nd fraction of qsr penetration in ice     [%]
180         !
181         SELECT CASE( ksbc )
182         !
183         CASE( jp_blk )           ! Bulk formulation
184            CALL blk_ice_tau
185            CALL blk_ice_flx( zsist, zalb_ice )
186            !
187         CASE( jp_purecpl )            ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
188            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
189            !
190         END SELECT
191         
192         IF( ln_mixcpl) THEN
193            CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
194            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
195            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
196         ENDIF
197
198         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point
199         CALL iom_put( 'vtau_ice', vtau_ice )     ! Wind stress over ice along j-axis at I-point
200
201         IF(ln_ctl) THEN         ! print mean trends (used for debugging)
202            CALL prt_ctl_info( 'Ice Forcings ' )
203            CALL prt_ctl( tab2d_1=tprecip ,clinfo1=' sbc_ice_lim: precip  : ', tab2d_2=sprecip , clinfo2=' Snow    : ' )
204            CALL prt_ctl( tab2d_1=utau_ice,clinfo1=' sbc_ice_lim: utau_ice: ', tab2d_2=vtau_ice, clinfo2=' vtau_ice: ' )
205            CALL prt_ctl( tab2d_1=sst_m   ,clinfo1=' sbc_ice_lim: sst     : ', tab2d_2=sss_m   , clinfo2=' sss     : ' )
206            CALL prt_ctl( tab2d_1=u_oce   ,clinfo1=' sbc_ice_lim: u_io    : ', tab2d_2=v_oce   , clinfo2=' v_io    : ' )
207            CALL prt_ctl( tab2d_1=hsnif   ,clinfo1=' sbc_ice_lim: hsnif  1: ', tab2d_2=hicif   , clinfo2=' hicif   : ' )
208            CALL prt_ctl( tab2d_1=frld    ,clinfo1=' sbc_ice_lim: frld   1: ', tab2d_2=sist    , clinfo2=' sist    : ' )
209         ENDIF
210
211         ! ---------------- !
212         !  Ice model step  !
213         ! ---------------- !
214         numit = numit + nn_fsbc                           ! Ice model time step
215
216                           CALL lim_rst_opn_2  ( kt )  ! Open Ice restart file
217         IF( .NOT. lk_c1d ) THEN                       ! Ice dynamics & transport (except in 1D case)
218                           CALL lim_dyn_2      ( kt )      ! Ice dynamics    ( rheology/dynamics )
219                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion )
220           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping
221           IF( ln_bdy    ) CALL bdy_ice_lim( kt ) ! bdy ice thermo
222         END IF
223         !                                             ! Ice surface fluxes in coupled mode
224         IF( ln_cpl ) THEN   ! pure coupled and mixed forced-coupled configurations
225            a_i(:,:,1)=fr_i
226            CALL sbc_cpl_ice_flx( frld,                                              &
227            !                                optional arguments, used only in 'mixed oce-ice' case
228            &                                             palbi=zalb_ice, psst=sst_m, pist=zsist )
229            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
230         ENDIF
231                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics
232                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes
233
234         IF(  .NOT. lk_mpp )THEN
235            IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 )   &
236            &              CALL lim_dia_2      ( kt )      ! Ice Diagnostics
237         ENDIF
238# if ! defined key_iomput
239                           CALL lim_wri_2      ( kt )      ! Ice outputs
240# endif
241         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
242         !
243# if defined key_agrif && defined key_lim2
244         IF( .NOT. Agrif_Root() )   CALL agrif_update_lim2( kt )
245# endif
246         !
247         CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice)
248         CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
249         !
250      ENDIF                                    ! End sea-ice time step only
251      !
252      !                                        !--------------------------!
253      !                                        !  at all ocean time step  !
254      !                                        !--------------------------!
255      !                                               
256      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
257      !                                                   ! otherwise the atm.-ocean stresses are used everywhere
258      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
259      !
260   END SUBROUTINE sbc_ice_lim_2
261
262#else
263   !!----------------------------------------------------------------------
264   !!   Default option           Dummy module      NO LIM 2.0 sea-ice model
265   !!----------------------------------------------------------------------
266CONTAINS
267   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine
268      INTEGER, INTENT(in) ::   kt, ksbc   
269      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc
270   END SUBROUTINE sbc_ice_lim_2
271#endif
272
273   !!======================================================================
274END MODULE sbcice_lim_2
Note: See TracBrowser for help on using the repository browser.