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 @ 14219

Last change on this file since 14219 was 14055, checked in by cetlod, 4 years ago

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