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.
limistate_2.F90 in branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

source: branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90 @ 7512

Last change on this file since 7512 was 7508, checked in by mocavero, 8 years ago

changes on code duplication and workshare construct
  • Property svn:keywords set to Id
File size: 11.3 KB
Line 
1MODULE limistate_2
2   !!======================================================================
3   !!                     ***  MODULE  limistate_2  ***
4   !!              Initialisation of diagnostics ice variables
5   !!======================================================================
6   !! History :   1.0  !  01-04  (C. Ethe, G. Madec)  Original code
7   !!             2.0  !  03-08  (G. Madec)  add lim_istate_init
8   !!                  !  04-04  (S. Theetten) initialization from a file
9   !!                  !  06-07  (S. Masson)  IOM to read the restart
10   !!                  !  07-10  (G. Madec)  surface module
11   !!--------------------------------------------------------------------
12#if defined key_lim2
13   !!----------------------------------------------------------------------
14   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
15   !!----------------------------------------------------------------------
16   !!   lim_istate_2      :  Initialisation of diagnostics ice variables
17   !!   lim_istate_init_2 :  initialization of ice state and namelist read
18   !!----------------------------------------------------------------------
19   USE phycst
20   USE par_ice_2       ! ice parameters
21   USE dom_ice_2
22   USE eosbn2          ! equation of state
23   USE lbclnk
24   USE oce
25   USE ice_2
26   USE iom
27   USE in_out_manager
28   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC lim_istate_2      ! routine called by lim_init_2.F90
34
35   !                        !! **  namelist (namiceini) **
36   LOGICAL  ::   ln_limini   ! Ice initialization state
37   REAL(wp) ::   ttest       ! threshold water temperature for initial sea ice
38   REAL(wp) ::   hninn       ! initial snow thickness in the north
39   REAL(wp) ::   hginn       ! initial ice thickness in the north
40   REAL(wp) ::   alinn       ! initial leads area in the north
41   REAL(wp) ::   hnins       ! initial snow thickness in the south
42   REAL(wp) ::   hgins       ! initial ice thickness in the south
43   REAL(wp) ::   alins       ! initial leads area in the south
44   
45   REAL(wp) ::   zero      = 0.e0     ! constant value = 0
46   REAL(wp) ::   zone      = 1.e0     ! constant value = 1
47   !!----------------------------------------------------------------------
48   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
49   !! $Id$
50   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE lim_istate_2
55      !!-------------------------------------------------------------------
56      !!                    ***  ROUTINE lim_istate_2  ***
57      !!
58      !! ** Purpose :   defined the sea-ice initial state
59      !!
60      !! ** Method  :   restart from a state defined in a binary file
61      !!                or from arbitrary sea-ice conditions
62      !!--------------------------------------------------------------------
63      INTEGER  ::   ji, jj, jk                ! dummy loop indices
64      REAL(wp) ::   zidto                     ! temporary scalar
65      !--------------------------------------------------------------------
66 
67      CALL lim_istate_init_2     !  reading the initials parameters of the ice
68
69      IF( .NOT. ln_limini ) THEN 
70         
71         CALL eos_fzp( tsn(:,:,1,jp_sal), tfu(:,:) )       ! freezing/melting point of sea water [Celcius]
72!$OMP PARALLEL
73!$OMP DO schedule(static) private(jj, ji)
74         DO jj = 1, jpj
75            DO ji = 1, jpi
76               tfu(ji,jj) = tfu(ji,jj) *  tmask(ji,jj,1)
77            END DO
78         END DO
79
80!$OMP DO schedule(static) private(jj, ji)
81         DO jj = 1, jpj
82            DO ji = 1, jpi
83               !                     ! ice if sst <= t-freez + ttest
84               IF( tsn(ji,jj,1,jp_tem)  - tfu(ji,jj) >= ttest ) THEN   ;   zidto = 0.e0      ! no ice
85               ELSE                                                    ;   zidto = 1.e0      !    ice
86               ENDIF
87               !
88               IF( fcor(ji,jj) >= 0.e0 ) THEN     !--  Northern hemisphere.
89                  hicif(ji,jj)   = zidto * hginn
90                  frld(ji,jj)    = zidto * alinn + ( 1.0 - zidto ) * 1.0
91                  hsnif(ji,jj)   = zidto * hninn
92               ELSE                               !---  Southern hemisphere.
93                  hicif(ji,jj)   = zidto * hgins
94                  frld(ji,jj)    = zidto * alins + ( 1.0 - zidto ) * 1.0
95                  hsnif(ji,jj)   = zidto * hnins
96               ENDIF
97            END DO
98         END DO
99
100!$OMP DO schedule(static) private(jj, ji)
101         DO jj = 1, jpj
102            DO ji = 1, jpi
103               tfu(ji,jj) = tfu(ji,jj) + rt0       ! ftu converted from Celsius to Kelvin (rt0 over land)
104         
105               sist  (ji,jj)   = tfu(ji,jj)
106               tbif  (ji,jj,1) = tfu(ji,jj)
107               tbif  (ji,jj,2) = tfu(ji,jj)
108               tbif  (ji,jj,3) = tfu(ji,jj)
109            END DO
110         END DO
111
112!$OMP END PARALLEL
113      ENDIF
114     
115!$OMP PARALLEL DO schedule(static) private(jj, ji)
116         DO jj = 1, jpj
117            DO ji = 1, jpi
118               fsbbq (ji,jj)   = 0.e0
119               qstoif(ji,jj)   = 0.e0
120               u_ice (ji,jj)   = 0.e0
121               v_ice (ji,jj)   = 0.e0
122
123               !---  Moments for advection.             
124
125               sxice (ji,jj)  = 0.e0   ;   sxsn (ji,jj)  = 0.e0   ;   sxa  (ji,jj)  = 0.e0
126               syice (ji,jj)  = 0.e0   ;   sysn (ji,jj)  = 0.e0   ;   sya  (ji,jj)  = 0.e0
127               sxxice(ji,jj)  = 0.e0   ;   sxxsn(ji,jj)  = 0.e0   ;   sxxa (ji,jj)  = 0.e0
128               syyice(ji,jj)  = 0.e0   ;   syysn(ji,jj)  = 0.e0   ;   syya (ji,jj)  = 0.e0
129               sxyice(ji,jj)  = 0.e0   ;   sxysn(ji,jj)  = 0.e0   ;   sxya (ji,jj)  = 0.e0
130
131               sxc0  (ji,jj)  = 0.e0   ;   sxc1 (ji,jj)  = 0.e0   ;   sxc2 (ji,jj)  = 0.e0
132               syc0  (ji,jj)  = 0.e0   ;   syc1 (ji,jj)  = 0.e0   ;   syc2 (ji,jj)  = 0.e0
133               sxxc0 (ji,jj)  = 0.e0   ;   sxxc1(ji,jj)  = 0.e0   ;   sxxc2(ji,jj)  = 0.e0
134               syyc0 (ji,jj)  = 0.e0   ;   syyc1(ji,jj)  = 0.e0   ;   syyc2(ji,jj)  = 0.e0
135               sxyc0 (ji,jj)  = 0.e0   ;   sxyc1(ji,jj)  = 0.e0   ;   sxyc2(ji,jj)  = 0.e0
136
137               sxst  (ji,jj)  = 0.e0
138               syst  (ji,jj)  = 0.e0
139               sxxst (ji,jj)  = 0.e0
140               syyst (ji,jj)  = 0.e0
141               sxyst (ji,jj)  = 0.e0
142#if ! defined key_lim2_vp
143               stress1_i (ji,jj) = 0._wp                          ! EVP rheology
144               stress2_i (ji,jj) = 0._wp
145               stress12_i(ji,jj) = 0._wp
146#endif
147            END DO
148         END DO
149
150      !-- lateral boundary conditions
151      CALL lbc_lnk( hicif, 'T', 1. )
152      CALL lbc_lnk( frld , 'T', 1. )
153
154      ! C A U T I O N  frld = 1 over land and lbc_lnk put zero along
155      ! *************  closed boundaries herefore we force to one over land
156!$OMP PARALLEL DO schedule(static) private(jj, ji)
157         DO jj = 1, jpj
158            DO ji = 1, jpi
159               frld(ji,jj) = tms(ji,jj) * frld(ji,jj) + ( 1. - tms(ji,jj) )   
160            END DO
161         END DO
162
163      CALL lbc_lnk( hsnif, 'T', 1. )
164      CALL lbc_lnk( sist , 'T', 1. , pval = rt0 )      ! set rt0 on closed boundary (required by bulk formulation)
165      DO jk = 1, jplayersp1
166         CALL lbc_lnk(tbif(:,:,jk), 'T', 1. )
167      END DO
168      CALL lbc_lnk( fsbbq  , 'T', 1. )
169      CALL lbc_lnk( qstoif , 'T', 1. )
170
171   END SUBROUTINE lim_istate_2
172
173   
174   SUBROUTINE lim_istate_init_2
175      !!-------------------------------------------------------------------
176      !!                   ***  ROUTINE lim_istate_init_2  ***
177      !!       
178      !! ** Purpose :   Definition of initial state of the ice
179      !!
180      !! ** Method  :   Read the namiceini namelist and check the parameter
181      !!       values called at the first timestep (nit000)
182      !!
183      !! ** input   :   Namelist namiceini
184      !!-------------------------------------------------------------------
185      INTEGER :: inum_ice
186      INTEGER :: ji,jj
187      INTEGER :: ios                 ! Local integer output status for namelist read
188
189      NAMELIST/namiceini/ ln_limini, ttest, hninn, hginn, alinn, &
190         &                hnins, hgins, alins
191      !!-------------------------------------------------------------------
192                   
193      REWIND( numnam_ice_ref )              ! Namelist namiceini in reference namelist : Ice initial state
194      READ  ( numnam_ice_ref, namiceini, IOSTAT = ios, ERR = 901)
195901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in reference namelist', lwp )
196
197      REWIND( numnam_ice_cfg )              ! Namelist namiceini in configuration namelist : Ice initial state
198      READ  ( numnam_ice_cfg, namiceini, IOSTAT = ios, ERR = 902 )
199902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceini in configuration namelist', lwp )
200      IF(lwm) WRITE ( numoni, namiceini )
201      !
202      IF(lwp) THEN
203         WRITE(numout,*)
204         WRITE(numout,*) 'lim_istate_init_2 : ice parameters inititialisation '
205         WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
206         WRITE(numout,*) '         threshold water temp. for initial sea-ice    ttest      = ', ttest
207         WRITE(numout,*) '         initial snow thickness in the north          hninn      = ', hninn
208         WRITE(numout,*) '         initial ice thickness in the north           hginn      = ', hginn 
209         WRITE(numout,*) '         initial leads area in the north              alinn      = ', alinn           
210         WRITE(numout,*) '         initial snow thickness in the south          hnins      = ', hnins 
211         WRITE(numout,*) '         initial ice thickness in the south           hgins      = ', hgins
212         WRITE(numout,*) '         initial leads area in the south              alins      = ', alins
213         WRITE(numout,*) '         Ice state initialization using input file    ln_limini  = ', ln_limini
214      ENDIF
215
216      IF( ln_limini ) THEN                      ! Ice initialization using input file
217         !
218         CALL iom_open( 'Ice_initialization.nc', inum_ice )
219         !
220         IF( inum_ice > 0 ) THEN
221            IF(lwp) WRITE(numout,*)
222            IF(lwp) WRITE(numout,*) '                  ice state initialization with : Ice_initialization.nc'
223           
224            CALL iom_get( inum_ice, jpdom_data, 'hicif', hicif )     
225            CALL iom_get( inum_ice, jpdom_data, 'hsnif', hsnif )     
226            CALL iom_get( inum_ice, jpdom_data, 'frld' , frld  )     
227            CALL iom_get( inum_ice, jpdom_data, 'ts'   , sist  )
228            CALL iom_get( inum_ice, jpdom_unknown, 'tbif', tbif(1:nlci,1:nlcj,:),   &
229                 &        kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,jplayersp1 /) )
230            ! put some values in the extra-halo...
231            DO jj = nlcj+1, jpj   ;   tbif(1:nlci,jj,:) = tbif(1:nlci,nlej,:)   ;   END DO
232            DO ji = nlci+1, jpi   ;   tbif(ji    ,: ,:) = tbif(nlei  ,:   ,:)   ;   END DO
233
234            CALL iom_close( inum_ice)
235            !
236         ENDIF
237      ENDIF
238      !     
239   END SUBROUTINE lim_istate_init_2
240
241#else
242   !!----------------------------------------------------------------------
243   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
244   !!----------------------------------------------------------------------
245CONTAINS
246   SUBROUTINE lim_istate_2        ! Empty routine
247   END SUBROUTINE lim_istate_2
248#endif
249
250   !!======================================================================
251END MODULE limistate_2
Note: See TracBrowser for help on using the repository browser.