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

Last change on this file since 12649 was 12649, checked in by smasson, 4 years ago
trunk: clean and unique 3rd dimension in iom_rstput, see #2432
Property svn:keywords set to `Id`
File size: 16.0 KB

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

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

Download in other formats: