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.

sedrst.F90 in NEMO/trunk/src/TOP/PISCES/SED – NEMO

Context Navigation

source: NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90 @ 13970

Last change on this file since 13970 was 13970, checked in by andmirek, 3 years ago
Ticket #2462 into the trunk
Property svn:keywords set to `Id`
File size: 17.5 KB

Line
1	MODULE sedrst
2	!!======================================================================
3	!! * MODULE sedrst *
4	!! Read and write the restart files for sediment
5	!!======================================================================
6
7	!!----------------------------------------------------------------------
8	!! * Modules used
9	!! ==============
10	USE sed
11	USE sedarr
12	USE trc_oce, ONLY : l_offline
13	USE phycst , ONLY : rday
14	USE iom
15	USE daymod
16	USE lib_mpp ! distribued memory computing library
17
18
19	!! * Accessibility
20	IMPLICIT NONE
21	PRIVATE
22
23	!! * Accessibility
24	PUBLIC sed_rst_opn ! called by ???
25	PUBLIC sed_rst_read
26	PUBLIC sed_rst_wri
27	PUBLIC sed_rst_cal
28
29	!! $Id$
30	CONTAINS
31
32
33	SUBROUTINE sed_rst_opn( kt )
34	!!----------------------------------------------------------------------
35	!! * sed_rst_opn *
36	!!
37	!! ** purpose : output of sed-trc variable in a netcdf file
38	!!----------------------------------------------------------------------
39	INTEGER, INTENT(in) :: kt ! number of iteration
40	!
41	CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character
42	CHARACTER(LEN=50) :: clname ! trc output restart file name
43	CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file
44	CHARACTER(LEN=52) :: clpname ! trc output restart file name including AGRIF
45	!!----------------------------------------------------------------------
46	!
47	IF( l_offline ) THEN
48	IF( kt == nittrc000 ) THEN
49	lrst_sed = .FALSE.
50	IF( ln_rst_list ) THEN
51	nrst_lst = 1
52	nitrst = nn_stocklist( nrst_lst )
53	ELSE
54	nitrst = nitend
55	ENDIF
56	ENDIF
57	IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN
58	! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment
59	nitrst = kt + nn_stock - 1 ! define the next value of nitrst for restart writing
60	IF( nitrst > nitend ) nitrst = nitend ! make sure we write a restart at the end of the run
61	ENDIF
62	ELSE
63	IF( kt == nittrc000 ) lrst_sed = .FALSE.
64	ENDIF
65
66	IF( .NOT. ln_rst_list .AND. nn_stock == -1 ) RETURN ! we will never do any restart
67
68	! to get better performances with NetCDF format:
69	! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1)
70	! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1
71	IF( kt == nitrst - 2*nn_dtsed .OR. nn_stock == nn_dtsed .OR. ( kt == nitend - nn_dtsed .AND. .NOT. lrst_sed ) ) THEN
72	! beware of the format used to write kt (default is i8.8, that should be large enough)
73	IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst
74	ELSE ; WRITE(clkt,'(i8.8)') nitrst
75	ENDIF
76	! create the file
77	IF(lwp) WRITE(numsed,*)
78	clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_sedrst_out)
79	clpath = TRIM(cn_sedrst_outdir)
80	IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
81	IF(lwp) WRITE(numsed,*) &
82	' open sed restart.output NetCDF file: ',TRIM(clpath)//clname
83	IF(.NOT.lwxios) THEN
84	CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' )
85	ELSE
86	#if defined key_iomput
87	cw_sedrst_cxt = "rstws_"//TRIM(ADJUSTL(clkt))
88	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
89	clpname = clname
90	ELSE
91	clpname = TRIM(Agrif_CFixed())//"_"//clname
92	ENDIF
93	numrsw = iom_xios_setid(TRIM(clpath)//TRIM(clpname))
94	CALL iom_init( cw_sedrst_cxt, kdid = numrsw, ld_closedef = .FALSE. )
95	#else
96	clinfo = 'Can not use XIOS in trc_rst_opn'
97	CALL ctl_stop(TRIM(clinfo))
98	#endif
99	ENDIF
100
101	lrst_sed = .TRUE.
102	ENDIF
103	!
104	END SUBROUTINE sed_rst_opn
105
106	SUBROUTINE sed_rst_read
107	!!----------------------------------------------------------------------
108	!! * ROUTINE sed_rst_read *
109	!!
110	!! ** Purpose : Initialization of sediment module
111	!! - sets initial sediment composition
112	!! ( only clay or reading restart file )
113	!!
114	!! History :
115	!! ! 06-07 (C. Ethe) original
116	!!----------------------------------------------------------------------
117
118	!! * local declarations
119	INTEGER :: ji, jj, jk, jn
120	REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: zdta
121	REAL(wp), DIMENSION(jpi,jpj,jpksed,2) :: zdta1
122	REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2
123	REAL(wp), DIMENSION(jpoce,jpksed) :: zhipor
124	REAL(wp) :: zkt
125	CHARACTER(len = 20) :: cltra
126	CHARACTER(LEN=20) :: name1
127	LOGICAL :: llok
128	!--------------------------------------------------------------------
129
130	IF( ln_timing ) CALL timing_start('sed_rst_read')
131
132	IF (lwp) WRITE(numsed,*) ' '
133	IF (lwp) WRITE(numsed,*) ' Initilization of Sediment components from restart'
134	IF (lwp) WRITE(numsed,*) ' '
135
136	zdta = 1.
137	zdta1 = 1.
138	zdta2 = 0.
139
140	DO jn = 1, jptrased
141	cltra = TRIM(sedtrcd(jn))
142	IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
143	CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta(:,:,:,jn) )
144	ELSE
145	zdta(:,:,:,jn) = 0.0
146	ENDIF
147	ENDDO
148
149	DO jn = 1, jpsol
150	CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jn), &
151	& zdta(1:jpi,1:jpj,1:jpksed,jn), iarroce(1:jpoce) )
152	END DO
153
154	DO jn = 1, jpwat
155	CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jn), &
156	& zdta(1:jpi,1:jpj,1:jpksed,jpsol+jn), iarroce(1:jpoce) )
157	END DO
158
159	DO jn = 1, 2
160	cltra = TRIM(seddia3d(jn))
161	IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
162	CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta1(:,:,:,jn) )
163	ELSE
164	zdta1(:,:,:,jn) = 0.0
165	ENDIF
166	ENDDO
167
168	zhipor(:,:) = 0.
169	CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), &
170	& zdta1(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) )
171
172	! Initialization of [h+] in mol/kg
173	DO jk = 1, jpksed
174	DO ji = 1, jpoce
175	hipor (ji,jk) = 10.*( -1. zhipor(ji,jk) )
176	ENDDO
177	ENDDO
178
179	CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), &
180	& zdta1(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) )
181
182	! Initialization of sediment composant only ie jk=2 to jk=jpksed
183	! ( nothing in jk=1)
184	solcp(1:jpoce,1,:) = 0.
185	pwcp (1:jpoce,1,:) = 0.
186
187	cltra = "dbioturb"
188	IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
189	CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) )
190	ELSE
191	zdta2(:,:,:) = 0.0
192	ENDIF
193
194	CALL pack_arr( jpoce, db(1:jpoce,1:jpksed), &
195	& zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
196
197	cltra = "irrig"
198	IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
199	CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) )
200	ELSE
201	zdta2(:,:,:) = 0.0
202	ENDIF
203
204	CALL pack_arr( jpoce, irrig(1:jpoce,1:jpksed), &
205	& zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
206
207	cltra = "sedligand"
208	IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN
209	CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) )
210	ELSE
211	zdta2(:,:,:) = 0.0
212	ENDIF
213
214	CALL pack_arr( jpoce, sedligand(1:jpoce,1:jpksed), &
215	& zdta2(1:jpi,1:jpj,1:jpksed), iarroce(1:jpoce) )
216	IF( ln_timing ) CALL timing_stop('sed_rst_read')
217
218	END SUBROUTINE sed_rst_read
219
220	SUBROUTINE sed_rst_wri( kt )
221	!!----------------------------------------------------------------------
222	!! * ROUTINE sed_rst_wri *
223	!!
224	!! ** Purpose : save field which are necessary for sediment restart
225	!!
226	!! History :
227	!! ! 06-07 (C. Ethe) original
228	!!----------------------------------------------------------------------
229	!!* Modules used
230	INTEGER, INTENT(in) :: kt ! number of iteration
231	!! * local declarations
232	INTEGER :: ji, jj, jk, jn
233	REAL(wp), DIMENSION(1) :: zinfo
234	CHARACTER(len=50) :: clname
235	CHARACTER(len=20) :: cltra, name1
236	REAL(wp), DIMENSION(jpoce,jpksed) :: zdta
237	REAL(wp), DIMENSION(jpi,jpj,jpksed) :: zdta2
238	!! -----------------------------------------------------------------------
239
240	IF( ln_timing ) CALL timing_start('sed_rst_wri')
241
242	!! 0. initialisations
243	!! ------------------
244
245	IF(lwp) WRITE(numsed,*) ' '
246	IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ', &
247	'at it= ',kt
248	IF(lwp) WRITE(numsed,*) '~~~~~~~~~'
249
250
251	trcsedi(:,:,:,:) = 0.0
252	flxsedi3d(:,:,:,:) = 0.0
253	zdta(:,:) = 1.0
254	zdta2(:,:,:) = 0.0
255
256
257	!! 1. WRITE in nutwrs
258	!! ------------------
259	! zinfo(1) = REAL( kt)
260	CALL iom_rstput( kt, nitrst, numrsw, 'kt', REAL( kt , wp) )
261
262	! Back to 2D geometry
263	DO jn = 1, jpsol
264	CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), &
265	& solcp(1:jpoce,1:jpksed,jn ) )
266	END DO
267
268	DO jn = 1, jpwat
269	CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol+jn) , iarroce(1:jpoce), &
270	& pwcp(1:jpoce,1:jpksed,jn ) )
271	END DO
272	! pH
273	DO jk = 1, jpksed
274	DO ji = 1, jpoce
275	zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn )
276	ENDDO
277	ENDDO
278
279	CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), &
280	& zdta(1:jpoce,1:jpksed) )
281
282	CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), &
283	& co3por(1:jpoce,1:jpksed) )
284
285	! prognostic variables
286	! --------------------
287
288	DO jn = 1, jptrased
289	cltra = TRIM(sedtrcd(jn))
290	CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), trcsedi(:,:,:,jn) )
291	ENDDO
292
293	DO jn = 1, 2
294	cltra = TRIM(seddia3d(jn))
295	CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), flxsedi3d(:,:,:,jn) )
296	ENDDO
297
298	CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), &
299	& db(1:jpoce,1:jpksed) )
300
301	cltra = "dbioturb"
302	CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) )
303
304	CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), &
305	& irrig(1:jpoce,1:jpksed) )
306
307	cltra = "irrig"
308	CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) )
309
310	CALL unpack_arr( jpoce, zdta2(1:jpi,1:jpj,1:jpksed) , iarroce(1:jpoce), &
311	& sedligand(1:jpoce,1:jpksed) )
312
313	cltra = "sedligand"
314	CALL iom_rstput( kt, nitrst, numrsw, TRIM(cltra), zdta2(:,:,:) )
315
316	IF( kt == nitrst ) THEN
317	IF(.NOT.lwxios) THEN
318	CALL iom_close( numrsw ) ! close the restart file (only at last time step)
319	ELSE
320	CALL iom_context_finalize( cw_sedrst_cxt )
321	iom_file(numrsw)%nfid = 0
322	numrsw = 0
323	ENDIF
324	IF( l_offline .AND. ln_rst_list ) THEN
325	nrst_lst = nrst_lst + 1
326	nitrst = nn_stocklist( nrst_lst )
327	ENDIF
328	ENDIF
329
330	IF( ln_timing ) CALL timing_stop('sed_rst_wri')
331
332	END SUBROUTINE sed_rst_wri
333
334
335	SUBROUTINE sed_rst_cal( kt, cdrw )
336	!!---------------------------------------------------------------------
337	!! * ROUTINE sed_rst_cal *
338	!!
339	!! ** Purpose : Read or write calendar in restart file:
340	!!
341	!! WRITE(READ) mode:
342	!! kt : number of time step since the begining of the experiment at the
343	!! end of the current(previous) run
344	!! adatrj(0) : number of elapsed days since the begining of the experiment at the
345	!! end of the current(previous) run (REAL -> keep fractions of day)
346	!! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer)
347	!!
348	!! According to namelist parameter nrstdt,
349	!! nn_rsttr = 0 no control on the date (nittrc000 is arbitrary).
350	!! nn_rsttr = 1 we verify that nittrc000 is equal to the last
351	!! time step of previous run + 1.
352	!! In both those options, the exact duration of the experiment
353	!! since the beginning (cumulated duration of all previous restart runs)
354	!! is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt.
355	!! This is valid is the time step has remained constant.
356	!!
357	!! nn_rsttr = 2 the duration of the experiment in days (adatrj)
358	!! has been stored in the restart file.
359	!!----------------------------------------------------------------------
360	INTEGER , INTENT(in) :: kt ! ocean time-step
361	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
362	!
363	LOGICAL :: llok
364	REAL(wp) :: zkt, zrdttrc1
365	REAL(wp) :: zndastp
366	CHARACTER(len = 82) :: clpname
367
368	! Time domain : restart
369	! ---------------------
370
371	IF( TRIM(cdrw) == 'READ' ) THEN
372
373	IF(lwp) WRITE(numsed,*)
374	IF(lwp) WRITE(numsed,*) 'sed_rst_cal : read the SED restart file for calendar'
375	IF(lwp) WRITE(numsed,*) '~~~~~~~~~~~~'
376
377	IF( ln_rst_sed ) THEN
378	lxios_sini = .FALSE.
379	CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr )
380
381	IF( lrxios) THEN
382	cr_sedrst_cxt = 'sed_rst'
383	IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for SED'
384	! IF( TRIM(Agrif_CFixed()) == '0' ) THEN
385	! clpname = cn_sedrst_in
386	! ELSE
387	! clpname = TRIM(Agrif_CFixed())//"_"//cn_sedrst_in
388	! ENDIF
389	CALL iom_init( cr_sedrst_cxt, kdid = numrsr, ld_closedef = .TRUE. )
390	ENDIF
391	CALL iom_get ( numrsr, 'kt', zkt ) ! last time-step of previous run
392	IF(lwp) THEN
393	WRITE(numsed,) ' ** Info read in restart : '
394	WRITE(numsed,*) ' previous time-step : ', NINT( zkt )
395	WRITE(numsed,) ' ** restart option'
396	SELECT CASE ( nn_rstsed )
397	CASE ( 0 ) ; WRITE(numsed,*) ' nn_rstsed = 0 : no control of nittrc000'
398	CASE ( 1 ) ; WRITE(numsed,*) ' nn_rstsed = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
399	CASE ( 2 ) ; WRITE(numsed,*) ' nn_rstsed = 2 : calendar parameters read in restart'
400	END SELECT
401	WRITE(numsed,*)
402	ENDIF
403	! Control of date
404	IF( nittrc000 - NINT( zkt ) /= nn_dtsed .AND. nn_rstsed /= 0 ) &
405	& CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart', &
406	& ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
407	ENDIF
408	!
409	IF( l_offline ) THEN
410	! ! set the date in offline mode
411	IF( ln_rst_sed .AND. nn_rstsed == 2 ) THEN
412	CALL iom_get( numrsr, 'ndastp', zndastp )
413	ndastp = NINT( zndastp )
414	CALL iom_get( numrsr, 'adatrj', adatrj )
415	ELSE
416	ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam
417	adatrj = ( REAL( nittrc000-1, wp ) * rn_Dt ) / rday
418	! note this is wrong if time step has changed during run
419	ENDIF
420	!
421	IF(lwp) THEN
422	WRITE(numsed,) ' ** Info used values : '
423	WRITE(numsed,*) ' date ndastp : ', ndastp
424	WRITE(numsed,*) ' number of elapsed days since the begining of run : ', adatrj
425	WRITE(numsed,*)
426	ENDIF
427	!
428	CALL day_init ! compute calendar
429	!
430	ENDIF
431	!
432	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
433	!
434	IF( kt == nitrst ) THEN
435	IF(lwp) WRITE(numsed,*)
436	IF(lwp) WRITE(numsed,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp
437	IF(lwp) WRITE(numsed,*) '~~~~~~~'
438	IF( lwxios ) CALL iom_init_closedef(cw_sedrst_cxt)
439	ENDIF
440	CALL iom_rstput( kt, nitrst, numrsw, 'kt' , REAL( kt , wp) ) ! time-step
441	CALL iom_rstput( kt, nitrst, numrsw, 'ndastp' , REAL( ndastp, wp) ) ! date
442	CALL iom_rstput( kt, nitrst, numrsw, 'adatrj' , adatrj ) ! number of elapsed days since
443	! ! the begining of the run [s]
444	ENDIF
445
446	END SUBROUTINE sed_rst_cal
447
448	END MODULE sedrst

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

Download in other formats: