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 NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/ICE – NEMO

source: NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/ICE/icerst.F90 @ 13338

Last change on this file since 13338 was 13338, checked in by jchanut, 4 years ago

#2222, forgotten key_agrif in previous commit

  • Property svn:keywords set to Id
File size: 13.9 KB
Line 
1MODULE icerst
2   !!======================================================================
3   !!                     ***  MODULE  icerst  ***
4   !!   sea-ice :  write/read the ice restart file
5   !!======================================================================
6   !! History:   4.0  !  2018     (many people)      SI3 [aka Sea Ice cube]
7   !!----------------------------------------------------------------------
8#if defined key_si3
9   !!----------------------------------------------------------------------
10   !!   'key_si3'                                       SI3 sea-ice model
11   !!----------------------------------------------------------------------
12   !!   ice_rst_opn   : open  restart file
13   !!   ice_rst_write : write restart file
14   !!   ice_rst_read  : read  restart file
15   !!----------------------------------------------------------------------
16   USE ice            ! sea-ice: variables
17   USE dom_oce        ! ocean domain
18   USE phycst  , ONLY : rt0
19   USE sbc_oce , ONLY : nn_fsbc, ln_cpl
20   USE iceistate      ! sea-ice: initial state
21   USE icectl         ! sea-ice: control
22   !
23   USE in_out_manager ! I/O manager
24   USE iom            ! I/O manager library
25   USE lib_mpp        ! MPP library
26   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
27
28#if defined key_agrif
29   USE agrif_oce      ! initial state interpolation
30   USE agrif_ice_interp
31#endif 
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   ice_rst_opn     ! called by icestp
37   PUBLIC   ice_rst_write   ! called by icestp
38   PUBLIC   ice_rst_read    ! called by ice_init
39
40   !!----------------------------------------------------------------------
41   !! NEMO/ICE 4.0 , NEMO Consortium (2018)
42   !! $Id$
43   !! Software governed by the CeCILL license (see ./LICENSE)
44   !!----------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE ice_rst_opn( kt )
48      !!----------------------------------------------------------------------
49      !!                    ***  ice_rst_opn  ***
50      !!
51      !! ** purpose  :   open restart file
52      !!----------------------------------------------------------------------
53      INTEGER, INTENT(in) ::   kt       ! number of iteration
54      !
55      CHARACTER(len=20)   ::   clkt     ! ocean time-step define as a character
56      CHARACTER(len=50)   ::   clname   ! ice output restart file name
57      CHARACTER(len=256)  ::   clpath   ! full path to ice output restart file
58      !!----------------------------------------------------------------------
59      !
60      IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
61
62      IF( ln_rst_list .OR. nn_stock /= -1 ) THEN
63      ! in order to get better performances with NetCDF format, we open and define the ice restart file
64      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), except if we write ice
65      ! restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1
66      IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nn_stock == nn_fsbc    &
67         &                             .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN
68         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN
69            ! beware of the format used to write kt (default is i8.8, that should be large enough...)
70            IF( nitrst > 99999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
71            ELSE                           ;   WRITE(clkt, '(i8.8)') nitrst
72            ENDIF
73            ! create the file
74            clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)
75            clpath = TRIM(cn_icerst_outdir) 
76            IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/'
77            IF(lwp) THEN
78               WRITE(numout,*)
79               WRITE(numout,*) '             open ice restart NetCDF file: ',TRIM(clpath)//clname
80               IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN
81                  WRITE(numout,*) '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
82               ELSE
83                  WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
84               ENDIF
85            ENDIF
86            !
87            CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' )
88            lrst_ice = .TRUE.
89         ENDIF
90      ENDIF
91      ENDIF
92      !
93      IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' )   ! control print
94      !
95   END SUBROUTINE ice_rst_opn
96
97
98   SUBROUTINE ice_rst_write( kt )
99      !!----------------------------------------------------------------------
100      !!                    ***  ice_rst_write  ***
101      !!
102      !! ** purpose  :   write restart file
103      !!----------------------------------------------------------------------
104      INTEGER, INTENT(in) ::   kt     ! number of iteration
105      !!
106      INTEGER ::   jk    ! dummy loop indices
107      INTEGER ::   iter
108      CHARACTER(len=25) ::   znam
109      CHARACTER(len=2)  ::   zchar, zchar1
110      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace
111      !!----------------------------------------------------------------------
112
113      iter = kt + nn_fsbc - 1   ! ice restarts are written at kt == nitrst - nn_fsbc + 1
114
115      IF( iter == nitrst ) THEN
116         IF(lwp) WRITE(numout,*)
117         IF(lwp) WRITE(numout,*) 'ice_rst_write : write ice restart file  kt =', kt
118         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'         
119      ENDIF
120
121      ! Write in numriw (if iter == nitrst)
122      ! ------------------
123      !                                                                        ! calendar control
124      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step
125      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date
126      CALL iom_delay_rst( 'WRITE', 'ICE', numriw )   ! save only ice delayed global communication variables
127
128      ! Prognostic variables
129      CALL iom_rstput( iter, nitrst, numriw, 'v_i'  , v_i   )
130      CALL iom_rstput( iter, nitrst, numriw, 'v_s'  , v_s   )
131      CALL iom_rstput( iter, nitrst, numriw, 'sv_i' , sv_i  )
132      CALL iom_rstput( iter, nitrst, numriw, 'a_i'  , a_i   )
133      CALL iom_rstput( iter, nitrst, numriw, 't_su' , t_su  )
134      CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice )
135      CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice )
136      CALL iom_rstput( iter, nitrst, numriw, 'oa_i' , oa_i  )
137      CALL iom_rstput( iter, nitrst, numriw, 'a_ip' , a_ip  )
138      CALL iom_rstput( iter, nitrst, numriw, 'v_ip' , v_ip  )
139      ! Snow enthalpy
140      DO jk = 1, nlay_s 
141         WRITE(zchar1,'(I2.2)') jk
142         znam = 'e_s'//'_l'//zchar1
143         z3d(:,:,:) = e_s(:,:,jk,:)
144         CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
145      END DO
146      ! Ice enthalpy
147      DO jk = 1, nlay_i 
148         WRITE(zchar1,'(I2.2)') jk
149         znam = 'e_i'//'_l'//zchar1
150         z3d(:,:,:) = e_i(:,:,jk,:)
151         CALL iom_rstput( iter, nitrst, numriw, znam , z3d )
152      END DO
153      ! fields needed for Met Office (Jules) coupling
154      IF( ln_cpl ) THEN
155         CALL iom_rstput( iter, nitrst, numriw, 'cnd_ice', cnd_ice )
156         CALL iom_rstput( iter, nitrst, numriw, 't1_ice' , t1_ice  )
157      ENDIF
158      !
159
160      ! close restart file
161      ! ------------------
162      IF( iter == nitrst ) THEN
163         CALL iom_close( numriw )
164         lrst_ice = .FALSE.
165      ENDIF
166      !
167   END SUBROUTINE ice_rst_write
168
169
170   SUBROUTINE ice_rst_read( Kbb, Kmm, Kaa )
171      !!----------------------------------------------------------------------
172      !!                    ***  ice_rst_read  ***
173      !!
174      !! ** purpose  :   read restart file
175      !!----------------------------------------------------------------------
176      INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
177      INTEGER           ::   jk
178      LOGICAL           ::   llok
179      INTEGER           ::   id0, id1, id2, id3, id4   ! local integer
180      CHARACTER(len=25) ::   znam
181      CHARACTER(len=2)  ::   zchar, zchar1
182      REAL(wp)          ::   zfice, ziter
183      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   z3d   ! 3D workspace
184      !!----------------------------------------------------------------------
185
186      IF(lwp) THEN
187         WRITE(numout,*)
188         WRITE(numout,*) 'ice_rst_read: read ice NetCDF restart file'
189         WRITE(numout,*) '~~~~~~~~~~~~'
190      ENDIF
191
192#if defined key_agrif
193      IF( (.NOT.Agrif_Root()).AND.ln_init_chfrpar ) THEN
194         !                 ! -------------------------------- !
195         !                 ! == set ice fields from parent == !
196         !                 ! -------------------------------- !
197         !
198         CALL agrif_istate_ice
199         !
200      ELSE
201#endif
202
203         CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir )
204
205         ! test if v_i exists
206         id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. )
207
208         !                    ! ------------------------------ !
209         IF( id0 > 0 ) THEN   ! == case of a normal restart == !
210            !                 ! ------------------------------ !
211         
212            ! Time info
213            CALL iom_get( numrir, 'nn_fsbc', zfice )
214            CALL iom_get( numrir, 'kt_ice' , ziter )   
215            IF(lwp) WRITE(numout,*) '   read ice restart file at time step    : ', ziter
216            IF(lwp) WRITE(numout,*) '   in any case we force it to nit000 - 1 : ', nit000 - 1
217
218            ! Control of date
219            IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 )   &
220               &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart',  &
221               &                   '   verify the file or rerun with the value 0 for the',        &
222               &                   '   control of time parameter  nrstdt' )
223            IF( NINT(zfice) /= nn_fsbc          .AND. ABS( nrstdt ) == 1 )   &
224               &     CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart',  &
225               &                   '   verify the file or rerun with the value 0 for the',         &
226               &                   '   control of time parameter  nrstdt' )
227
228            ! --- mandatory fields --- !
229            CALL iom_get( numrir, jpdom_auto, 'v_i'  , v_i   )
230            CALL iom_get( numrir, jpdom_auto, 'v_s'  , v_s   )
231            CALL iom_get( numrir, jpdom_auto, 'sv_i' , sv_i  )
232            CALL iom_get( numrir, jpdom_auto, 'a_i'  , a_i   )
233            CALL iom_get( numrir, jpdom_auto, 't_su' , t_su  )
234            CALL iom_get( numrir, jpdom_auto, 'u_ice', u_ice, cd_type = 'U', psgn = -1._wp )
235            CALL iom_get( numrir, jpdom_auto, 'v_ice', v_ice, cd_type = 'V', psgn = -1._wp )
236            ! Snow enthalpy
237            DO jk = 1, nlay_s
238               WRITE(zchar1,'(I2.2)') jk
239               znam = 'e_s'//'_l'//zchar1
240               CALL iom_get( numrir, jpdom_auto, znam , z3d )
241               e_s(:,:,jk,:) = z3d(:,:,:)
242            END DO
243            ! Ice enthalpy
244            DO jk = 1, nlay_i
245               WRITE(zchar1,'(I2.2)') jk
246               znam = 'e_i'//'_l'//zchar1
247               CALL iom_get( numrir, jpdom_auto, znam , z3d )
248               e_i(:,:,jk,:) = z3d(:,:,:)
249            END DO
250            ! -- optional fields -- !
251            ! ice age
252            id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. )
253            IF( id1 > 0 ) THEN                       ! fields exist
254               CALL iom_get( numrir, jpdom_auto, 'oa_i', oa_i )
255            ELSE                                     ! start from rest
256               IF(lwp) WRITE(numout,*) '   ==>>   previous run without ice age output then set it to zero'
257               oa_i(:,:,:) = 0._wp
258            ENDIF
259            ! melt ponds
260            id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. )
261            IF( id2 > 0 ) THEN                       ! fields exist
262               CALL iom_get( numrir, jpdom_auto, 'a_ip' , a_ip )
263               CALL iom_get( numrir, jpdom_auto, 'v_ip' , v_ip )
264            ELSE                                     ! start from rest
265               IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero'
266               a_ip(:,:,:) = 0._wp
267               v_ip(:,:,:) = 0._wp
268            ENDIF
269            ! fields needed for Met Office (Jules) coupling
270            IF( ln_cpl ) THEN
271               id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. )
272               id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. )
273               IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist
274                  CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice )
275                  CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice  )
276               ELSE                                     ! start from rest
277                  IF(lwp) WRITE(numout,*) '   ==>>   previous run without conductivity output then set it to zero'
278                  cnd_ice(:,:,:) = 0._wp
279                  t1_ice (:,:,:) = rt0
280               ENDIF
281            ENDIF
282
283            CALL iom_delay_rst( 'READ', 'ICE', numrir )   ! read only ice delayed global communication variables
284
285            !                 ! ---------------------------------- !
286         ELSE                 ! == case of a simplified restart == !
287            !                 ! ---------------------------------- !
288            CALL ctl_warn('ice_rst_read: you are using a simplified ice restart')
289            !
290            CALL ice_istate_init
291            CALL ice_istate( nit000, Kbb, Kmm, Kaa )
292            !
293            IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) &
294               &   CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T')
295            !
296         ENDIF
297#if defined key_agrif
298      ENDIF
299#endif
300
301   END SUBROUTINE ice_rst_read
302
303#else
304   !!----------------------------------------------------------------------
305   !!   Default option :       Empty module           NO SI3 sea-ice model
306   !!----------------------------------------------------------------------
307#endif
308
309   !!======================================================================
310END MODULE icerst
Note: See TracBrowser for help on using the repository browser.