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.

restart.F90 in trunk/NEMO/OPA_SRC – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/restart.F90 @ 584

Last change on this file since 584 was 579, checked in by opalod, 18 years ago
nemo_v1_bugfix_080: CT : compilation error correction
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 17.6 KB

Rev	Line
[3]	1	MODULE restart
	2	!!======================================================================
	3	!! * MODULE restart *
	4	!! Ocean restart : write the ocean restart file
[508]	5	!!======================================================================
	6	!! History : ! 99-11 (M. Imbard) Original code
	7	!! 8.5 ! 02-08 (G. Madec) F90: Free form
	8	!! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization
	9	!! 9.0 ! 06-07 (S. Masson) use IOM for restart
	10	!!----------------------------------------------------------------------
[3]	11
	12	!!----------------------------------------------------------------------
[508]	13	!! rst_opn : open the ocean restart file
	14	!! rst_write : write the ocean restart file
	15	!! rst_read : read the ocean restart file
[3]	16	!!----------------------------------------------------------------------
	17	USE dom_oce ! ocean space and time domain
	18	USE oce ! ocean dynamics and tracers
	19	USE phycst ! physical constants
	20	USE daymod ! calendar
	21	USE ice_oce ! ice variables
	22	USE blk_oce ! bulk variables
[467]	23	USE cpl_oce, ONLY : lk_cpl !
[508]	24	USE in_out_manager ! I/O manager
	25	USE iom ! I/O module
[544]	26	USE ini1d ! re-initialization of u-v mask for the 1D configuration
	27	USE zpshde ! partial step: hor. derivative (zps_hde routine)
	28	USE eosbn2 ! equation of state (eos bn2 routine)
[579]	29	USE trdmld_oce ! ocean active mixed layer tracers trends variables
[3]	30
	31	IMPLICIT NONE
	32	PRIVATE
	33
[508]	34	PUBLIC rst_opn ! routine called by step module
	35	PUBLIC rst_write ! routine called by step module
	36	PUBLIC rst_read ! routine called by opa module
[3]	37
[521]	38	LOGICAL, PUBLIC :: lrst_oce !: logical to control the oce restart write
[579]	39	INTEGER, PUBLIC :: numror, numrow !: logical unit for cean restart (read and write)
[508]	40
	41	!! * Substitutions
	42	# include "vectopt_loop_substitute.h90"
[3]	43	!!----------------------------------------------------------------------
[508]	44	!! OPA 9.0 , LOCEAN-IPSL (2006)
[359]	45	!! $Header$
[508]	46	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
[359]	47	!!----------------------------------------------------------------------
[3]	48
	49	CONTAINS
	50
[508]	51	SUBROUTINE rst_opn( kt )
	52	!!---------------------------------------------------------------------
	53	!! * ROUTINE rst_opn *
	54	!!
	55	!! ** Purpose : + initialization (should be read in the namelist) of nitrst
	56	!! + open the restart when we are one time step before nitrst
	57	!! - restart header is defined when kt = nitrst-1
	58	!! - restart data are written when kt = nitrst
	59	!! + define lrst_oce to .TRUE. when we need to define or write the restart
	60	!!----------------------------------------------------------------------
	61	INTEGER, INTENT(in) :: kt ! ocean time-step
	62	!!
	63	CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character
	64	CHARACTER(LEN=50) :: clname ! ice output restart file name
	65	!!----------------------------------------------------------------------
	66	!
	67	IF( kt == nit000 ) THEN ! default initialization, to do: should be read in the namelist...
	68	nitrst = nitend ! to do: should be read in the namelist in a cleaver way...
	69	lrst_oce = .FALSE.
	70	ENDIF
	71
	72	IF ( kt == nitrst-1 .AND. lrst_oce ) THEN
[557]	73	CALL ctl_stop( 'rst_opn: we cannot create an ocean restart at every time step', &
	74	& 'if the run ahs more than one tie step!!!' )
[508]	75	numrow = 0
	76	ELSEIF( kt == nitrst-1 .OR. nitend == nit000 ) THEN ! beware if model runs only one time step
	77	! beware of the format used to write kt (default is i8.8, that should be large enough)
	78	IF( nitrst > 1.0e9 ) THEN
	79	WRITE(clkt,*) nitrst
	80	ELSE
	81	WRITE(clkt,'(i8.8)') nitrst
	82	ENDIF
	83	! create the file
	84	IF(lwp) WRITE(numout,*)
	85	clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_restart"
	86	IF(lwp) WRITE(numout,*) ' open ocean restart.output NetCDF file: '//clname
[547]	87	CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
[508]	88	lrst_oce = .TRUE.
	89	ENDIF
	90	!
	91	END SUBROUTINE rst_opn
	92
	93
[3]	94	SUBROUTINE rst_write( kt )
	95	!!---------------------------------------------------------------------
	96	!! * ROUTINE rstwrite *
	97	!!
	98	!! ** Purpose : Write restart fields in NetCDF format
	99	!!
[508]	100	!! ** Method : Write in numrow when kt == nitrst in NetCDF
[3]	101	!! file, save fields which are necessary for restart
	102	!!----------------------------------------------------------------------
[508]	103	INTEGER, INTENT(in) :: kt ! ocean time-step
[3]	104	!!----------------------------------------------------------------------
	105
[508]	106	IF(lwp) THEN
	107	WRITE(numout,*)
	108	WRITE(numout,*) 'rst_write : write ocean NetCDF restart file kt =', kt,' date= ', ndastp
	109	WRITE(numout,*) '~~~~~~~~~'
[3]	110	ENDIF
[544]	111
[508]	112	! calendar control
	113	CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step
	114	CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date
[544]	115	CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since
[508]	116	! ! the begining of the run [s]
[544]	117	CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics time step
	118	CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) ) ! surface tracer time step
[3]	119
[508]	120	! prognostic variables
	121	CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub )
	122	CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb )
	123	CALL iom_rstput( kt, nitrst, numrow, 'tb' , tb )
	124	CALL iom_rstput( kt, nitrst, numrow, 'sb' , sb )
	125	CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb )
	126	CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb )
	127	CALL iom_rstput( kt, nitrst, numrow, 'un' , un )
	128	CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn )
	129	CALL iom_rstput( kt, nitrst, numrow, 'tn' , tn )
	130	CALL iom_rstput( kt, nitrst, numrow, 'sn' , sn )
	131	CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn )
	132	CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn )
[544]	133
	134	#if defined key_ice_lim
[508]	135	CALL iom_rstput( kt, nitrst, numrow, 'nfice' , REAL( nfice, wp) ) ! ice computation frequency
	136	CALL iom_rstput( kt, nitrst, numrow, 'sst_io' , sst_io )
	137	CALL iom_rstput( kt, nitrst, numrow, 'sss_io' , sss_io )
	138	CALL iom_rstput( kt, nitrst, numrow, 'u_io' , u_io )
	139	CALL iom_rstput( kt, nitrst, numrow, 'v_io' , v_io )
[544]	140	# if defined key_coupled
[508]	141	CALL iom_rstput( kt, nitrst, numrow, 'alb_ice', alb_ice )
[3]	142	# endif
[544]	143	#endif
	144	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily
[508]	145	CALL iom_rstput( kt, nitrst, numrow, 'nfbulk' , REAL( nfbulk, wp) ) ! bulk computation frequency
	146	CALL iom_rstput( kt, nitrst, numrow, 'gsst' , gsst )
[544]	147	#endif
[3]	148
[544]	149	IF( nn_dynhpg_rst == 1 ) THEN
	150	CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd )
	151	CALL iom_rstput( kt, nitrst, numrow, 'rhop', rhop )
	152	IF( ln_zps ) THEN
	153	CALL iom_rstput( kt, nitrst, numrow, 'gtu' , gtu )
	154	CALL iom_rstput( kt, nitrst, numrow, 'gsu' , gsu )
	155	CALL iom_rstput( kt, nitrst, numrow, 'gru' , gru )
	156	CALL iom_rstput( kt, nitrst, numrow, 'gtv' , gtv )
	157	CALL iom_rstput( kt, nitrst, numrow, 'gsv' , gsv )
	158	CALL iom_rstput( kt, nitrst, numrow, 'grv' , grv )
	159	ENDIF
	160	ENDIF
	161
[508]	162	IF( kt == nitrst ) THEN
	163	CALL iom_close( numrow ) ! close the restart file (only at last time step)
[579]	164	IF( .NOT. lk_trdmld ) lrst_oce = .FALSE.
[3]	165	ENDIF
[508]	166	!
[3]	167	END SUBROUTINE rst_write
	168
	169
	170	SUBROUTINE rst_read
	171	!!----------------------------------------------------------------------
	172	!! * ROUTINE rst_read *
	173	!!
	174	!! ** Purpose : Read files for restart
	175	!!
	176	!! ** Method : Read the previous fields on the NetCDF file
	177	!! the first record indicates previous characterics
	178	!! after control with the present run, we read :
	179	!! - prognostic variables on the second record
	180	!! - elliptic solver arrays
[359]	181	!! - barotropic stream function arrays ("key_dynspg_rl" defined)
	182	!! or free surface arrays
[3]	183	!! - tke arrays (lk_zdftke=T)
	184	!! for this last three records, the previous characteristics
	185	!! could be different with those used in the present run.
	186	!!
	187	!! According to namelist parameter nrstdt,
	188	!! nrstdt = 0 no control on the date (nit000 is arbitrary).
	189	!! nrstdt = 1 we verify that nit000 is equal to the last
	190	!! time step of previous run + 1.
	191	!! In both those options, the exact duration of the experiment
	192	!! since the beginning (cumulated duration of all previous restart runs)
	193	!! is not stored in the restart and is assumed to be (nit000-1)*rdt.
	194	!! This is valid is the time step has remained constant.
	195	!!
	196	!! nrstdt = 2 the duration of the experiment in days (adatrj)
	197	!! has been stored in the restart file.
	198	!!----------------------------------------------------------------------
[544]	199	REAL(wp) :: zcoef, zkt, zrdt, zrdttra1, zndastp, znfice, znfbulk
	200	#if defined key_ice_lim
[473]	201	INTEGER :: ji, jj
[544]	202	#endif
[3]	203	!!----------------------------------------------------------------------
	204
[508]	205	IF(lwp) THEN ! Contol prints
	206	WRITE(numout,*)
	207	WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
	208	WRITE(numout,*) '~~~~~~~~'
	209
	210	WRITE(numout,) ' ** Info on the present job : '
	211	WRITE(numout,*) ' time-step : ', nit000
	212	WRITE(numout,*) ' date ndastp : ', ndastp
	213	WRITE(numout,*)
	214	WRITE(numout,) ' ** restart option'
	215	SELECT CASE ( nrstdt )
	216	CASE ( 0 )
	217	WRITE(numout,*) ' nrstdt = 0 no control of nit000'
	218	CASE ( 1 )
	219	WRITE(numout,*) ' nrstdt = 1 we control the date of nit000'
	220	CASE ( 2 )
	221	WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file'
	222	CASE DEFAULT
	223	WRITE(numout,*) ' ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date'
	224	WRITE(numout,*) ' ======= ========='
	225	END SELECT
	226	WRITE(numout,*)
[3]	227	ENDIF
	228
[547]	229	CALL iom_open( 'restart', numror, kiolib = jprstlib )
[3]	230
[508]	231	! Calendar informations
[544]	232	CALL iom_get( numror, 'kt' , zkt ) ! time-step
	233	CALL iom_get( numror, 'ndastp' , zndastp ) ! date
[508]	234	IF(lwp) THEN
	235	WRITE(numout,*)
	236	WRITE(numout,) ' ** Info on the restart file read : '
	237	WRITE(numout,*) ' time-step : ', NINT( zkt )
	238	WRITE(numout,*) ' date ndastp : ', NINT( zndastp )
	239	WRITE(numout,*)
	240	ENDIF
[3]	241	! Control of date
[508]	242	IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) &
[473]	243	& CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &
	244	& ' verify the restart file or rerun with nrstdt = 0 (namelist)' )
[3]	245	! re-initialisation of adatrj0
[508]	246	adatrj0 = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
[3]	247	IF ( nrstdt == 2 ) THEN
[544]	248	! by default ndatsp has been set to ndate0 in dom_nam
	249	! ndate0 has been read in the namelist (standard OPA 8)
	250	! here when nrstdt=2 we keep the final date of previous run
[508]	251	ndastp = NINT( zndastp )
[544]	252	CALL iom_get( numror, 'adatrj', adatrj ) ! number of elapsed days since the begining of last run
[3]	253	ENDIF
[544]	254	! Check dynamics and tracer time-step consistency and force Euler restart if changed
	255	IF( iom_varid( numror, 'rdt' ) > 0 ) THEN
	256	CALL iom_get( numror, 'rdt', zrdt )
	257	IF( zrdt /= rdt ) neuler = 0
	258	ENDIF
	259	IF( iom_varid( numror, 'rdttra1' ) > 0 ) THEN
	260	CALL iom_get( numror, 'rdttra1', zrdttra1 )
	261	IF( zrdttra1 /= rdttra(1) ) neuler = 0
	262	ENDIF
	263	!
[508]	264	! ! Read prognostic variables
	265	CALL iom_get( numror, jpdom_local, 'ub' , ub ) ! before i-component velocity
	266	CALL iom_get( numror, jpdom_local, 'vb' , vb ) ! before j-component velocity
	267	CALL iom_get( numror, jpdom_local, 'tb' , tb ) ! before temperature
	268	CALL iom_get( numror, jpdom_local, 'sb' , sb ) ! before salinity
	269	CALL iom_get( numror, jpdom_local, 'rotb' , rotb ) ! before curl
	270	CALL iom_get( numror, jpdom_local, 'hdivb', hdivb ) ! before horizontal divergence
	271	CALL iom_get( numror, jpdom_local, 'un' , un ) ! now i-component velocity
	272	CALL iom_get( numror, jpdom_local, 'vn' , vn ) ! now j-component velocity
	273	CALL iom_get( numror, jpdom_local, 'tn' , tn ) ! now temperature
	274	CALL iom_get( numror, jpdom_local, 'sn' , sn ) ! now salinity
	275	CALL iom_get( numror, jpdom_local, 'rotn' , rotn ) ! now curl
	276	CALL iom_get( numror, jpdom_local, 'hdivn', hdivn ) ! now horizontal divergence
	277
	278
	279	IF( neuler == 0 ) THEN ! Euler restart (neuler=0)
	280	tb (:,:,:) = tn (:,:,:) ! all before fields set to now field values
	281	sb (:,:,:) = sn (:,:,:)
	282	ub (:,:,:) = un (:,:,:)
	283	vb (:,:,:) = vn (:,:,:)
	284	rotb (:,:,:) = rotn (:,:,:)
	285	hdivb(:,:,:) = hdivn(:,:,:)
[3]	286	ENDIF
[508]	287
	288	!!sm: TO BE MOVED IN NEW SURFACE MODULE...
	289
[544]	290	#if defined key_ice_lim
[3]	291	! Louvain La Neuve Sea Ice Model
[508]	292	IF( iom_varid( numror, 'nfice' ) > 0 ) then
	293	CALL iom_get( numror , 'nfice' , znfice ) ! ice computation frequency
	294	CALL iom_get( numror, jpdom_local, 'sst_io' , sst_io )
	295	CALL iom_get( numror, jpdom_local, 'sss_io' , sss_io )
	296	CALL iom_get( numror, jpdom_local, 'u_io' , u_io )
	297	CALL iom_get( numror, jpdom_local, 'v_io' , v_io )
[544]	298	# if defined key_coupled
[508]	299	CALL iom_get( numror, jpdom_local, 'alb_ice', alb_ice )
[544]	300	# endif
[508]	301	IF( znfice /= REAL( nfice, wp ) ) THEN ! if nfice changed between 2 runs
	302	zcoef = REAL( nfice-1, wp ) / znfice
	303	sst_io(:,:) = zcoef * sst_io(:,:)
	304	sss_io(:,:) = zcoef * sss_io(:,:)
	305	u_io (:,:) = zcoef * u_io (:,:)
	306	v_io (:,:) = zcoef * v_io (:,:)
	307	ENDIF
	308	ELSE
[3]	309	IF(lwp) WRITE(numout,*)
	310	IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization'
	311	IF(lwp) WRITE(numout,*)
[508]	312	zcoef = REAL( nfice-1, wp )
	313	sst_io(:,:) = zcoef *( tn(:,:,1) + rt0 ) !!bug a explanation is needed here!
	314	sss_io(:,:) = zcoef * sn(:,:,1)
	315	zcoef = 0.5 * REAL( nfice-1, wp )
[3]	316	DO jj = 2, jpj
[508]	317	DO ji = fs_2, jpi ! vector opt.
	318	u_io(ji,jj) = zcoef * ( un(ji-1,jj ,1) + un(ji-1,jj-1,1) )
	319	v_io(ji,jj) = zcoef * ( vn(ji ,jj-1,1) + vn(ji-1,jj-1,1) )
[3]	320	END DO
	321	END DO
[544]	322	# if defined key_coupled
[3]	323	alb_ice(:,:) = 0.8 * tmask(:,:,1)
[544]	324	# endif
[3]	325	ENDIF
[544]	326	#endif
	327	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily
[3]	328	! Louvain La Neuve Sea Ice Model
[508]	329	IF( iom_varid( numror, 'nfbulk' ) > 0 ) THEN
	330	CALL iom_get( numror , 'nfbulk', znfbulk ) ! bulk computation frequency
	331	CALL iom_get( numror, jpdom_local, 'gsst' , gsst )
	332	IF( znfbulk /= REAL(nfbulk, wp) ) THEN ! if you change nfbulk between 2 runs
	333	zcoef = REAL( nfbulk-1, wp ) / znfbulk
	334	gsst(:,:) = zcoef * gsst(:,:)
	335	ENDIF
	336	ELSE
[3]	337	IF(lwp) WRITE(numout,*)
	338	IF(lwp) WRITE(numout,*) 'rst_read : LLN sea Ice Model => Ice initialization'
	339	IF(lwp) WRITE(numout,*)
[508]	340	gsst(:,:) = REAL( nfbulk - 1, wp )*( tn(:,:,1) + rt0 )
[3]	341	ENDIF
[544]	342	#endif
[3]	343
[508]	344	!!sm: end of TO BE MOVED IN NEW SURFACE MODULE...
[544]	345
	346	IF( iom_varid( numror, 'rhd' ) > 0 ) THEN
	347	CALL iom_get( numror, jpdom_local, 'rhd' , rhd )
	348	CALL iom_get( numror, jpdom_local, 'rhop', rhop )
	349	ELSE
	350	CALL eos( tb, sb, rhd, rhop ) ! before potential and in situ densities
	351	ENDIF
	352	IF( ln_zps .AND. .NOT. lk_cfg_1d ) THEN
	353	IF( iom_varid( numror, 'gtu' ) > 0 ) THEN
	354	CALL iom_get( numror, jpdom_local, 'gtu' , gtu )
	355	CALL iom_get( numror, jpdom_local, 'gsu' , gsu )
	356	CALL iom_get( numror, jpdom_local, 'gru' , gru )
	357	CALL iom_get( numror, jpdom_local, 'gtv' , gtv )
	358	CALL iom_get( numror, jpdom_local, 'gsv' , gsv )
	359	CALL iom_get( numror, jpdom_local, 'grv' , grv )
	360	ELSE
	361	CALL zps_hde( nit000, tb , sb , rhd, & ! Partial steps: before Horizontal DErivative
	362	& gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level
	363	& gtv, gsv, grv )
	364	ENDIF
	365	ENDIF
[508]	366	!
	367	END SUBROUTINE rst_read
[473]	368
[3]	369
	370	!!=====================================================================
	371	END MODULE restart

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

Download in other formats: