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_fdir.h90 in trunk/NEMO/OPA_SRC – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/restart_fdir.h90 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago
Initial revision
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 8.1 KB

Line
1	SUBROUTINE rst_write( kt )
2	!!---------------------------------------------------------------------
3	!! * ROUTINE rst_write *
4	!!
5	!! ** Purpose : Write restart fields in direct access format
6	!!
7	!! ** Method : restart.output file, each nstock time step , save
8	!! fields which are necessary for restart
9	!!
10	!! History :
11	!! ! 91-03 () original code
12	!! ! 91-11 (G. Madec)
13	!! ! 92-06 (M. Imbard) correction restart file
14	!! ! 92-07 (M. Imbard) split into diawri and rstwri
15	!! ! 98-02 (M. Guyon) FETI method
16	!! ! 98-05 (G. Roullet) free surface
17	!! ! 99-11 (M. Imbard) NetCDF FORMAT with ioipsl
18	!! 8.5 ! 02-08 (G. Madec) F90: Free form
19	!!----------------------------------------------------------------------
20	!! * Arguments
21	INTEGER, INTENT( in ) :: kt ! ocean time-step
22
23	!! * Local declarations
24	INTEGER :: ino0, it0, ipcg0, isor0, itke0
25	INTEGER :: ibloc, ilglo
26	!!----------------------------------------------------------------------
27	!! OPA 8.5, LODYC-IPSL (2002)
28	!!----------------------------------------------------------------------
29
30	IF( kt == nit000 ) THEN
31	IF(lwp) WRITE(numout,*)
32	IF(lwp) WRITE(numout,*) 'rst_write : write restart.output direct access file'
33	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
34	ibloc = 4096
35	ilglo = ibloc((jpiglojpjglo*jpbyt-1 )/ibloc+1)
36	CALL ctlopn( numwrs,'restart.output', 'UNKNOWN','UNFORMATTED','DIRECT', ilglo, numout, lwp, 1 )
37	ENDIF
38
39	IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
40
41	! 0. Initializations
42	! ------------------
43
44	IF(lwp) THEN
45	WRITE(numout,*) ' output done in numwrs = ', numwrs,' at it= ',kt,' date= ',ndastp
46	ENDIF
47
48	ino0 = no
49	it0 = kt
50	ipcg0 = 0
51	isor0 = 0
52	itke0 = 0
53	isor0 = nsolv - 1
54	ipcg0 = 2 - nsolv
55	IF( lk_zdftke ) itke0 = 1
56	! FETI method
57	IF (nsolv == 3) THEN
58	isor0 = 2
59	ipcg0 = 2
60	ENDIF
61
62	! 1. Write in numwrs
63	! ------------------
64
65	IF(lwp) WRITE(numwrs,REC=1) & ! first record
66	ino0, it0, isor0, ipcg0, itke0, ndastp
67	! ! prognostic variables
68	CALL write3(numwrs,ub ,2 ) ! before fields
69	CALL write3(numwrs,vb ,3 )
70	CALL write3(numwrs,tb ,5 )
71	CALL write3(numwrs,sb ,6 )
72	CALL write3(numwrs,rotb ,7 )
73	CALL write3(numwrs,hdivb,8 )
74	CALL write3(numwrs,un ,9 ) ! now fields
75	CALL write3(numwrs,vn ,10)
76	CALL write3(numwrs,tn ,12)
77	CALL write3(numwrs,sn ,13)
78	CALL write3(numwrs,rotn ,14)
79	CALL write3(numwrs,hdivn,15)
80	CALL write2(numwrs,gcx ,jpk,17) ! Read elliptic solver arrays
81	CALL write2(numwrs,gcxb,jpk,18)
82	#if defined key_dynspg_fsc
83	CALL write2(numwrs,sshb,jpk,4 ) ! free surface formulation (ssh)
84	CALL write2(numwrs,sshn,jpk,11)
85	#else
86	CALL write2(numwrs,bsfb,jpk,4 ) ! Rigid-lid formulation (bsf)
87	CALL write2(numwrs,bsfn,jpk,11)
88	CALL write2(numwrs,bsfd,jpk,16)
89	#endif
90	IF( lk_zdftke ) CALL write3(numwrs,en,19) ! TKE arrays
91	ENDIF
92
93	END SUBROUTINE rst_write
94
95
96	SUBROUTINE rst_read
97	!!----------------------------------------------------------------------
98	!! * ROUTINE rst_read *
99	!!
100	!!----------------------------------------------------------------------
101	!! * Local declarations
102	INTEGER :: ino0, it0, ipcg0, isor0, itke0
103	INTEGER :: ino1, it1, isor1, ipcg1, itke1, idast1
104	INTEGER :: ibloc, ilglo
105	INTEGER :: inum ! temporary logical unit
106	!!----------------------------------------------------------------------
107	!! OPA 8.5, LODYC-IPSL (2002)
108	!!----------------------------------------------------------------------
109
110	! open restart file
111	ibloc = 4096
112	ilglo = ibloc((jpiglojpjglo*jpbyt-1 )/ibloc+1)
113	CALL ctlopn(inum,'restart','OLD','UNFORMATTED','DIRECT', &
114	ilglo,numout,lwp,1)
115	! restart options
116	IF(nrstdt == 0) THEN
117	IF(lwp) WRITE(numout,*) ' nrstdt = 0 no control of nit000'
118	ELSE IF(nrstdt == 1) THEN
119	IF(lwp) WRITE(numout,*) ' nrstdt = 1 we control the date'
120	ELSE
121	IF(lwp) WRITE(numout,*) ' ===>>>> nrstdt not equal 0 or 1'
122	IF(lwp) WRITE(numout,*) ' ======= ======'
123	IF(lwp) WRITE(numout,*) ' we dont control the date'
124	ENDIF
125
126
127	! 0. Initialisations
128	! ------------------
129
130	ino0 = no
131	it0 = nit000
132	ipcg0 = 0
133	isor0 = 0
134	itke0 = 0
135	isor0 = nsolv-1
136	ipcg0 = 2-nsolv
137	IF( lk_zdftke ) itke0 = 1
138	! FETI method
139	IF( nsolv == 3 ) THEN
140	isor0=2
141	ipcg0=2
142	ENDIF
143
144	IF(lwp) THEN
145	WRITE(numout,*)
146	WRITE(numout,) ' ** dtrlec: beginning of restart'
147	WRITE(numout,*) ' '
148	WRITE(numout,*) ' the present run :'
149	WRITE(numout,*) ' job number : ', no
150	WRITE(numout,*) ' with nit000 : ', nit000
151	WRITE(numout,*) ' with pcg option ipcg0 : ', ipcg0
152	WRITE(numout,*) ' with sor option isor0 : ', isor0
153	WRITE(numout,*) ' with FETI solver option ipcg0 & isor0 : ', ipcg0,' & ',isor0
154	WRITE(numout,*) ' with tke option itke0 : ', itke0
155	ENDIF
156
157	! 1. Read inum
158	! --------------
159
160	! First record
161
162	READ(inum,REC=1) ino1, it1, isor1, ipcg1, itke1, idast1
163
164	IF(lwp) THEN
165	WRITE(numout,*)
166	WRITE(numout,*) ' READ inum with '
167	WRITE(numout,*) ' job number : ', ino1
168	WRITE(numout,*) ' with time step it : ', it1
169	WRITE(numout,*) ' with pcg option ipcg1 : ', ipcg1
170	WRITE(numout,*) ' with sor option isor1 : ', isor1
171	WRITE(numout,*) ' with tke option itke1 : ', itke1
172	WRITE(numout,*) ' with FETI solver option ipcg1 + isor1 : ', ipcg1 + isor1
173	WRITE(numout,*)
174	ENDIF
175
176	! Control of date
177
178	IF( (it0-it1) /= 1 .AND. ABS(nrstdt) == 1 ) THEN
179	IF(lwp) THEN
180	WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
181	WRITE(numout,*) ' ======= ======='
182	WRITE(numout,*) ' we stop. verify the file'
183	WRITE(numout,*) ' or rerun with the value 0 for the'
184	WRITE(numout,*) ' control of time parameter nrstdt'
185	WRITE(numout,*)
186	ENDIF
187	STOP 'dtrlec'
188	ENDIF
189
190	CALL read3(inum,ub ,2 ) ! Read prognostic variables
191	CALL read3(inum,vb ,3 )
192	CALL read3(inum,tb ,5 )
193	CALL read3(inum,sb ,6 )
194	CALL read3(inum,rotb ,7 )
195	CALL read3(inum,hdivb,8 )
196	CALL read3(inum,un ,9 )
197	CALL read3(inum,vn ,10)
198	CALL read3(inum,tn ,12)
199	CALL read3(inum,sn ,13)
200	CALL read3(inum,rotn ,14)
201	CALL read3(inum,hdivn,15)
202
203	CALL read2(inum,gcx ,jpk,17) ! Read elliptic solver arrays
204	CALL read2(inum,gcxb,jpk,18)
205
206	# if defined key_dynspg_fsc
207	CALL read2(inum,sshb ,jpk,4 ) ! free surface formulation (ssh)
208	CALL read2(inum,sshn ,jpk,11)
209	# else
210	CALL read2(inum,bsfb ,jpk,4 ) ! Rigid-lid formulation (bsf)
211	CALL read2(inum,bsfn ,jpk,11)
212	CALL read2(inum,bsfd ,jpk,16)
213	# endif
214
215	IF( lk_zdftke ) THEN
216	IF( itke1 == 1 ) THEN ! Read tke arrays
217	CALL read3(inum,en,19)
218	ELSE
219	IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file didnot used tke scheme'
220	IF(lwp) WRITE(numout,*) ' ======= ======='
221	nrstdt = 2
222	ENDIF
223	ENDIF
224
225	CLOSE( inum )
226
227	END SUBROUTINE rst_read

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

Download in other formats:

Original Format