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.
icestp.F90 in trunk/NEMO/LIM_SRC – NEMO

source: trunk/NEMO/LIM_SRC/icestp.F90 @ 700

Last change on this file since 700 was 700, checked in by smasson, 17 years ago

sbc(1): bugfix on wind stress computation #2

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.7 KB
Line 
1MODULE icestp
2   !!======================================================================
3   !!                       ***  MODULE icestp   ***
4   !!   Sea-Ice model : LIM Sea ice model time-stepping
5   !!======================================================================
6   !! History :   1.0  !  99-11  (M. Imbard)  Original code
7   !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf.
8   !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module
9   !!----------------------------------------------------------------------
10#if defined key_ice_lim
11   !!----------------------------------------------------------------------
12   !!   'key_ice_lim' :                                   Lim sea-ice model
13   !!----------------------------------------------------------------------
14   !!----------------------------------------------------------------------
15   !!   ice_stp       : sea-ice model time-stepping
16   !!----------------------------------------------------------------------
17   USE dom_oce
18   USE oce  ! dynamics and tracers variables
19   USE in_out_manager
20   USE ice_oce         ! ice variables
21   USE flx_oce         ! forcings variables
22   USE dom_ice
23   USE daymod
24   USE phycst          ! Define parameters for the routines
25   USE taumod
26   USE ice
27   USE ocesbc
28   USE lbclnk
29   USE limdyn
30   USE limtrp
31   USE limthd
32   USE limflx
33   USE limdia
34   USE limwri
35   USE limrst
36   USE limdmp          ! Ice damping
37   USE prtctl          ! Print control
38
39   IMPLICIT NONE
40   PRIVATE
41
42   PUBLIC   ice_stp    ! called by step.F90
43
44   !! * Substitutions
45#  include "domzgr_substitute.h90"
46#  include "vectopt_loop_substitute.h90"
47   !!-----------------------------------------------------
48   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)
49   !! $Header$
50   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
51   !!-----------------------------------------------------
52
53CONTAINS
54
55   SUBROUTINE ice_stp ( kt )
56      !!---------------------------------------------------------------------
57      !!                  ***  ROUTINE ice_stp  ***
58      !!                   
59      !! ** Purpose :   Louvain la Neuve Sea Ice Model time stepping
60      !!
61      !! ** Action  : - call the ice dynamics routine
62      !!              - call the ice advection/diffusion routine
63      !!              - call the ice thermodynamics routine
64      !!              - call the routine that computes mass and
65      !!                heat fluxes at the ice/ocean interface
66      !!              - save the outputs
67      !!              - save the outputs for restart when necessary
68      !!----------------------------------------------------------------------
69      INTEGER, INTENT(in)          ::   kt       ! ocean time-step index
70
71      INTEGER                      ::   ji, jj   ! dummy loop indices
72      REAL(wp), DIMENSION(jpi,jpj) ::   zsss_io, zsss2_io, zsss3_io   ! tempory workspaces
73      REAL(wp)                     ::   zmult                         ! tempory workspaces
74      !!----------------------------------------------------------------------
75
76      IF( kt == nit000 ) THEN
77         IF(lwp) WRITE(numout,*)
78         IF(lwp) WRITE(numout,*) 'ice_stp : Louvain la Neuve Ice Model (LIM)'
79          !  Initialize fluxes fields
80         gtaux(:,:) = 0.e0
81         gtauy(:,:) = 0.e0
82      ENDIF
83
84      ! Temperature , salinity and horizonta wind
85      ! sst_io  and sss_io, u_io and v_io  are initialized at nit000 in limistate.F90 (or limrst.F90) with :
86      !              sst_io = sst_io + (nfice - 1) * (tn(:,:,1)+rt0 )
87      !              sss_io = sss_io + (nfice - 1) * sn(:,:,1)
88      !              u_io  = u_io  + (nfice - 1) * 0.5 * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
89      !              v_io  = v_io  + (nfice - 1) * 0.5 * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
90      !    cumulate fields
91      !
92      sst_io(:,:) = sst_io(:,:) + tn(:,:,1)
93      sss_io(:,:) = sss_io(:,:) + sn(:,:,1)
94
95 
96      ! surface ocean current at I-point (from U-, V-points)
97      DO jj = 2, jpj
98         DO ji = fs_2, jpi   ! vector opt.
99            u_io (ji,jj) = u_io(ji,jj) + un(ji-1,jj  ,1) + un(ji-1,jj-1,1)
100            v_io (ji,jj) = v_io(ji,jj) + vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1)
101         END DO
102      END DO
103     
104     
105      IF( MOD( kt-1, nfice ) == 0 ) THEN
106         
107         ! The LIM model is going to be call
108         zmult = 1. / REAL( nfice, wp )
109         sst_io(:,:) = zmult * sst_io(:,:) * tmask(:,:,1) + rt0
110         sss_io(:,:) = zmult * sss_io(:,:)
111
112         ! stress from ocean U- and V-points to ice U,V point
113         zmult = 0.5 * zmult
114         DO jj = 2, jpj
115            DO ji = fs_2, jpi   ! vector opt.
116               ! ice/atmosphere stress at I-point (from U-, V-points)
117               gtaux(ji,jj) = 0.5 * ( taux_ice(ji-1,jj  ) + taux_ice(ji-1,jj-1) ) 
118               gtauy(ji,jj) = 0.5 * ( tauy_ice(ji  ,jj-1) + tauy_ice(ji-1,jj-1) )
119               
120               u_io (ji,jj) = zmult * u_io(ji,jj)
121               v_io (ji,jj) = zmult * v_io(ji,jj)
122            END DO
123         END DO
124
125         ! lateral boundary condition
126         CALL lbc_lnk( gtaux(:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
127         CALL lbc_lnk( gtauy(:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
128         CALL lbc_lnk( u_io (:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
129         CALL lbc_lnk( v_io (:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
130
131!!gmbug  in the ocean freezing point computed as :
132!!gm           fzptn (ji,jj) = ( -0.0575 + 1.710523e-3 * SQRT( sn(ji,jj,1) )   &
133!!gm                                     - 2.154996e-4 *       sn(ji,jj,1)   ) * sn(ji,jj,1)   !!   &
134!!gm           !!                        - 7.53e-4 * pressure
135!!gm
136!!gm!bug this is much more accurate and efficient computation
137!!gm       **************************************************
138!!gm freezing point from unesco:
139!!gm     real function tf(s,p)
140!!gm   function to compute the freezing point of seawater
141!!gm
142!!gm   reference: unesco tech. papers in the marine science no. 28. 1978
143!!gm   eighth report jpots
144!!gm   annex 6 freezing point of seawater f.j. millero pp.29-35.
145!!gm
146!!gm  units:
147!!gm         pressure      p          decibars
148!!gm         salinity      s          pss-78
149!!gm         temperature   tf         degrees celsius
150!!gm         freezing pt.
151!!gm************************************************************
152!!gm  checkvalue: tf= -2.588567 deg. c for s=40.0, p=500. decibars
153!!gm     tf=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
154!!gm     return
155!!gm     end
156!!gm!bug
157
158
159!!gm      DO jj = 1, jpj
160!!gm         DO ji = 1, jpi
161!!gm            tfu(ji,jj)  = (  rt0 + ( - 0.0575                              &
162!!gm               &                     + 1.710523e-3 * SQRT( sss_io(ji,jj) )   &
163!!gm               &                     - 2.154996e-4 *       sss_io(ji,jj)   ) * sss_io(ji,jj)  ) * tms(ji,jj)
164!!gm         END DO
165!!gm      END DO
166!!gm
167         zsss_io (:,:) = SQRT( sss_io(:,:) ) 
168         zsss2_io(:,:) =  sss_io(:,:) *  sss_io(:,:)
169         zsss3_io(:,:) = zsss_io(:,:) * zsss_io(:,:) * zsss_io(:,:)
170         
171         DO jj = 1, jpj
172            DO ji = 1, jpi
173               tfu(ji,jj)  = ABS ( rt0 - 0.0575       *   sss_io(ji,jj)   &
174                    &                    + 1.710523e-03 * zsss3_io(ji,jj)   &
175                    &                    - 2.154996e-04 * zsss2_io(ji,jj) ) * tms(ji,jj)
176            END DO
177         END DO
178         
179
180         IF(ln_ctl) THEN         ! print mean trends (used for debugging)
181            CALL prt_ctl_info('Ice Forcings ')
182            CALL prt_ctl(tab2d_1=qsr_oce ,clinfo1=' qsr_oce  : ', tab2d_2=qsr_ice , clinfo2=' qsr_ice   : ')
183            CALL prt_ctl(tab2d_1=qnsr_oce,clinfo1=' qnsr_oce : ', tab2d_2=qnsr_ice, clinfo2=' qnsr_ice  : ')
184            CALL prt_ctl(tab2d_1=evap    ,clinfo1=' evap     : ')
185            CALL prt_ctl(tab2d_1=tprecip ,clinfo1=' precip   : ', tab2d_2=sprecip , clinfo2=' Snow      : ')
186            CALL prt_ctl(tab2d_1=gtaux   ,clinfo1=' u-stress : ', tab2d_2=gtauy   , clinfo2=' v-stress  : ')
187            CALL prt_ctl(tab2d_1=sst_io  ,clinfo1=' sst      : ', tab2d_2=sss_io  , clinfo2=' sss       : ')
188            CALL prt_ctl(tab2d_1=u_io    ,clinfo1=' u_io     : ', tab2d_2=v_io    , clinfo2=' v_io      : ')
189            CALL prt_ctl(tab2d_1=hsnif   ,clinfo1=' hsnif  1 : ', tab2d_2=hicif   , clinfo2=' hicif     : ')
190            CALL prt_ctl(tab2d_1=frld    ,clinfo1=' frld   1 : ', tab2d_2=sist    , clinfo2=' sist      : ')
191         ENDIF
192
193         !                                                           !-----------------------!
194         CALL lim_rst_opn( kt )                                      ! Open Ice restart file !
195         !                                                           !-----------------------!
196
197         !                                                           !--------------!
198         CALL lim_dyn( kt )                                          ! Ice dynamics !   ( rheology/dynamics )
199         !                                                           !--------------!
200         IF(ln_ctl) THEN
201            CALL prt_ctl(tab2d_1=hsnif ,clinfo1=' hsnif  2 : ', tab2d_2=hicif , clinfo2=' hicif     : ')
202            CALL prt_ctl(tab2d_1=frld  ,clinfo1=' frld   2 : ', tab2d_2=sist  , clinfo2=' sist      : ')
203         ENDIF
204
205
206         !                                                           !---------------!
207         CALL lim_trp( kt )                                          ! Ice transport !  ( Advection/diffusion )
208         !                                                           !---------------!
209         IF(ln_ctl) THEN
210            CALL prt_ctl(tab2d_1=hsnif ,clinfo1=' hsnif  3 : ', tab2d_2=hicif , clinfo2=' hicif     : ')
211            CALL prt_ctl(tab2d_1=frld  ,clinfo1=' frld   3 : ', tab2d_2=sist  , clinfo2=' sist      : ')
212         ENDIF
213
214         !                                                           !-------------!
215         IF( ln_limdmp ) THEN                                        ! Ice damping !
216         !                                                           !-------------!
217#if defined key_agrif
218            IF( Agrif_Root() )   CALL lim_dmp(kt)
219#else
220            CALL lim_dmp(kt)                                         
221#endif
222         ENDIF
223         !                                                           !--------------------!
224         CALL lim_thd( kt )                                          ! Ice thermodynamics !
225         !                                                           !--------------------!
226         IF(ln_ctl) THEN
227            CALL prt_ctl(tab2d_1=hsnif ,clinfo1=' hsnif  4 : ', tab2d_2=hicif , clinfo2=' hicif     : ')
228            CALL prt_ctl(tab2d_1=frld  ,clinfo1=' frld   4 : ', tab2d_2=sist  , clinfo2=' sist      : ')
229         ENDIF
230
231
232         ! Mass and heat fluxes from ice to ocean
233         !                                                           !------------------------------!
234         CALL lim_flx                                                ! Ice/Ocean Mass & Heat fluxes !
235         !                                                           !------------------------------!
236
237         IF( MOD( kt + nfice -1, ninfo ) == 0 .OR. ntmoy == 1 )  THEN        !-----------------!
238            CALL lim_dia( kt )                                       ! Ice Diagnostics !
239         ENDIF                                                       !-----------------!
240
241         !                                                           !-------------!
242         CALL lim_wri( kt )                                          ! Ice outputs !
243         !                                                           !-------------!
244
245         !                                                           !------------------------!
246         IF( lrst_ice ) CALL lim_rst_write( kt )                     ! Write Ice restart file !
247         !                                                           !------------------------!
248
249         ! Re-initialization of forcings
250         qsr_oce (:,:) = 0.e0
251         qsr_ice (:,:) = 0.e0
252         qnsr_oce(:,:) = 0.e0
253         qnsr_ice(:,:) = 0.e0 
254         dqns_ice(:,:) = 0.e0 
255         tprecip (:,:) = 0.e0 
256         sprecip (:,:) = 0.e0
257         fr1_i0  (:,:) = 0.e0
258         fr2_i0  (:,:) = 0.e0
259         evap    (:,:) = 0.e0
260#if ! defined key_coupled
261         qla_ice (:,:) = 0.e0
262         dqla_ice(:,:) = 0.e0
263#endif
264      ENDIF
265      !
266   END SUBROUTINE ice_stp
267
268#else
269   !!----------------------------------------------------------------------
270   !!   Default option           Dummy module          NO LIM sea-ice model
271   !!----------------------------------------------------------------------
272CONTAINS
273   SUBROUTINE ice_stp ( kt )     ! Dummy routine
274      WRITE(*,*) 'ice_stp: You should not have seen this print! error?', kt
275   END SUBROUTINE ice_stp
276#endif
277
278   !!======================================================================
279END MODULE icestp
Note: See TracBrowser for help on using the repository browser.