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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 @ 4416

Last change on this file since 4416 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.

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