Context Navigation

iostart.F90 @ 3449

Last change on this file since 3449 was 3435, checked in by Laurent Fairhead, 5 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

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: 13.8 KB

Line
1	MODULE iostart
2
3	PRIVATE
4	INTEGER,SAVE :: nid_start
5	INTEGER,SAVE :: nid_restart
6
7	INTEGER,SAVE :: idim1,idim2,idim3,idim4
8	INTEGER,PARAMETER :: length=100
9
10	INTERFACE get_field
11	MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
12	END INTERFACE get_field
13
14	INTERFACE get_var
15	MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
16	END INTERFACE get_var
17
18	INTERFACE put_field
19	MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
20	END INTERFACE put_field
21
22	INTERFACE put_var
23	MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
24	END INTERFACE put_var
25
26	PUBLIC get_field,get_var,put_field,put_var
27	PUBLIC Open_startphy,close_startphy,open_restartphy,close_restartphy
28
29	CONTAINS
30
31	SUBROUTINE Open_startphy(filename)
32	USE netcdf
33	USE mod_phys_lmdz_para
34	IMPLICIT NONE
35	CHARACTER(LEN=*) :: filename
36	INTEGER :: ierr
37
38	IF (is_mpi_root .AND. is_omp_root) THEN
39	ierr = NF90_OPEN (filename, NF90_NOWRITE,nid_start)
40	IF (ierr.NE.NF90_NOERR) THEN
41	write(6,*)' Pb d''ouverture du fichier '//filename
42	write(6,*)' ierr = ', ierr
43	CALL abort_physic("", "", 1)
44	ENDIF
45	ENDIF
46
47	END SUBROUTINE Open_startphy
48
49	SUBROUTINE Close_startphy
50	USE netcdf
51	USE mod_phys_lmdz_para
52	IMPLICIT NONE
53	INTEGER :: ierr
54
55	IF (is_mpi_root .AND. is_omp_root) THEN
56	ierr = NF90_CLOSE (nid_start)
57	ENDIF
58
59	END SUBROUTINE close_startphy
60
61
62	FUNCTION Inquire_Field(Field_name)
63	USE netcdf
64	USE mod_phys_lmdz_para
65	IMPLICIT NONE
66	CHARACTER(LEN=*) :: Field_name
67	LOGICAL :: inquire_field
68	INTEGER :: varid
69	INTEGER :: ierr
70
71	IF (is_mpi_root .AND. is_omp_root) THEN
72	ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
73	IF (ierr==NF90_NOERR) THEN
74	Inquire_field=.TRUE.
75	ELSE
76	Inquire_field=.FALSE.
77	ENDIF
78	ENDIF
79
80	CALL bcast(Inquire_field)
81
82	END FUNCTION Inquire_Field
83
84
85	SUBROUTINE Get_Field_r1(field_name,field,found)
86	IMPLICIT NONE
87	CHARACTER(LEN=*),INTENT(IN) :: Field_name
88	REAL,INTENT(INOUT) :: Field(:)
89	LOGICAL,INTENT(OUT),OPTIONAL :: found
90
91	CALL Get_field_rgen(field_name,field,1,found)
92
93	END SUBROUTINE Get_Field_r1
94
95	SUBROUTINE Get_Field_r2(field_name,field,found)
96	IMPLICIT NONE
97	CHARACTER(LEN=*),INTENT(IN) :: Field_name
98	REAL,INTENT(INOUT) :: Field(:,:)
99	LOGICAL,INTENT(OUT),OPTIONAL :: found
100
101	CALL Get_field_rgen(field_name,field,size(field,2),found)
102
103
104	END SUBROUTINE Get_Field_r2
105
106	SUBROUTINE Get_Field_r3(field_name,field,found)
107	IMPLICIT NONE
108	CHARACTER(LEN=*),INTENT(IN) :: Field_name
109	REAL,INTENT(INOUT) :: Field(:,:,:)
110	LOGICAL,INTENT(OUT),OPTIONAL :: found
111
112	CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),found)
113
114	END SUBROUTINE Get_Field_r3
115
116	SUBROUTINE Get_field_rgen(field_name,field,field_size,found)
117	USE netcdf
118	USE dimphy
119	USE geometry_mod
120	USE mod_grid_phy_lmdz
121	USE mod_phys_lmdz_para
122	IMPLICIT NONE
123	CHARACTER(LEN=*) :: Field_name
124	INTEGER :: field_size
125	REAL :: field(klon,field_size)
126	LOGICAL,OPTIONAL :: found
127
128	REAL :: field_glo(klon_glo,field_size)
129	REAL :: field_glo_tmp(klon_glo,field_size)
130	INTEGER :: ind_cell_glo_glo(klon_glo)
131	LOGICAL :: tmp_found
132	INTEGER :: varid
133	INTEGER :: ierr,i
134
135	! IF (is_master) ALLOCATE(ind_cell_glo_glo(1:klon_glo))
136	CALL gather(ind_cell_glo,ind_cell_glo_glo)
137
138	IF (is_master) THEN
139
140	ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
141
142	IF (ierr==NF90_NOERR) THEN
143	CALL body(field_glo_tmp)
144	tmp_found=.TRUE.
145	ELSE
146	tmp_found=.FALSE.
147	ENDIF
148
149	ENDIF
150
151	CALL bcast(tmp_found)
152
153	IF (tmp_found) THEN
154	IF (is_master) THEN
155	DO i=1,klon_glo
156	field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:)
157	ENDDO
158	ENDIF
159	CALL scatter(field_glo,field)
160	ENDIF
161
162	IF (PRESENT(found)) THEN
163	found=tmp_found
164	ELSE
165	IF (.NOT. tmp_found) THEN
166	PRINT*, 'phyetat0: Le champ <'//field_name//'> est absent'
167	call abort_physic("", "", 1)
168	ENDIF
169	ENDIF
170
171
172	CONTAINS
173
174	SUBROUTINE body(field_glo)
175	REAL :: field_glo(klon_glo*field_size)
176	ierr=NF90_GET_VAR(nid_start,varid,field_glo)
177	IF (ierr/=NF90_NOERR) THEN
178	! La variable exist dans le fichier mais la lecture a echouee.
179	PRINT*, 'phyetat0: Lecture echouee pour <'//field_name//'>'
180
181	IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
182	! Essaye de lire le variable sur surface uniqument, comme fait avant
183	field_glo(:)=0.
184	ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
185	IF (ierr/=NF90_NOERR) THEN
186	PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
187	call abort_physic("", "", 1)
188	ELSE
189	PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
190	END IF
191	ELSE
192	call abort_physic("", "", 1)
193	ENDIF
194	ENDIF
195
196	END SUBROUTINE body
197
198	END SUBROUTINE Get_field_rgen
199
200
201	SUBROUTINE get_var_r0(var_name,var,found)
202	IMPLICIT NONE
203	CHARACTER(LEN=*),INTENT(IN) :: var_name
204	REAL,INTENT(INOUT) :: var
205	LOGICAL,OPTIONAL,INTENT(OUT) :: found
206
207	REAL :: varout(1)
208
209	CALL Get_var_rgen(var_name,varout,size(varout),found)
210	var=varout(1)
211
212	END SUBROUTINE get_var_r0
213
214	SUBROUTINE get_var_r1(var_name,var,found)
215	IMPLICIT NONE
216	CHARACTER(LEN=*),INTENT(IN) :: var_name
217	REAL,INTENT(INOUT) :: var(:)
218	LOGICAL,OPTIONAL,INTENT(OUT) :: found
219
220	CALL Get_var_rgen(var_name,var,size(var),found)
221
222	END SUBROUTINE get_var_r1
223
224	SUBROUTINE get_var_r2(var_name,var,found)
225	IMPLICIT NONE
226	CHARACTER(LEN=*),INTENT(IN) :: var_name
227	REAL,INTENT(OUT) :: var(:,:)
228	LOGICAL,OPTIONAL,INTENT(OUT) :: found
229
230	CALL Get_var_rgen(var_name,var,size(var),found)
231
232	END SUBROUTINE get_var_r2
233
234	SUBROUTINE get_var_r3(var_name,var,found)
235	IMPLICIT NONE
236	CHARACTER(LEN=*),INTENT(IN) :: var_name
237	REAL,INTENT(INOUT) :: var(:,:,:)
238	LOGICAL,OPTIONAL,INTENT(OUT) :: found
239
240	CALL Get_var_rgen(var_name,var,size(var),found)
241
242	END SUBROUTINE get_var_r3
243
244	SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
245	USE netcdf
246	USE dimphy
247	USE mod_grid_phy_lmdz
248	USE mod_phys_lmdz_para
249	IMPLICIT NONE
250	CHARACTER(LEN=*) :: var_name
251	INTEGER :: var_size
252	REAL :: var(var_size)
253	LOGICAL,OPTIONAL :: found
254
255	LOGICAL :: tmp_found
256	INTEGER :: varid
257	INTEGER :: ierr
258
259	IF (is_mpi_root .AND. is_omp_root) THEN
260
261	ierr=NF90_INQ_VARID(nid_start,var_name,varid)
262
263	IF (ierr==NF90_NOERR) THEN
264	ierr=NF90_GET_VAR(nid_start,varid,var)
265	IF (ierr/=NF90_NOERR) THEN
266	PRINT*, 'phyetat0: Lecture echouee pour <'//var_name//'>'
267	call abort_physic("", "", 1)
268	ENDIF
269	tmp_found=.TRUE.
270	ELSE
271	tmp_found=.FALSE.
272	ENDIF
273
274	ENDIF
275
276	CALL bcast(tmp_found)
277
278	IF (tmp_found) THEN
279	CALL bcast(var)
280	ENDIF
281
282	IF (PRESENT(found)) THEN
283	found=tmp_found
284	ELSE
285	IF (.NOT. tmp_found) THEN
286	PRINT*, 'phyetat0: La variable champ <'//var_name//'> est absente'
287	call abort_physic("", "", 1)
288	ENDIF
289	ENDIF
290
291	END SUBROUTINE Get_var_rgen
292
293
294	SUBROUTINE open_restartphy(filename)
295	USE netcdf
296	USE mod_phys_lmdz_para, ONLY: is_master
297	USE mod_grid_phy_lmdz, ONLY: klon_glo
298	USE dimphy, ONLY: klev, klevp1
299	USE print_control_mod, ONLY: lunout
300	IMPLICIT NONE
301	CHARACTER(LEN=*),INTENT(IN) :: filename
302	INTEGER :: ierr
303
304	IF (is_master) THEN
305	ierr = NF90_CREATE(filename, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
306	nid_restart)
307	IF (ierr/=NF90_NOERR) THEN
308	write(lunout,*)'open_restartphy: problem creating file '//trim(filename)
309	write(lunout,*)trim(nf90_strerror(ierr))
310	CALL abort_physic("open_restartphy", trim(nf90_strerror(ierr)), 1)
311	ENDIF
312
313	ierr = NF90_PUT_ATT (nid_restart, NF90_GLOBAL, "title","Fichier redemmarage physique")
314
315	ierr = NF90_DEF_DIM (nid_restart, "index", length, idim1)
316	ierr = NF90_DEF_DIM (nid_restart, "points_physiques", klon_glo, idim2)
317	ierr = NF90_DEF_DIM (nid_restart, "horizon_vertical", klon_glo*klev, idim3)
318	ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)
319
320	ierr = NF90_ENDDEF(nid_restart)
321	ENDIF
322
323	END SUBROUTINE open_restartphy
324
325	SUBROUTINE close_restartphy
326	USE netcdf
327	USE mod_phys_lmdz_para
328	IMPLICIT NONE
329	INTEGER :: ierr
330
331	IF (is_mpi_root .AND. is_omp_root) THEN
332	ierr = NF90_CLOSE (nid_restart)
333	ENDIF
334
335	END SUBROUTINE close_restartphy
336
337
338	SUBROUTINE put_field_r1(field_name,title,field)
339	IMPLICIT NONE
340	CHARACTER(LEN=*),INTENT(IN) :: field_name
341	CHARACTER(LEN=*),INTENT(IN) :: title
342	REAL,INTENT(IN) :: field(:)
343
344	CALL put_field_rgen(field_name,title,field,1)
345
346	END SUBROUTINE put_field_r1
347
348	SUBROUTINE put_field_r2(field_name,title,field)
349	IMPLICIT NONE
350	CHARACTER(LEN=*),INTENT(IN) :: field_name
351	CHARACTER(LEN=*),INTENT(IN) :: title
352	REAL,INTENT(IN) :: field(:,:)
353
354	CALL put_field_rgen(field_name,title,field,size(field,2))
355
356	END SUBROUTINE put_field_r2
357
358	SUBROUTINE put_field_r3(field_name,title,field)
359	IMPLICIT NONE
360	CHARACTER(LEN=*),INTENT(IN) :: field_name
361	CHARACTER(LEN=*),INTENT(IN) :: title
362	REAL,INTENT(IN) :: field(:,:,:)
363
364	CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
365
366	END SUBROUTINE put_field_r3
367
368	SUBROUTINE put_field_rgen(field_name,title,field,field_size)
369	USE netcdf
370	USE dimphy
371	USE geometry_mod
372	USE mod_grid_phy_lmdz
373	USE mod_phys_lmdz_para
374	IMPLICIT NONE
375	CHARACTER(LEN=*),INTENT(IN) :: field_name
376	CHARACTER(LEN=*),INTENT(IN) :: title
377	INTEGER,INTENT(IN) :: field_size
378	REAL,INTENT(IN) :: field(klon,field_size)
379
380	REAL :: field_glo(klon_glo,field_size)
381	REAL :: field_glo_tmp(klon_glo,field_size)
382	! INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:)
383	INTEGER :: ind_cell_glo_glo(klon_glo)
384	INTEGER :: ierr,i
385	INTEGER :: nvarid
386	INTEGER :: idim
387
388
389	! IF (is_master) ALLOCATE(ind_cell_glo_glo(klon_glo))
390	CALL gather(ind_cell_glo,ind_cell_glo_glo)
391
392	CALL gather(field,field_glo_tmp)
393
394	IF (is_master) THEN
395
396	DO i=1,klon_glo
397	field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:)
398	ENDDO
399
400
401	IF (field_size==1) THEN
402	idim=idim2
403	ELSE IF (field_size==klev) THEN
404	idim=idim3
405	ELSE IF (field_size==klevp1) THEN
406	idim=idim4
407	ELSE
408	PRINT *, "erreur phyredem : probleme de dimension"
409	CALL abort_physic("", "", 1)
410	ENDIF
411
412	ierr = NF90_REDEF (nid_restart)
413	#ifdef NC_DOUBLE
414	ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
415	#else
416	ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid)
417	#endif
418	IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
419	ierr = NF90_ENDDEF(nid_restart)
420	ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
421	ENDIF
422
423	END SUBROUTINE put_field_rgen
424
425	SUBROUTINE put_var_r0(var_name,title,var)
426	IMPLICIT NONE
427	CHARACTER(LEN=*),INTENT(IN) :: var_name
428	CHARACTER(LEN=*),INTENT(IN) :: title
429	REAL,INTENT(IN) :: var
430	REAL :: varin(1)
431
432	varin(1)=var
433
434	CALL put_var_rgen(var_name,title,varin,size(varin))
435
436	END SUBROUTINE put_var_r0
437
438
439	SUBROUTINE put_var_r1(var_name,title,var)
440	IMPLICIT NONE
441	CHARACTER(LEN=*),INTENT(IN) :: var_name
442	CHARACTER(LEN=*),INTENT(IN) :: title
443	REAL,INTENT(IN) :: var(:)
444
445	CALL put_var_rgen(var_name,title,var,size(var))
446
447	END SUBROUTINE put_var_r1
448
449	SUBROUTINE put_var_r2(var_name,title,var)
450	IMPLICIT NONE
451	CHARACTER(LEN=*),INTENT(IN) :: var_name
452	CHARACTER(LEN=*),INTENT(IN) :: title
453	REAL,INTENT(IN) :: var(:,:)
454
455	CALL put_var_rgen(var_name,title,var,size(var))
456
457	END SUBROUTINE put_var_r2
458
459	SUBROUTINE put_var_r3(var_name,title,var)
460	IMPLICIT NONE
461	CHARACTER(LEN=*),INTENT(IN) :: var_name
462	CHARACTER(LEN=*),INTENT(IN) :: title
463	REAL,INTENT(IN) :: var(:,:,:)
464
465	CALL put_var_rgen(var_name,title,var,size(var))
466
467	END SUBROUTINE put_var_r3
468
469	SUBROUTINE put_var_rgen(var_name,title,var,var_size)
470	USE netcdf
471	USE dimphy
472	USE mod_phys_lmdz_para
473	IMPLICIT NONE
474	CHARACTER(LEN=*),INTENT(IN) :: var_name
475	CHARACTER(LEN=*),INTENT(IN) :: title
476	INTEGER,INTENT(IN) :: var_size
477	REAL,INTENT(IN) :: var(var_size)
478
479	INTEGER :: ierr
480	INTEGER :: nvarid
481
482	IF (is_mpi_root .AND. is_omp_root) THEN
483
484	IF (var_size/=length) THEN
485	PRINT *, "erreur phyredem : probleme de dimension"
486	call abort_physic("", "", 1)
487	ENDIF
488
489	ierr = NF90_REDEF (nid_restart)
490
491	#ifdef NC_DOUBLE
492	ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
493	#else
494	ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
495	#endif
496	IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
497	ierr = NF90_ENDDEF(nid_restart)
498
499	ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
500
501	ENDIF
502
503	END SUBROUTINE put_var_rgen
504
505	END MODULE iostart

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

Download in other formats:

Original Format