Context Navigation

icerst.F90 @ 14239

Last change on this file since 14239 was 14239, checked in by smasson, 3 years ago
trunk: replace key_iomput by key_xios
Property svn:keywords set to `Id`
File size: 15.8 KB

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

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/trunk/src/ICE/icerst.F90 @ 14239

Download in other formats: