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/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 @ 2834

Last change on this file since 2834 was 2834, checked in by charris, 13 years ago

#662 Tidying of sbc_cpl_ice_flx (mainly related to LIM2). There is still scope for cleaning up the use of ice fraction and lead fraction in the sbccpl routines, but best to wait until the LIM3 functionality is properly sorted.

  • Property svn:keywords set to Id
File size: 13.1 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_core      ! Surface boundary condition: CORE bulk
27   USE sbcblk_clio      ! Surface boundary condition: CLIO bulk
28   USE sbccpl           ! Surface boundary condition: coupled interface
29   USE albedo
30
31   USE phycst           ! Define parameters for the routines
32   USE eosbn2           ! equation of state
33   USE limdyn_2
34   USE limtrp_2
35   USE limdmp_2
36   USE limthd_2
37   USE limsbc_2         ! sea surface boundary condition
38   USE limdia_2
39   USE limwri_2
40   USE limrst_2
41
42   USE c1d              ! 1D vertical configuration
43
44   USE lbclnk           ! lateral boundary condition - MPP link
45   USE lib_mpp          ! MPP library
46   USE iom              ! I/O manager library
47   USE in_out_manager   ! I/O manager
48   USE prtctl           ! Print control
49
50   IMPLICIT NONE
51   PRIVATE
52
53   PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
54
55   !! * Substitutions
56#  include "domzgr_substitute.h90"
57#  include "vectopt_loop_substitute.h90"
58   !!----------------------------------------------------------------------
59   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
60   !! $Id$
61   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
62   !!----------------------------------------------------------------------
63CONTAINS
64
65   SUBROUTINE sbc_ice_lim_2( kt, ksbc )
66      !!---------------------------------------------------------------------
67      !!                  ***  ROUTINE sbc_ice_lim_2  ***
68      !!                   
69      !! ** Purpose :   update the ocean surface boundary condition via the
70      !!                Louvain la Neuve Sea Ice Model time stepping
71      !!
72      !! ** Method  :   ice model time stepping
73      !!              - call the ice dynamics routine
74      !!              - call the ice advection/diffusion routine
75      !!              - call the ice thermodynamics routine
76      !!              - call the routine that computes mass and
77      !!                heat fluxes at the ice/ocean interface
78      !!              - save the outputs
79      !!              - save the outputs for restart when necessary
80      !!
81      !! ** Action  : - time evolution of the LIM sea-ice model
82      !!              - update all sbc variables below sea-ice:
83      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps
84      !!---------------------------------------------------------------------
85      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
86      USE wrk_nemo, ONLY:   wrk_3d_1 , wrk_3d_2 , wrk_3d_3   ! 3D workspace
87      !!
88      INTEGER, INTENT(in) ::   kt      ! ocean time step
89      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled )
90      !!
91      INTEGER  ::   ji, jj   ! dummy loop indices
92      ! Pointers into workspaces contained in the wrk_nemo module
93      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky
94      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky
95      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K)
96      !!----------------------------------------------------------------------
97
98      IF( wrk_in_use(3, 1,2,3) ) THEN
99         CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable')   ;   RETURN
100      ENDIF
101      ! Use pointers to access only sub-arrays of workspaces
102      zalb_ice_os => wrk_3d_1(:,:,1:1)
103      zalb_ice_cs => wrk_3d_2(:,:,1:1)
104      zsist       => wrk_3d_3(:,:,1:1)
105
106      IF( kt == nit000 ) THEN
107         IF(lwp) WRITE(numout,*)
108         IF(lwp) WRITE(numout,*) 'sbc_ice_lim_2 : update ocean surface boudary condition' 
109         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM) time stepping'
110         !
111         CALL ice_init_2
112      ENDIF
113
114      !                                        !----------------------!
115      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
116         !                                     !----------------------!
117         !  Bulk Formulea !
118         !----------------!
119         ! ... mean surface ocean current at ice dynamics point
120         SELECT CASE( cp_ice_msh )
121         CASE( 'I' )                  !== B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
122            DO jj = 2, jpj
123               DO ji = 2, jpi   ! NO vector opt. possible
124                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
125                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
126               END DO
127            END DO
128            CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
129            CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
130            !
131         CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
132            u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
133            v_oce(:,:) = ssv_m(:,:)
134            !
135         END SELECT
136
137         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
138         tfu(:,:) = tfreez( sss_m ) +  rt0 
139
140         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
141
142         ! ... ice albedo (clear sky and overcast sky)
143         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
144                                 reshape( hsnif, (/jpi,jpj,1/) ), &
145                          zalb_ice_cs, zalb_ice_os )
146
147         ! ... Sea-ice surface boundary conditions output from bulk formulae :
148         !     - utau_ice   ! surface ice stress i-component (I-point)   [N/m2]
149         !     - vtau_ice   ! surface ice stress j-component (I-point)   [N/m2]
150         !     - qns_ice    ! non solar heat flux over ice   (T-point)   [W/m2]
151         !     - qsr_ice    !     solar heat flux over ice   (T-point)   [W/m2]
152         !     - qla_ice    ! latent    heat flux over ice   (T-point)   [W/m2]
153         !     - dqns_ice   ! non solar heat sensistivity    (T-point)   [W/m2]
154         !     - dqla_ice   ! latent    heat sensistivity    (T-point)   [W/m2]
155         !     - tprecip    ! total precipitation            (T-point)   [Kg/m2/s]
156         !     - sprecip    ! solid precipitation            (T-point)   [Kg/m2/s]
157         !     - fr1_i0     ! 1sr fraction of qsr penetration in ice     [%]
158         !     - fr2_i0     ! 2nd fraction of qsr penetration in ice     [%]
159         !
160         SELECT CASE( ksbc )
161         CASE( 3 )           ! CLIO bulk formulation
162            CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         &
163               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
164               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
165               &                      tprecip    , sprecip    ,                         &
166               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
167
168         CASE( 4 )           ! CORE bulk formulation
169            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice_cs,            &
170               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
171               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
172               &                      tprecip    , sprecip    ,                         &
173               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
174         CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
175            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
176         END SELECT
177
178         CALL iom_put( 'utau_ice', utau_ice )     ! Wind stress over ice along i-axis at I-point
179         CALL iom_put( 'vtau_ice', vtau_ice )     ! Wind stress over ice along j-axis at I-point
180
181         IF(ln_ctl) THEN         ! print mean trends (used for debugging)
182            CALL prt_ctl_info( 'Ice Forcings ' )
183            CALL prt_ctl( tab2d_1=tprecip ,clinfo1=' sbc_ice_lim: precip  : ', tab2d_2=sprecip , clinfo2=' Snow    : ' )
184            CALL prt_ctl( tab2d_1=utau_ice,clinfo1=' sbc_ice_lim: utau_ice: ', tab2d_2=vtau_ice, clinfo2=' vtau_ice: ' )
185            CALL prt_ctl( tab2d_1=sst_m   ,clinfo1=' sbc_ice_lim: sst     : ', tab2d_2=sss_m   , clinfo2=' sss     : ' )
186            CALL prt_ctl( tab2d_1=u_oce   ,clinfo1=' sbc_ice_lim: u_io    : ', tab2d_2=v_oce   , clinfo2=' v_io    : ' )
187            CALL prt_ctl( tab2d_1=hsnif   ,clinfo1=' sbc_ice_lim: hsnif  1: ', tab2d_2=hicif   , clinfo2=' hicif   : ' )
188            CALL prt_ctl( tab2d_1=frld    ,clinfo1=' sbc_ice_lim: frld   1: ', tab2d_2=sist    , clinfo2=' sist    : ' )
189         ENDIF
190
191         ! ---------------- !
192         !  Ice model step  !
193         ! ---------------- !
194         numit = numit + nn_fsbc                           ! Ice model time step
195
196                           CALL lim_rst_opn_2  ( kt )  ! Open Ice restart file
197         IF( .NOT. lk_c1d ) THEN                       ! Ice dynamics & transport (except in 1D case)
198                           CALL lim_dyn_2      ( kt )      ! Ice dynamics    ( rheology/dynamics )
199                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion )
200           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping
201         END IF
202#if defined key_coupled
203         !                                             ! Ice surface fluxes in coupled mode
204         IF( ksbc == 5 )   THEN
205            a_i(:,:,1)=fr_i
206            CALL sbc_cpl_ice_flx( frld,                                              &
207            !                                optional arguments, used only in 'mixed oce-ice' case
208            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist )
209            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
210         ENDIF
211#endif
212                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics
213                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes
214
215         IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   &
216            &              CALL lim_dia_2      ( kt )      ! Ice Diagnostics
217# if ! defined key_iomput
218                           CALL lim_wri_2      ( kt )      ! Ice outputs
219# endif
220         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
221         !
222      ENDIF                                    ! End sea-ice time step only
223      !
224      !                                        !--------------------------!
225      !                                        !  at all ocean time step  !
226      !                                        !--------------------------!
227      !                                               
228      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
229      !                                                   ! otherwise the atm.-ocean stresses are used everywhere
230      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
231      !
232      IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays')
233      !
234   END SUBROUTINE sbc_ice_lim_2
235
236#else
237   !!----------------------------------------------------------------------
238   !!   Default option           Dummy module      NO LIM 2.0 sea-ice model
239   !!----------------------------------------------------------------------
240CONTAINS
241   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine
242      INTEGER, INTENT(in) ::   kt, ksbc   
243      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc
244   END SUBROUTINE sbc_ice_lim_2
245#endif
246
247   !!======================================================================
248END MODULE sbcice_lim_2
Note: See TracBrowser for help on using the repository browser.