Context Navigation

dynetat0.F @ 2597

Last change on this file since 2597 was 2597, checked in by Ehouarn Millour, 8 years ago
Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod. EM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 11.2 KB

Line
1	!
2	! $Id $
3	!
4	SUBROUTINE dynetat0(fichnom,vcov,ucov,
5	. teta,q,masse,ps,phis,time)
6
7	USE infotrac
8	use netcdf, only: nf90_get_var
9
10	use control_mod, only : planet_type
11	USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa,
12	& lllm, omeg, rad
13
14	IMPLICIT NONE
15
16	c=======================================================================
17	c
18	c Auteur: P. Le Van / L.Fairhead
19	c -------
20	c
21	c objet:
22	c ------
23	c
24	c Lecture de l'etat initial
25	c
26	c=======================================================================
27	c-----------------------------------------------------------------------
28	c Declarations:
29	c -------------
30
31	#include "dimensions.h"
32	#include "paramet.h"
33	#include "temps.h"
34	#include "comvert.h"
35	#include "comgeom2.h"
36	#include "ener.h"
37	#include "netcdf.inc"
38	#include "description.h"
39	#include "serre.h"
40	#include "logic.h"
41	#include "iniprint.h"
42
43	c Arguments:
44	c ----------
45
46	CHARACTER() fichnom
47	REAL vcov(iip1, jjm,llm),ucov(iip1, jjp1,llm),teta(iip1, jjp1,llm)
48	REAL q(iip1,jjp1,llm,nqtot),masse(iip1, jjp1,llm)
49	REAL ps(iip1, jjp1),phis(iip1, jjp1)
50
51	REAL time
52
53	c Variables
54	c
55	INTEGER length,iq
56	PARAMETER (length = 100)
57	REAL tab_cntrl(length) ! tableau des parametres du run
58	INTEGER ierr, nid, nvarid
59
60	INTEGER idecal
61
62	c-----------------------------------------------------------------------
63
64	c Ouverture NetCDF du fichier etat initial
65
66	ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
67	IF (ierr.NE.NF_NOERR) THEN
68	write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
69	write(lunout,*)' ierr = ', ierr
70	CALL ABORT_gcm("dynetat0", "", 1)
71	ENDIF
72
73	c
74	ierr = NF_INQ_VARID (nid, "controle", nvarid)
75	IF (ierr .NE. NF_NOERR) THEN
76	write(lunout,*)"dynetat0: Le champ <controle> est absent"
77	CALL ABORT_gcm("dynetat0", "", 1)
78	ENDIF
79	ierr = nf90_get_var(nid, nvarid, tab_cntrl)
80	IF (ierr .NE. NF_NOERR) THEN
81	write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
82	CALL ABORT_gcm("dynetat0", "", 1)
83	ENDIF
84
85	!!! AS: idecal is a hack to be able to read planeto starts...
86	!!! .... while keeping everything OK for LMDZ EARTH
87	if (planet_type.eq."generic") then
88	print*,'NOTE NOTE NOTE : Planeto-like start files'
89	idecal = 4
90	annee_ref = 2000
91	else
92	print*,'NOTE NOTE NOTE : Earth-like start files'
93	idecal = 5
94	annee_ref = tab_cntrl(5)
95	endif
96
97
98	im = tab_cntrl(1)
99	jm = tab_cntrl(2)
100	lllm = tab_cntrl(3)
101	day_ref = tab_cntrl(4)
102	rad = tab_cntrl(idecal+1)
103	omeg = tab_cntrl(idecal+2)
104	g = tab_cntrl(idecal+3)
105	cpp = tab_cntrl(idecal+4)
106	kappa = tab_cntrl(idecal+5)
107	daysec = tab_cntrl(idecal+6)
108	dtvr = tab_cntrl(idecal+7)
109	etot0 = tab_cntrl(idecal+8)
110	ptot0 = tab_cntrl(idecal+9)
111	ztot0 = tab_cntrl(idecal+10)
112	stot0 = tab_cntrl(idecal+11)
113	ang0 = tab_cntrl(idecal+12)
114	pa = tab_cntrl(idecal+13)
115	preff = tab_cntrl(idecal+14)
116	c
117	clon = tab_cntrl(idecal+15)
118	clat = tab_cntrl(idecal+16)
119	grossismx = tab_cntrl(idecal+17)
120	grossismy = tab_cntrl(idecal+18)
121	c
122	IF ( tab_cntrl(idecal+19).EQ.1. ) THEN
123	fxyhypb = . TRUE .
124	c dzoomx = tab_cntrl(25)
125	c dzoomy = tab_cntrl(26)
126	c taux = tab_cntrl(28)
127	c tauy = tab_cntrl(29)
128	ELSE
129	fxyhypb = . FALSE .
130	ysinus = . FALSE .
131	IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
132	ENDIF
133
134	day_ini = tab_cntrl(30)
135	itau_dyn = tab_cntrl(31)
136	start_time = tab_cntrl(32)
137	c .................................................................
138	c
139	c
140	write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
141	& rad,omeg,g,cpp,kappa
142
143	IF( im.ne.iim ) THEN
144	PRINT 1,im,iim
145	STOP
146	ELSE IF( jm.ne.jjm ) THEN
147	PRINT 2,jm,jjm
148	STOP
149	ELSE IF( lllm.ne.llm ) THEN
150	PRINT 3,lllm,llm
151	STOP
152	ENDIF
153
154	ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
155	IF (ierr .NE. NF_NOERR) THEN
156	write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
157	CALL ABORT_gcm("dynetat0", "", 1)
158	ENDIF
159	ierr = nf90_get_var(nid, nvarid, rlonu)
160	IF (ierr .NE. NF_NOERR) THEN
161	write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
162	CALL ABORT_gcm("dynetat0", "", 1)
163	ENDIF
164
165	ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
166	IF (ierr .NE. NF_NOERR) THEN
167	write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
168	CALL ABORT_gcm("dynetat0", "", 1)
169	ENDIF
170	ierr = nf90_get_var(nid, nvarid, rlatu)
171	IF (ierr .NE. NF_NOERR) THEN
172	write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
173	CALL ABORT_gcm("dynetat0", "", 1)
174	ENDIF
175
176	ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
177	IF (ierr .NE. NF_NOERR) THEN
178	write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
179	CALL ABORT_gcm("dynetat0", "", 1)
180	ENDIF
181	ierr = nf90_get_var(nid, nvarid, rlonv)
182	IF (ierr .NE. NF_NOERR) THEN
183	write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
184	CALL ABORT_gcm("dynetat0", "", 1)
185	ENDIF
186
187	ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
188	IF (ierr .NE. NF_NOERR) THEN
189	write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
190	CALL ABORT_gcm("dynetat0", "", 1)
191	ENDIF
192	ierr = nf90_get_var(nid, nvarid, rlatv)
193	IF (ierr .NE. NF_NOERR) THEN
194	write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
195	CALL ABORT_gcm("dynetat0", "", 1)
196	ENDIF
197
198	ierr = NF_INQ_VARID (nid, "cu", nvarid)
199	IF (ierr .NE. NF_NOERR) THEN
200	write(lunout,*)"dynetat0: Le champ <cu> est absent"
201	CALL ABORT_gcm("dynetat0", "", 1)
202	ENDIF
203	ierr = nf90_get_var(nid, nvarid, cu)
204	IF (ierr .NE. NF_NOERR) THEN
205	write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
206	CALL ABORT_gcm("dynetat0", "", 1)
207	ENDIF
208
209	ierr = NF_INQ_VARID (nid, "cv", nvarid)
210	IF (ierr .NE. NF_NOERR) THEN
211	write(lunout,*)"dynetat0: Le champ <cv> est absent"
212	CALL ABORT_gcm("dynetat0", "", 1)
213	ENDIF
214	ierr = nf90_get_var(nid, nvarid, cv)
215	IF (ierr .NE. NF_NOERR) THEN
216	write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
217	CALL ABORT_gcm("dynetat0", "", 1)
218	ENDIF
219
220	ierr = NF_INQ_VARID (nid, "aire", nvarid)
221	IF (ierr .NE. NF_NOERR) THEN
222	write(lunout,*)"dynetat0: Le champ <aire> est absent"
223	CALL ABORT_gcm("dynetat0", "", 1)
224	ENDIF
225	ierr = nf90_get_var(nid, nvarid, aire)
226	IF (ierr .NE. NF_NOERR) THEN
227	write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
228	CALL ABORT_gcm("dynetat0", "", 1)
229	ENDIF
230
231	ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
232	IF (ierr .NE. NF_NOERR) THEN
233	write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
234	CALL ABORT_gcm("dynetat0", "", 1)
235	ENDIF
236	ierr = nf90_get_var(nid, nvarid, phis)
237	IF (ierr .NE. NF_NOERR) THEN
238	write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
239	CALL ABORT_gcm("dynetat0", "", 1)
240	ENDIF
241
242	ierr = NF_INQ_VARID (nid, "temps", nvarid)
243	IF (ierr .NE. NF_NOERR) THEN
244	write(lunout,*)"dynetat0: Le champ <temps> est absent"
245	write(lunout,*)"dynetat0: J essaie <Time>"
246	ierr = NF_INQ_VARID (nid, "Time", nvarid)
247	IF (ierr .NE. NF_NOERR) THEN
248	write(lunout,*)"dynetat0: Le champ <Time> est absent"
249	CALL ABORT_gcm("dynetat0", "", 1)
250	ENDIF
251	ENDIF
252	ierr = nf90_get_var(nid, nvarid, time)
253	IF (ierr .NE. NF_NOERR) THEN
254	write(lunout,*)"dynetat0: Lecture echouee <temps>"
255	CALL ABORT_gcm("dynetat0", "", 1)
256	ENDIF
257
258	ierr = NF_INQ_VARID (nid, "ucov", nvarid)
259	IF (ierr .NE. NF_NOERR) THEN
260	write(lunout,*)"dynetat0: Le champ <ucov> est absent"
261	CALL ABORT_gcm("dynetat0", "", 1)
262	ENDIF
263	ierr = nf90_get_var(nid, nvarid, ucov)
264	IF (ierr .NE. NF_NOERR) THEN
265	write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
266	CALL ABORT_gcm("dynetat0", "", 1)
267	ENDIF
268
269	ierr = NF_INQ_VARID (nid, "vcov", nvarid)
270	IF (ierr .NE. NF_NOERR) THEN
271	write(lunout,*)"dynetat0: Le champ <vcov> est absent"
272	CALL ABORT_gcm("dynetat0", "", 1)
273	ENDIF
274	ierr = nf90_get_var(nid, nvarid, vcov)
275	IF (ierr .NE. NF_NOERR) THEN
276	write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
277	CALL ABORT_gcm("dynetat0", "", 1)
278	ENDIF
279
280	ierr = NF_INQ_VARID (nid, "teta", nvarid)
281	IF (ierr .NE. NF_NOERR) THEN
282	write(lunout,*)"dynetat0: Le champ <teta> est absent"
283	CALL ABORT_gcm("dynetat0", "", 1)
284	ENDIF
285	ierr = nf90_get_var(nid, nvarid, teta)
286	IF (ierr .NE. NF_NOERR) THEN
287	write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
288	CALL ABORT_gcm("dynetat0", "", 1)
289	ENDIF
290
291
292	IF(nqtot.GE.1) THEN
293	DO iq=1,nqtot
294	ierr = NF_INQ_VARID (nid, tname(iq), nvarid)
295	IF (ierr .NE. NF_NOERR) THEN
296	write(lunout,*)"dynetat0: Le traceur <"//trim(tname(iq))//
297	& "> est absent"
298	write(lunout,*)" Il est donc initialise a zero"
299	q(:,:,:,iq)=0.
300	ELSE
301	ierr = NF90_GET_VAR(nid, nvarid, q(:,:,:,iq))
302	IF (ierr .NE. NF_NOERR) THEN
303	write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
304	CALL ABORT_gcm("dynetat0", "", 1)
305	ENDIF
306	ENDIF
307	ENDDO
308	ENDIF
309
310	ierr = NF_INQ_VARID (nid, "masse", nvarid)
311	IF (ierr .NE. NF_NOERR) THEN
312	write(lunout,*)"dynetat0: Le champ <masse> est absent"
313	CALL ABORT_gcm("dynetat0", "", 1)
314	ENDIF
315	ierr = nf90_get_var(nid, nvarid, masse)
316	IF (ierr .NE. NF_NOERR) THEN
317	write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
318	CALL ABORT_gcm("dynetat0", "", 1)
319	ENDIF
320
321	ierr = NF_INQ_VARID (nid, "ps", nvarid)
322	IF (ierr .NE. NF_NOERR) THEN
323	write(lunout,*)"dynetat0: Le champ <ps> est absent"
324	CALL ABORT_gcm("dynetat0", "", 1)
325	ENDIF
326	ierr = nf90_get_var(nid, nvarid, ps)
327	IF (ierr .NE. NF_NOERR) THEN
328	write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
329	CALL ABORT_gcm("dynetat0", "", 1)
330	ENDIF
331
332	ierr = NF_CLOSE(nid)
333
334	day_ini=day_ini+INT(time)
335	time=time-INT(time)
336
337	1 FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
338	*arrage est differente de la valeur parametree iim =',i4//)
339	2 FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
340	*arrage est differente de la valeur parametree jjm =',i4//)
341	3 FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
342	*rrage est differente de la valeur parametree llm =',i4//)
343	4 FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
344	*rrage est differente de la valeur dtinteg =',i4//)
345
346	RETURN
347	END

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

Download in other formats:

Original Format