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.
icerst.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90 @ 8506

Last change on this file since 8506 was 8486, checked in by clem, 7 years ago

changes in style - part1 - (now the code looks better txs to Gurvan's comments)

File size: 28.4 KB
Line 
1MODULE icerst
2   !!======================================================================
3   !!                     ***  MODULE  icerst  ***
4   !! Ice restart :  write the ice restart file
5   !!======================================================================
6   !! History:   3.0  ! 2005-04 (M. Vancoppenolle) Original code
7   !!             -   ! 2008-03 (C. Ethe) restart files in using IOM interface
8   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
9   !!----------------------------------------------------------------------
10#if defined key_lim3
11   !!----------------------------------------------------------------------
12   !!   'key_lim3'                                        LIM sea-ice model
13   !!----------------------------------------------------------------------
14   !!   ice_rst_opn   : open ice restart file
15   !!   ice_rst_write : write of the restart file
16   !!   ice_rst_read  : read  the restart file
17   !!----------------------------------------------------------------------
18   USE ice            ! sea-ice variables
19   USE sbc_ice , ONLY :  snwice_mass, snwice_mass_b
20   USE dom_oce        ! ocean domain
21   USE sbc_oce , ONLY : nn_fsbc
22   USE icectl
23   !
24   USE in_out_manager ! I/O manager
25   USE iom            ! I/O library
26   USE lib_mpp        ! MPP library
27   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   ice_rst_opn    ! routine called by icestep.F90
33   PUBLIC   ice_rst_write  ! routine called by icestep.F90
34   PUBLIC   ice_rst_read   ! routine called by ice_init
35
36   LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write
37   INTEGER, PUBLIC ::   numrir, numriw   !: logical unit for ice restart (read and write)
38
39   !!----------------------------------------------------------------------
40   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
41   !! $Id: icerst.F90 8411 2017-08-07 16:09:12Z clem $
42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
43   !!----------------------------------------------------------------------
44CONTAINS
45
46   SUBROUTINE ice_rst_opn( kt )
47      !!----------------------------------------------------------------------
48      !!                    ***  ice_rst_opn  ***
49      !!
50      !! ** purpose  :   output of sea-ice variable in a netcdf file
51      !!----------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kt       ! number of iteration
53      !
54      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
55      CHARACTER(len=50)   ::   clname   ! ice output restart file name
56      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file
57      !!----------------------------------------------------------------------
58      !
59      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
60
61      ! in order to get better performances with NetCDF format, we open and define the ice restart file
62      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice
63      ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
64      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc    &
65         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
66         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
67            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
68            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
69            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
70            ENDIF
71            ! create the file
72            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
73            clpath = TRIM(cn_icerst_outdir) 
74            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
75            IF(lwp) THEN
76               WRITE(numout,*)
77               SELECT CASE ( jprstlib )
78               CASE DEFAULT
79                  WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
80               END SELECT
81               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
82                  WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
83               ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
84               ENDIF
85            ENDIF
86            !
87            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )
88            lrst_ice = .TRUE.
89         ENDIF
90      ENDIF
91      !
92      IF( ln_limctl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
93   END SUBROUTINE ice_rst_opn
94
95
96   SUBROUTINE ice_rst_write( kt )
97      !!----------------------------------------------------------------------
98      !!                    ***  ice_rst_write  ***
99      !!
100      !! ** purpose  :   output of sea-ice variable in a netcdf file
101      !!----------------------------------------------------------------------
102      INTEGER, INTENT(in) ::   kt     ! number of iteration
103      !!
104      INTEGER ::   ji, jj, jk ,jl   ! dummy loop indices
105      INTEGER ::   iter
106      CHARACTER(len=25) ::   znam
107      CHARACTER(len=2)  ::   zchar, zchar1
108      REAL(wp), DIMENSION(jpi,jpj) :: z2d
109      !!----------------------------------------------------------------------
110
111      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
112
113      IF( iter == nitrst ) THEN
114         IF(lwp) WRITE(numout,*)
115         IF(lwp) WRITE(numout,*) 'ice_rst_write : write ice restart file  kt =', kt
116         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
117      ENDIF
118
119      ! Write in numriw (if iter == nitrst)
120      ! ------------------
121      !                                                                        ! calendar control
122      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step
123      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date
124
125!!gm   It is possible and easy to define a 3D domain size (jpi,jpj,jpl) or use a SIZE( tab, DIM=3) in iom_rtput )
126!!gm         ===>>> just a simple   iom_rstput( iter, nitrst, numriw, 'v_i', v_i )  etc...
127!!gm   "just" ask Sebatien
128
129
130      ! Prognostic variables
131      DO jl = 1, jpl 
132         WRITE(zchar,'(I2.2)') jl
133         znam = 'v_i'//'_htc'//zchar
134         z2d(:,:) = v_i(:,:,jl)
135         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
136         znam = 'v_s'//'_htc'//zchar
137         z2d(:,:) = v_s(:,:,jl)
138         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
139         znam = 'smv_i'//'_htc'//zchar
140         z2d(:,:) = smv_i(:,:,jl)
141         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
142         znam = 'oa_i'//'_htc'//zchar
143         z2d(:,:) = oa_i(:,:,jl)
144         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
145         znam = 'a_i'//'_htc'//zchar
146         z2d(:,:) = a_i(:,:,jl)
147         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
148         znam = 't_su'//'_htc'//zchar
149         z2d(:,:) = t_su(:,:,jl)
150         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
151      END DO
152
153      ! MV MP 2016
154      IF ( nn_pnd_scheme > 0 ) THEN
155         DO jl = 1, jpl 
156            WRITE(zchar,'(I2.2)') jl
157            znam = 'a_ip'//'_htc'//zchar
158            z2d(:,:) = a_ip(:,:,jl)
159            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
160            znam = 'v_ip'//'_htc'//zchar
161            z2d(:,:) = v_ip(:,:,jl)
162            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
163         END DO
164      ENDIF
165      ! END MV MP 2016
166
167      DO jl = 1, jpl 
168         WRITE(zchar,'(I2.2)') jl
169         znam = 'tempt_sl1'//'_htc'//zchar
170         z2d(:,:) = e_s(:,:,1,jl)
171         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
172         DO jk = 1, nlay_i 
173            WRITE(zchar1,'(I2.2)') jk
174            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
175            z2d(:,:) = e_i(:,:,jk,jl)
176            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
177         END DO
178      END DO
179
180      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'        , u_ice      )
181      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'        , v_ice      )
182      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'    , stress1_i  )
183      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'    , stress2_i  )
184      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i'   , stress12_i )
185      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass'  , snwice_mass )
186      CALL iom_rstput( iter, nitrst, numriw, 'snwice_mass_b', snwice_mass_b )
187
188      ! In case Prather scheme is used for advection, write second order moments
189      ! ------------------------------------------------------------------------
190      IF( nn_limadv == -1 ) THEN
191         
192         DO jl = 1, jpl 
193            WRITE(zchar,'(I2.2)') jl
194            znam = 'sxice'//'_htc'//zchar
195            z2d(:,:) = sxice(:,:,jl)
196            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
197            znam = 'syice'//'_htc'//zchar
198            z2d(:,:) = syice(:,:,jl)
199            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
200            znam = 'sxxice'//'_htc'//zchar
201            z2d(:,:) = sxxice(:,:,jl)
202            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
203            znam = 'syyice'//'_htc'//zchar
204            z2d(:,:) = syyice(:,:,jl)
205            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
206            znam = 'sxyice'//'_htc'//zchar
207            z2d(:,:) = sxyice(:,:,jl)
208            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
209            znam = 'sxsn'//'_htc'//zchar
210            z2d(:,:) = sxsn(:,:,jl)
211            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
212            znam = 'sysn'//'_htc'//zchar
213            z2d(:,:) = sysn(:,:,jl)
214            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
215            znam = 'sxxsn'//'_htc'//zchar
216            z2d(:,:) = sxxsn(:,:,jl)
217            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
218            znam = 'syysn'//'_htc'//zchar
219            z2d(:,:) = syysn(:,:,jl)
220            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
221            znam = 'sxysn'//'_htc'//zchar
222            z2d(:,:) = sxysn(:,:,jl)
223            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
224            znam = 'sxa'//'_htc'//zchar
225            z2d(:,:) = sxa(:,:,jl)
226            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
227            znam = 'sya'//'_htc'//zchar
228            z2d(:,:) = sya(:,:,jl)
229            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
230            znam = 'sxxa'//'_htc'//zchar
231            z2d(:,:) = sxxa(:,:,jl)
232            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
233            znam = 'syya'//'_htc'//zchar
234            z2d(:,:) = syya(:,:,jl)
235            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
236            znam = 'sxya'//'_htc'//zchar
237            z2d(:,:) = sxya(:,:,jl)
238            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
239            znam = 'sxc0'//'_htc'//zchar
240            z2d(:,:) = sxc0(:,:,jl)
241            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
242            znam = 'syc0'//'_htc'//zchar
243            z2d(:,:) = syc0(:,:,jl)
244            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
245            znam = 'sxxc0'//'_htc'//zchar
246            z2d(:,:) = sxxc0(:,:,jl)
247            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
248            znam = 'syyc0'//'_htc'//zchar
249            z2d(:,:) = syyc0(:,:,jl)
250            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
251            znam = 'sxyc0'//'_htc'//zchar
252            z2d(:,:) = sxyc0(:,:,jl)
253            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
254            znam = 'sxsal'//'_htc'//zchar
255            z2d(:,:) = sxsal(:,:,jl)
256            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
257            znam = 'sysal'//'_htc'//zchar
258            z2d(:,:) = sysal(:,:,jl)
259            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
260            znam = 'sxxsal'//'_htc'//zchar
261            z2d(:,:) = sxxsal(:,:,jl)
262            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
263            znam = 'syysal'//'_htc'//zchar
264            z2d(:,:) = syysal(:,:,jl)
265            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
266            znam = 'sxysal'//'_htc'//zchar
267            z2d(:,:) = sxysal(:,:,jl)
268            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
269            znam = 'sxage'//'_htc'//zchar
270            z2d(:,:) = sxage(:,:,jl)
271            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
272            znam = 'syage'//'_htc'//zchar
273            z2d(:,:) = syage(:,:,jl)
274            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
275            znam = 'sxxage'//'_htc'//zchar
276            z2d(:,:) = sxxage(:,:,jl)
277            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
278            znam = 'syyage'//'_htc'//zchar
279            z2d(:,:) = syyage(:,:,jl)
280            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
281            znam = 'sxyage'//'_htc'//zchar
282            z2d(:,:) = sxyage(:,:,jl)
283            CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
284         END DO
285
286         CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' ,  sxopw  )
287         CALL iom_rstput( iter, nitrst, numriw, 'syopw ' ,  syopw  )
288         CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' ,  sxxopw )
289         CALL iom_rstput( iter, nitrst, numriw, 'syyopw' ,  syyopw )
290         CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' ,  sxyopw )
291         
292         DO jl = 1, jpl 
293            WRITE(zchar,'(I2.2)') jl
294            DO jk = 1, nlay_i 
295               WRITE(zchar1,'(I2.2)') jk
296               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
297               z2d(:,:) = sxe(:,:,jk,jl)
298               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
299               znam = 'sye'//'_il'//zchar1//'_htc'//zchar
300               z2d(:,:) = sye(:,:,jk,jl)
301               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
302               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
303               z2d(:,:) = sxxe(:,:,jk,jl)
304               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
305               znam = 'syye'//'_il'//zchar1//'_htc'//zchar
306               z2d(:,:) = syye(:,:,jk,jl)
307               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
308               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
309               z2d(:,:) = sxye(:,:,jk,jl)
310               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
311            END DO
312         END DO
313         ! MV MP 2016
314         IF ( nn_pnd_scheme > 0 ) THEN
315            DO jl = 1, jpl 
316               WRITE(zchar,'(I2.2)') jl
317               znam = 'sxap'//'_htc'//zchar
318               z2d(:,:) = sxap(:,:,jl)
319               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
320               znam = 'syap'//'_htc'//zchar
321               z2d(:,:) = syap(:,:,jl)
322               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
323               znam = 'sxxap'//'_htc'//zchar
324               z2d(:,:) = sxxap(:,:,jl)
325               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
326               znam = 'syyap'//'_htc'//zchar
327               z2d(:,:) = syyap(:,:,jl)
328               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
329               znam = 'sxyap'//'_htc'//zchar
330               z2d(:,:) = sxyap(:,:,jl)
331               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
332   
333               znam = 'sxvp'//'_htc'//zchar
334               z2d(:,:) = sxvp(:,:,jl)
335               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
336               znam = 'syvp'//'_htc'//zchar
337               z2d(:,:) = syvp(:,:,jl)
338               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
339               znam = 'sxxvp'//'_htc'//zchar
340               z2d(:,:) = sxxvp(:,:,jl)
341               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
342               znam = 'syyvp'//'_htc'//zchar
343               z2d(:,:) = syyvp(:,:,jl)
344               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
345               znam = 'sxyvp'//'_htc'//zchar
346               z2d(:,:) = sxyvp(:,:,jl)
347               CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
348            END DO
349         ENDIF
350
351      ENDIF
352     
353      ! close restart file
354      ! ------------------
355      IF( iter == nitrst ) THEN
356         CALL iom_close( numriw )
357         lrst_ice = .FALSE.
358      ENDIF
359      !
360      !
361   END SUBROUTINE ice_rst_write
362
363
364   SUBROUTINE ice_rst_read
365      !!----------------------------------------------------------------------
366      !!                    ***  ice_rst_read  ***
367      !!
368      !! ** purpose  :   read of sea-ice variable restart in a netcdf file
369      !!----------------------------------------------------------------------
370      INTEGER  :: ji, jj, jk, jl
371      REAL(wp) :: zfice, ziter
372      REAL(wp), DIMENSION(jpi,jpj) ::   z2d
373      CHARACTER(len=25) ::   znam
374      CHARACTER(len=2)  ::   zchar, zchar1
375      INTEGER           ::   jlibalt = jprstlib
376      LOGICAL           ::   llok
377      !!----------------------------------------------------------------------
378
379      IF(lwp) THEN
380         WRITE(numout,*)
381         WRITE(numout,*) 'ice_rst_read : read ice NetCDF restart file'
382         WRITE(numout,*) '~~~~~~~~~~~~~'
383      ENDIF
384
385      CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )
386
387      CALL iom_get( numrir, 'nn_fsbc', zfice )
388      CALL iom_get( numrir, 'kt_ice' , ziter )   
389      IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
390      IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
391
392      !Control of date
393
394      IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
395         &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  &
396         &                   '   verify the file or rerun with the value 0 for the',        &
397         &                   '   control of time parameter  nrstdt' )
398      IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
399         &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
400         &                   '   verify the file or rerun with the value 0 for the',         &
401         &                   '   control of time parameter  nrstdt' )
402
403      ! Prognostic variables
404      DO jl = 1, jpl 
405         WRITE(zchar,'(I2.2)') jl
406         znam = 'v_i'//'_htc'//zchar
407         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
408         v_i(:,:,jl) = z2d(:,:)
409         znam = 'v_s'//'_htc'//zchar
410         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
411         v_s(:,:,jl) = z2d(:,:) 
412         znam = 'smv_i'//'_htc'//zchar
413         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
414         smv_i(:,:,jl) = z2d(:,:)
415         znam = 'oa_i'//'_htc'//zchar
416         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
417         oa_i(:,:,jl) = z2d(:,:)
418         znam = 'a_i'//'_htc'//zchar
419         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
420         a_i(:,:,jl) = z2d(:,:)
421         znam = 't_su'//'_htc'//zchar
422         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
423         t_su(:,:,jl) = z2d(:,:)
424      END DO
425
426      ! MV MP 2016
427      IF ( nn_pnd_scheme > 0 ) THEN
428         DO jl = 1, jpl 
429            WRITE(zchar,'(I2.2)') jl
430            znam = 'a_ip'//'_htc'//zchar
431            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
432            a_ip(:,:,jl) = z2d(:,:)
433            znam = 'v_ip'//'_htc'//zchar
434            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
435            v_ip(:,:,jl) = z2d(:,:)
436         END DO
437      ENDIF
438      ! END MV MP 2016
439
440      DO jl = 1, jpl 
441         WRITE(zchar,'(I2.2)') jl
442         znam = 'tempt_sl1'//'_htc'//zchar
443         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
444         e_s(:,:,1,jl) = z2d(:,:)
445         DO jk = 1, nlay_i 
446            WRITE(zchar1,'(I2.2)') jk
447            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar
448            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
449            e_i(:,:,jk,jl) = z2d(:,:)
450         END DO
451      END DO
452
453      CALL iom_get( numrir, jpdom_autoglo, 'u_ice'     , u_ice      )
454      CALL iom_get( numrir, jpdom_autoglo, 'v_ice'     , v_ice      )
455      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i  )
456      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i  )
457      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i )
458      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass )
459      CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b )
460
461      ! In case Prather scheme is used for advection, read second order moments
462      ! ------------------------------------------------------------------------
463      IF( nn_limadv == -1 ) THEN
464
465         DO jl = 1, jpl 
466            WRITE(zchar,'(I2.2)') jl
467            znam = 'sxice'//'_htc'//zchar
468            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
469            sxice(:,:,jl) = z2d(:,:)
470            znam = 'syice'//'_htc'//zchar
471            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
472            syice(:,:,jl) = z2d(:,:)
473            znam = 'sxxice'//'_htc'//zchar
474            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
475            sxxice(:,:,jl) = z2d(:,:)
476            znam = 'syyice'//'_htc'//zchar
477            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
478            syyice(:,:,jl) = z2d(:,:)
479            znam = 'sxyice'//'_htc'//zchar
480            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
481            sxyice(:,:,jl) = z2d(:,:)
482            znam = 'sxsn'//'_htc'//zchar
483            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
484            sxsn(:,:,jl) = z2d(:,:)
485            znam = 'sysn'//'_htc'//zchar
486            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
487            sysn(:,:,jl) = z2d(:,:)
488            znam = 'sxxsn'//'_htc'//zchar
489            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
490            sxxsn(:,:,jl) = z2d(:,:)
491            znam = 'syysn'//'_htc'//zchar
492            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
493            syysn(:,:,jl) = z2d(:,:)
494            znam = 'sxysn'//'_htc'//zchar
495            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
496            sxysn(:,:,jl) = z2d(:,:)
497            znam = 'sxa'//'_htc'//zchar
498            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
499            sxa(:,:,jl) = z2d(:,:)
500            znam = 'sya'//'_htc'//zchar
501            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
502            sya(:,:,jl) = z2d(:,:)
503            znam = 'sxxa'//'_htc'//zchar
504            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
505            sxxa(:,:,jl) = z2d(:,:)
506            znam = 'syya'//'_htc'//zchar
507            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
508            syya(:,:,jl) = z2d(:,:)
509            znam = 'sxya'//'_htc'//zchar
510            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
511            sxya(:,:,jl) = z2d(:,:)
512            znam = 'sxc0'//'_htc'//zchar
513            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
514            sxc0(:,:,jl) = z2d(:,:)
515            znam = 'syc0'//'_htc'//zchar
516            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
517            syc0(:,:,jl) = z2d(:,:)
518            znam = 'sxxc0'//'_htc'//zchar
519            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
520            sxxc0(:,:,jl) = z2d(:,:)
521            znam = 'syyc0'//'_htc'//zchar
522            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
523            syyc0(:,:,jl) = z2d(:,:)
524            znam = 'sxyc0'//'_htc'//zchar
525            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
526            sxyc0(:,:,jl) = z2d(:,:)
527            znam = 'sxsal'//'_htc'//zchar
528            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
529            sxsal(:,:,jl) = z2d(:,:)
530            znam = 'sysal'//'_htc'//zchar
531            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
532            sysal(:,:,jl) = z2d(:,:)
533            znam = 'sxxsal'//'_htc'//zchar
534            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
535            sxxsal(:,:,jl) = z2d(:,:)
536            znam = 'syysal'//'_htc'//zchar
537            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
538            syysal(:,:,jl) = z2d(:,:)
539            znam = 'sxysal'//'_htc'//zchar
540            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
541            sxysal(:,:,jl) = z2d(:,:)
542            znam = 'sxage'//'_htc'//zchar
543            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
544            sxage(:,:,jl) = z2d(:,:)
545            znam = 'syage'//'_htc'//zchar
546            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
547            syage(:,:,jl) = z2d(:,:)
548            znam = 'sxxage'//'_htc'//zchar
549            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
550            sxxage(:,:,jl) = z2d(:,:)
551            znam = 'syyage'//'_htc'//zchar
552            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
553            syyage(:,:,jl) = z2d(:,:)
554            znam = 'sxyage'//'_htc'//zchar
555            CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
556            sxyage(:,:,jl)= z2d(:,:)
557         END DO
558         ! MV MP 2016
559         IF ( nn_pnd_scheme > 0 ) THEN
560            DO jl = 1, jpl 
561               WRITE(zchar,'(I2.2)') jl
562               znam = 'sxap'//'_htc'//zchar
563               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
564               sxap(:,:,jl) = z2d(:,:)
565               znam = 'syap'//'_htc'//zchar
566               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
567               syap(:,:,jl) = z2d(:,:)
568               znam = 'sxxap'//'_htc'//zchar
569               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
570               sxxap(:,:,jl) = z2d(:,:)
571               znam = 'syyap'//'_htc'//zchar
572               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
573               syyap(:,:,jl) = z2d(:,:)
574               znam = 'sxyap'//'_htc'//zchar
575               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
576               sxyap(:,:,jl) = z2d(:,:)
577   
578               znam = 'sxvp'//'_htc'//zchar
579               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
580               sxvp(:,:,jl) = z2d(:,:)
581               znam = 'syvp'//'_htc'//zchar
582               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
583               syvp(:,:,jl) = z2d(:,:)
584               znam = 'sxxvp'//'_htc'//zchar
585               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
586               sxxvp(:,:,jl) = z2d(:,:)
587               znam = 'syyvp'//'_htc'//zchar
588               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
589               syyvp(:,:,jl) = z2d(:,:)
590               znam = 'sxyvp'//'_htc'//zchar
591               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
592               sxyvp(:,:,jl) = z2d(:,:)
593            END DO
594         ENDIF
595         ! END MV MP 2016
596
597         CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' ,  sxopw  )
598         CALL iom_get( numrir, jpdom_autoglo, 'syopw ' ,  syopw  )
599         CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' ,  sxxopw )
600         CALL iom_get( numrir, jpdom_autoglo, 'syyopw' ,  syyopw )
601         CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' ,  sxyopw )
602
603         DO jl = 1, jpl 
604            WRITE(zchar,'(I2.2)') jl
605            DO jk = 1, nlay_i 
606               WRITE(zchar1,'(I2.2)') jk
607               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar
608               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
609               sxe(:,:,jk,jl) = z2d(:,:)
610               znam = 'sye'//'_il'//zchar1//'_htc'//zchar
611               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
612               sye(:,:,jk,jl) = z2d(:,:)
613               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar
614               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
615               sxxe(:,:,jk,jl) = z2d(:,:)
616               znam = 'syye'//'_il'//zchar1//'_htc'//zchar
617               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
618               syye(:,:,jk,jl) = z2d(:,:)
619               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar
620               CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
621               sxye(:,:,jk,jl) = z2d(:,:)
622            END DO
623         END DO
624         !
625      END IF
626     
627      ! clem: I do not understand why the following IF is needed
628      !       I suspect something inconsistent in the main code with option nn_icesal=1
629      IF( nn_icesal == 1 ) THEN
630         DO jl = 1, jpl 
631            sm_i(:,:,jl) = rn_icesal
632            DO jk = 1, nlay_i 
633               s_i(:,:,jk,jl) = rn_icesal
634            END DO
635         END DO
636      ENDIF
637      !
638      !CALL iom_close( numrir ) !clem: closed in icestp.F90
639      !
640   END SUBROUTINE ice_rst_read
641
642#else
643   !!----------------------------------------------------------------------
644   !!   Default option :       Empty module            NO LIM sea-ice model
645   !!----------------------------------------------------------------------
646#endif
647
648   !!======================================================================
649END MODULE icerst
Note: See TracBrowser for help on using the repository browser.