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.

trcrst_fdir.h90 in trunk/NEMO/TOP_SRC – NEMO

Context Navigation

source: trunk/NEMO/TOP_SRC/trcrst_fdir.h90 @ 376

Last change on this file since 376 was 350, checked in by opalod, 18 years ago
nemo_v1_update_032:RB: update restart routines ; update control for cfc
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 7.7 KB

Line
1	SUBROUTINE trc_rst
2	!!===========================================================================================
3	!!
4	!! ROUTINE trc_rst
5	!! *******************
6	!!
7	!!------------------------------------------------------------------------
8	!! TOP 1.0, LOCEAN-IPSL (2005)
9	!! $Header$
10	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
11	!!----------------------------------------------------------------------
12
13	!! * Local declarations
14	INTEGER :: ino0,ino1,it0,it1,idast1,jn,iarak0,iarak1
15	INTEGER :: ibloc, ilglo
16	INTEGER :: inum ! temporary logical unit
17	REAL(wp),DIMENSION(jpi,jpj) :: zq
18	! open restart file
19	ibloc = 4096
20	ilglo = ibloc((jpiglojpjglo*jpbyt-1 )/ibloc+1)
21	CALL ctlopn(inum,'restarti.trc','OLD','UNFORMATTED','DIRECT', &
22	ilglo,numout,lwp,1)
23	! restart options
24	IF(nrsttr == 0) THEN
25	IF(lwp) WRITE(numout,*) ' nrsttr = 0 no control of nit000'
26	ELSE IF(nrsttr == 1) THEN
27	IF(lwp) WRITE(numout,*) ' nrsttr = 1 we control the date'
28	ELSE
29	IF(lwp) WRITE(numout,*) ' ===>>>> nrsttr not equal 0 or 1'
30	IF(lwp) WRITE(numout,*) ' ======= ======'
31	IF(lwp) WRITE(numout,*) ' we dont control the date'
32	ENDIF
33
34	! 0. initialisations
35	! ------------------
36
37	ino0 =no
38	it0 =nit000
39
40	IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
41	iarak0 = 1
42	ELSE
43	iarak0=0
44	ENDIF
45
46	IF(lwp) THEN
47	WRITE(numout,*) ' '
48	WRITE(numout,) ' ** trcrst beginning of restart for'
49	WRITE(numout,*) ' passive tracer'
50	WRITE(numout,*) ' the present run :'
51	WRITE(numout,*) ' number job is : ',no
52	WRITE(numout,*) ' with the time nit000 : ',nit000
53	IF(iarak0.eq.1) then
54	WRITE(numout,*) ' and before fields for Arakawa sheme '
55	ENDIF
56	WRITE(numout,*) ' '
57	ENDIF
58
59	! 1. READ
60	! -------
61
62	! 1.1 first record
63
64	READ(inum,REC=1) ino1,it1,iarak1
65
66	IF(lwp) THEN
67	WRITE(numout,*) ' '
68	WRITE(numout,*) ' READ nutrst with '
69	WRITE(numout,*) ' number job is : ',ino1
70	WRITE(numout,*) ' with the time it : ',it1
71	IF(iarak1.eq.1) then
72	WRITE(numout,*) ' and before fields for Arakawa sheme '
73	ENDIF
74	WRITE(numout,*) ' '
75	ENDIF
76
77	! 1.2 control of date
78
79	IF((it0-it1) /= 1 .AND. ABS(nrsttr) == 1) THEN
80	IF(lwp) THEN
81	WRITE(numout,*) ' ===>>>> : problem with nit000 for the', &
82	' passive tracer restart'
83	WRITE(numout,*) ' ======= ', &
84	' ======================'
85	WRITE(numout,*) ' we stop. verify the FILE'
86	WRITE(numout,*) ' or rerun with the value 0 for the'
87	WRITE(numout,*) ' control of time PARAMETER nrstdt'
88	WRITE(numout,*) ' '
89	ENDIF
90	STOP 'trc_rst'
91	ENDIF
92
93	! 1.3 Control of the sheme
94
95	IF (iarak0 /= iarak1) THEN
96	IF(lwp) THEN
97	WRITE(numout,*) ' ===>>>> : problem with the', &
98	' passive tracer restart file'
99	WRITE(numout,*) ' ======= ', &
100	' ==========================='
101	WRITE(numout,*) ' we stop. verify the FILE'
102	WRITE(numout,*) ' before field required IF 1=',iarak0
103	WRITE(numout,*) ' before field present in file IF 1=', &
104	iarak1
105	WRITE(numout,*) ' '
106	ENDIF
107	STOP 'trc_rst'
108	ENDIF
109
110
111	! 1.4 READ prognostic variables
112
113	DO jn=1,jptra
114	CALL read3(inum,trn(1,1,1,jn), jn + 1 )
115	END DO
116
117	DO jn=1,jptra
118	CALL read3(inum,trb(1,1,1,jn), jptra + jn + 1 )
119	END DO
120
121	#if defined key_trc_lobster1
122	CALL read2(inum,sedpocb(:,:),jpk,2*jptra+2)
123	CALL read2(inum,sedpocn(:,:),jpk,2*jptra+3)
124	#elif defined key_trc_pisces
125
126	CALL read2(inum,xksi(:,:),jpk,2*jptra+2)
127	xksimax(:,:)=xksi(:,:)
128
129	CALL read2(inum,sedcal(:,:),jpk,2*jptra+3)
130	CALL read2(inum,sedsil(:,:),jpk,2*jptra+4)
131	CALL read2(inum,sedpoc(:,:),jpk,2*jptra+5)
132
133	#elif defined key_cfc
134	DO jn=1,jptra
135	CALL read2(inum,zq(:,:),jpk,2*jptra+2)
136	qint(:,:,jn) = zq(:,:)
137	CALL read2(inum,zq(:,:),jpk,2*jptra+3)
138	qtr(:,:,jn)=zq(:,:)
139	ENDDO
140	#endif
141
142	#if defined key_trc_pisces
143
144
145	!! Initialization of chemical variables of the carbon cycle
146	!! --------------------------------------------------------
147
148	DO jk = 1,jpk
149	DO jj = 1,jpj
150	DO ji = 1,jpi
151	caralk = trn(ji,jj,jk,jptal)- &
152	& borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk)))
153	co3(ji,jj,jk)=(caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk) &
154	& +(1.-tmask(ji,jj,jk))*.5e-3
155	bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk)
156	hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3(ji,jj,jk)) &
157	& tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))1.e-9
158	h2co3(ji,jj) = 1.e-5
159	ENDDO
160	ENDDO
161	ENDDO
162	#endif
163
164	CLOSE( inum )
165
166	END SUBROUTINE trc_rst
167
168	SUBROUTINE trc_wri(kt)
169	!! ==================================================================================
170	!!
171	!! ROUTINE trc_wri
172	!! ******************
173	!!
174	!!========================================================================================!
175	!! * Arguments
176	!! -----------
177	INTEGER, INTENT( in ) :: kt
178
179	!! * Local declarations
180	INTEGER :: jn
181	INTEGER :: ino0,it0,iarak0
182	REAL(wp),DIMENSION(jpi,jpj) :: zq
183
184	IF( kt == nit000 ) THEN
185	IF(lwp) WRITE(numout,*)
186	IF(lwp) WRITE(numout,*) 'trc_wri : write restart.trc.output direct access file'
187	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
188	ibloc = 4096
189	ilglo = ibloc((jpiglojpjglo*jpbyt-1 )/ibloc+1)
190	CALL ctlopn( nutwrs,'restart.trc.output', 'UNKNOWN','UNFORMATTED','DIRECT', ilglo, numout, lwp, 1 )
191	ENDIF
192
193	IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
194
195	! 0. Initializations
196	! ------------------
197
198	IF(lwp) THEN
199	WRITE(numout,*) ' '
200	WRITE(numout,*) &
201	& ' trcwri: restart OUTPUT done in nutwrs = ',nutwrs &
202	& ,' at it= ',kt,' date= ',ndastp
203	WRITE(numout,*) ' -------'
204	ENDIF
205
206	ino0 =no
207	it0 =kt
208	IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
209	iarak0 = 1
210	ELSE
211	iarak0=0
212	ENDIF
213
214	! 1. Write in nutwrs
215	! ------------------
216
217	IF(lwp) WRITE(nutwrs,REC=1) & ! first record
218	ino0, it0, iarak0
219
220	DO jn=1,jptra
221	CALL write3(nutwrs,trn(1,1,1,jn), jn + 1 )
222	END DO
223
224	DO jn=1,jptra
225	CALL write3(nutwrs,trb(1,1,1,jn), jptra + jn + 1 )
226	END DO
227
228	#if defined key_trc_lobster1
229	CALL write2(nutwrs,sedpocb,jpk,2*jptra+2)
230	CALL write2(nutwrs,sedpocn,jpk,2*jptra+3)
231	#elif defined key_trc_pisces
232	CALL write2(nutwrs,xksi,jpk,2*jptra+2)
233
234	CALL write2(nutwrs,sedcal,jpk,2*jptra+3)
235	CALL write2(nutwrs,sedsil,jpk,2*jptra+4)
236	CALL write2(nutwrs,sedpoc,jpk,2*jptra+5)
237	#elif defined key_cfc
238	DO jn=1,jptra
239	zq(:,:)=qint(:,:,jn)
240	CALL write2(nutwrs,zq,jpk,2*jptra+2)
241	zq(:,:)=qtr(:,:,jn)
242	CALL write2(nutwrs,zq,jpk,2*jptra+3)
243	ENDDO
244	#endif
245	ENDIF
246
247	END SUBROUTINE trc_wri

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

Download in other formats:

Original Format