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

Last change on this file since 336 was 335, checked in by opalod, 19 years ago
nemo_v1_update_023 : CE + RB + CT : new evolution of modules
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 7.6 KB

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

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

Download in other formats:

Original Format