Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

restart.f90

Last change on this file was 899, checked in by adurocher, 5 years ago

trunk : Fixed GCC warnings

Fixed iso c bindings
fixed warnings with -Wall -Wno-aliasing -Wno-unused -Wno-unused-dummy-argument -Wno-maybe-uninitialized -Wno-tabs warnings
Removed all unused variables (-Wunused-variable)
vector%dot_product is now dot_product_3d to avoid compilation warning "dot_product shadows intrinsic" with GCC

File size: 28.8 KB

Line
1	MODULE restart_mod
2	USE field_mod
3
4	TYPE t_field_array
5	TYPE(t_field),POINTER :: field(:)
6	END TYPE t_field_array
7
8	LOGICAL,SAVE :: write_start=.TRUE.
9
10	CONTAINS
11
12	SUBROUTINE init_restart
13	USE xios_mod
14	USE icosa
15	USE time_mod
16	USE omp_para
17	IMPLICIT NONE
18	CHARACTER(LEN=255) :: start_file_name
19	CHARACTER(LEN=255) :: restart_file_name
20
21	IF (using_xios) THEN
22	start_file_name="start"
23	CALL getin("start_file_name",start_file_name)
24	restart_file_name="restart"
25	CALL getin("restart_file_name",restart_file_name)
26	IF (is_omp_master) THEN
27	! CALL xios_set_file_attr("start",name=TRIM(ADJUSTL(start_file_name)),output_freq=(itaumax+1)*xios_timestep)
28	CALL xios_set_file_attr("start",name=TRIM(ADJUSTL(start_file_name)),output_freq=1*xios_timestep)
29	CALL xios_set_file_attr("restart",name=TRIM(ADJUSTL(restart_file_name)),output_freq=itaumax*xios_timestep)
30	CALL xios_set_fieldgroup_attr("group_restart", freq_op=itaumax*xios_timestep)
31	ENDIF
32	ENDIF
33
34	END SUBROUTINE init_restart
35
36
37	SUBROUTINE write_restart(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9, &
38	field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
39	USE prec
40	USE metric
41	USE field_mod
42	USE domain_mod
43	USE netcdf_mod
44	USE mpipara
45	USE omp_para
46	USE getin_mod
47	USE spherical_geom_mod
48	USE transfert_mod
49	USE disvert_mod
50	USE xios_mod
51	IMPLICIT NONE
52	INTEGER,INTENT(IN) :: it
53
54	TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
55	TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
56
57	TYPE(t_field_array) :: field_array(20)
58	INTEGER :: nfield
59	INTEGER :: fieldId(20)
60
61	TYPE(t_domain),POINTER :: d
62	TYPE(t_field),POINTER :: field(:)
63
64	CHARACTER(LEN=255) :: file_name
65	CHARACTER(LEN=255) :: suffix
66	INTEGER,PARAMETER :: nvert=6
67	INTEGER :: ncid, cellId, levId, edgeId, vertid, lonId, latId, bounds_lonId, bounds_latId, nqId, levAxisId
68	INTEGER :: ind,ind_glo,i,j,k,nf
69	INTEGER :: status
70	REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
71
72	IF (no_io) RETURN
73
74	IF (it==0) THEN
75	file_name="start"
76	CALL getin("start_file_name",file_name)
77	suffix="_start"
78	ELSE
79	file_name="restart"
80	CALL getin("restart_file_name",file_name)
81	suffix="_restart"
82	ENDIF
83
84	IF (using_xios) THEN
85	IF (PRESENT(field0)) THEN ; CALL xios_write_field(TRIM(field0(1)%name)//TRIM(suffix),field0) ; ENDIF
86	IF (PRESENT(field1)) THEN ; CALL xios_write_field(TRIM(field1(1)%name)//TRIM(suffix),field1) ; ENDIF
87	IF (PRESENT(field2)) THEN ; CALL xios_write_field(TRIM(field2(1)%name)//TRIM(suffix),field2) ; ENDIF
88	IF (PRESENT(field3)) THEN ; CALL xios_write_field(TRIM(field3(1)%name)//TRIM(suffix),field3) ; ENDIF
89	IF (PRESENT(field4)) THEN ; CALL xios_write_field(TRIM(field4(1)%name)//TRIM(suffix),field4) ; ENDIF
90	IF (PRESENT(field5)) THEN ; CALL xios_write_field(TRIM(field5(1)%name)//TRIM(suffix),field5) ; ENDIF
91	IF (PRESENT(field6)) THEN ; CALL xios_write_field(TRIM(field6(1)%name)//TRIM(suffix),field6) ; ENDIF
92	IF (PRESENT(field7)) THEN ; CALL xios_write_field(TRIM(field7(1)%name)//TRIM(suffix),field7) ; ENDIF
93	IF (PRESENT(field8)) THEN ; CALL xios_write_field(TRIM(field8(1)%name)//TRIM(suffix),field8) ; ENDIF
94	IF (PRESENT(field9)) THEN ; CALL xios_write_field(TRIM(field9(1)%name)//TRIM(suffix),field9) ; ENDIF
95	IF (PRESENT(field10)) THEN ; CALL xios_write_field(TRIM(field10(1)%name)//TRIM(suffix),field10) ; ENDIF
96	IF (PRESENT(field11)) THEN ; CALL xios_write_field(TRIM(field11(1)%name)//TRIM(suffix),field11) ; ENDIF
97	IF (PRESENT(field12)) THEN ; CALL xios_write_field(TRIM(field12(1)%name)//TRIM(suffix),field12) ; ENDIF
98	IF (PRESENT(field13)) THEN ; CALL xios_write_field(TRIM(field13(1)%name)//TRIM(suffix),field13) ; ENDIF
99	IF (PRESENT(field14)) THEN ; CALL xios_write_field(TRIM(field14(1)%name)//TRIM(suffix),field14) ; ENDIF
100	IF (PRESENT(field15)) THEN ; CALL xios_write_field(TRIM(field15(1)%name)//TRIM(suffix),field15) ; ENDIF
101	IF (PRESENT(field16)) THEN ; CALL xios_write_field(TRIM(field16(1)%name)//TRIM(suffix),field16) ; ENDIF
102	IF (PRESENT(field17)) THEN ; CALL xios_write_field(TRIM(field17(1)%name)//TRIM(suffix),field17) ; ENDIF
103	IF (PRESENT(field18)) THEN ; CALL xios_write_field(TRIM(field18(1)%name)//TRIM(suffix),field18) ; ENDIF
104	IF (PRESENT(field19)) THEN ; CALL xios_write_field(TRIM(field19(1)%name)//TRIM(suffix),field19) ; ENDIF
105	IF (is_omp_master) CALL xios_send_field('it'//TRIM(suffix),it*1.0)
106
107	ELSE
108
109	!$OMP MASTER
110
111	nfield=0
112	IF (PRESENT(field0)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0 ; ENDIF
113	IF (PRESENT(field1)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1 ; ENDIF
114	IF (PRESENT(field2)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2 ; ENDIF
115	IF (PRESENT(field3)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3 ; ENDIF
116	IF (PRESENT(field4)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4 ; ENDIF
117	IF (PRESENT(field5)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5 ; ENDIF
118	IF (PRESENT(field6)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6 ; ENDIF
119	IF (PRESENT(field7)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7 ; ENDIF
120	IF (PRESENT(field8)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8 ; ENDIF
121	IF (PRESENT(field9)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9 ; ENDIF
122	IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
123	IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
124	IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
125	IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
126	IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
127	IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
128	IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
129	IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
130	IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
131	IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
132
133
134
135	IF (is_mpi_root) THEN
136	status = NF90_CREATE(TRIM(ADJUSTL(file_name))//'.nc', NF90_CLOBBER, ncid)
137	status = NF90_DEF_DIM(ncid,'cell',ncell_glo,cellId)
138	status = NF90_DEF_DIM(ncid,'edge',3*ncell_glo,edgeId)
139	status = NF90_DEF_DIM(ncid,'lev',llm,levId)
140	status = NF90_DEF_DIM(ncid,'nvert',nvert,vertId)
141	status = NF90_DEF_DIM(ncid,'nq',nqtot,nqId)
142	status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"iteration",it)
143
144	status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ cellId /),lonId)
145	status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
146	status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
147	status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
148	status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ cellId /),latId)
149	status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
150	status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
151	status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
152	status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ vertId,cellId /),bounds_lonId)
153	status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ vertId,cellId /),bounds_latId)
154	status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ levId /),levAxisId)
155	status = NF90_PUT_ATT(ncid,levAxisId,"axis","Z")
156	status = NF90_PUT_ATT(ncid,levAxisId,"units","Pa")
157	status = NF90_PUT_ATT(ncid,levAxisId,"positive","down")
158
159	DO nf=1,nfield
160	field=>field_array(nf)%field
161	IF (field(1)%field_type==field_T) THEN
162	IF (field(1)%ndim==2) THEN
163	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId /),fieldId(nf))
164	status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat")
165	ELSE IF (field(1)%ndim==3) THEN
166	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId /),fieldId(nf))
167	status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lev lon lat")
168	ELSE IF (field(1)%ndim==4) THEN
169	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId,nqId /),fieldId(nf))
170	status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","nq lev lon lat")
171	ENDIF
172	ELSE IF (field(1)%field_type==field_U) THEN
173	IF (field(1)%ndim==2) THEN
174	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId /),fieldId(nf))
175	ELSE IF (field(1)%ndim==3) THEN
176	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId /),fieldId(nf))
177	ELSE IF (field(1)%ndim==4) THEN
178	status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId, nqId /),fieldId(nf))
179	ENDIF
180	ENDIF
181	ENDDO
182
183
184	status = NF90_ENDDEF(ncid)
185
186	ALLOCATE(lon(ncell_glo),lat(ncell_glo),bounds_lon(0:nvert-1,ncell_glo),bounds_lat(0:nvert-1,ncell_glo))
187	DO ind=1,ndomain_glo
188	d=>domain_glo(ind)
189	DO j=d%jj_begin,d%jj_end
190	DO i=d%ii_begin,d%ii_end
191	ind_glo=d%assign_cell_glo(i,j)
192	CALL xyz2lonlat(d%xyz(:,i,j),lon(ind_glo),lat(ind_glo))
193	lon(ind_glo)=lon(ind_glo)*180/Pi
194	lat(ind_glo)=lat(ind_glo)*180/Pi
195	DO k=0,5
196	CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ind_glo), bounds_lat(k,ind_glo))
197	bounds_lat(k,ind_glo)=bounds_lat(k,ind_glo)*180/Pi
198	bounds_lon(k,ind_glo)=bounds_lon(k,ind_glo)*180/Pi
199	ENDDO
200	ENDDO
201	ENDDO
202	ENDDO
203
204	status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell_glo /))
205	status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell_glo /))
206	status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
207	status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
208	status=NF90_PUT_VAR(ncid,levAxisId,REAL(presnivs,r8),start=(/ 1 /),count=(/ llm /))
209	ENDIF
210
211	DO nf=1,nfield
212	field=>field_array(nf)%field
213	CALL write_restart_field(field,fieldId(nf),ncid)
214	ENDDO
215
216	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId /),fieldId(nf))
217	! ELSE IF (field(1)%ndim==3) THEN
218	! status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId, levId /),fieldId(nf))
219	! ENDIF
220	! ENDDO
221
222
223	IF (is_mpi_root) THEN
224	status = NF90_CLOSE(ncid)
225	ENDIF
226
227	!$OMP END MASTER
228
229	ENDIF
230
231	END SUBROUTINE write_restart
232
233	SUBROUTINE write_restart_field(field,fieldId,ncid)
234	USE prec
235	USE metric
236	USE field_mod
237	USE domain_mod
238	USE netcdf_mod
239	USE mpipara
240	USE getin_mod
241	USE spherical_geom_mod
242	USE transfert_mod
243	USE xios_mod
244	IMPLICIT NONE
245	TYPE(t_field),POINTER :: field(:)
246	INTEGER,INTENT(IN) :: fieldId
247	INTEGER,INTENT(IN) :: ncid
248
249	TYPE(t_domain),POINTER :: d
250	TYPE(t_field),POINTER :: field_glo(:)
251	REAL(rstd),ALLOCATABLE :: global_field2d(:)
252	REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
253	REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
254	INTEGER :: i,j,ij,k,e,ind,ind_glo
255	INTEGER :: ndim, field_type
256	INTEGER :: status
257
258	ndim=field(1)%ndim
259	field_Type= field(1)%field_type
260
261	IF (is_mpi_root) THEN
262
263	IF (ndim==2) THEN
264	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
265	ELSE IF (ndim==3) THEN
266	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
267	ELSE IF (ndim==4) THEN
268	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
269	ENDIF
270	ENDIF
271
272	CALL gather_field(field,field_glo)
273
274
275	IF (is_mpi_root) THEN
276
277	IF (field_type==field_T) THEN
278	IF (ndim==2) THEN
279	ALLOCATE(global_field2d(ncell_glo))
280	DO ind=1,ndomain_glo
281	d=>domain_glo(ind)
282	DO j=d%jj_begin,d%jj_end
283	DO i=d%ii_begin,d%ii_end
284	IF (d%own(i,j)) THEN
285	ij=(j-1)*d%iim+i
286	ind_glo=d%assign_cell_glo(i,j)
287	global_field2d(ind_glo)=field_glo(ind)%rval2d(ij)
288	ENDIF
289	ENDDO
290	ENDDO
291	ENDDO
292	status=NF90_PUT_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ ncell_glo /))
293
294	ELSE IF (ndim==3) THEN
295	ALLOCATE(global_field3d(ncell_glo,llm))
296	DO ind=1,ndomain_glo
297	d=>domain_glo(ind)
298	DO j=d%jj_begin,d%jj_end
299	DO i=d%ii_begin,d%ii_end
300	IF (d%own(i,j)) THEN
301	ij=(j-1)*d%iim+i
302	ind_glo=d%assign_cell_glo(i,j)
303	global_field3d(ind_glo,:)=field_glo(ind)%rval3d(ij,:)
304	ENDIF
305	ENDDO
306	ENDDO
307	ENDDO
308	status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
309	ELSE IF (ndim==4) THEN
310	ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
311	DO ind=1,ndomain_glo
312	d=>domain_glo(ind)
313	DO j=d%jj_begin,d%jj_end
314	DO i=d%ii_begin,d%ii_end
315	IF (d%own(i,j)) THEN
316	ij=(j-1)*d%iim+i
317	ind_glo=d%assign_cell_glo(i,j)
318	global_field4d(ind_glo,:,:)=field_glo(ind)%rval4d(ij,:,:)
319	ENDIF
320	ENDDO
321	ENDDO
322	ENDDO
323	status=NF90_PUT_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
324	ENDIF
325
326	ELSE IF (field_type==field_U) THEN
327
328	IF (ndim==2) THEN
329	ALLOCATE(global_field2d(3*ncell_glo))
330	global_field2d(:) = 0
331	DO ind=1,ndomain_glo
332	d=>domain_glo(ind)
333	DO j=d%jj_begin,d%jj_end
334	DO i=d%ii_begin,d%ii_end
335	DO k=0,5
336	IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
337	.AND. d%edge_assign_pos(k,i,j)==k) THEN
338	ij=(j-1)*d%iim+i
339	ind_glo=d%assign_cell_glo(i,j)
340	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
341	global_field2d(e)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k))
342	ENDIF
343	ENDDO
344	ENDDO
345	ENDDO
346	ENDDO
347	status=NF90_PUT_VAR(ncid,fieldid,REAL(global_field2d,r8),start=(/ 1 /),count=(/ 3*ncell_glo /))
348	ELSE IF (ndim==3) THEN
349	ALLOCATE(global_field3d(3*ncell_glo,llm))
350	global_field3d(:,:) = 0
351	DO ind=1,ndomain_glo
352	d=>domain_glo(ind)
353	DO j=d%jj_begin,d%jj_end
354	DO i=d%ii_begin,d%ii_end
355	DO k=0,5
356	IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j &
357	.AND. d%edge_assign_pos(k,i,j)==k) THEN
358	ij=(j-1)*d%iim+i
359	ind_glo=d%assign_cell_glo(i,j)
360	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
361	global_field3d(e,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)
362	ENDIF
363	ENDDO
364	ENDDO
365	ENDDO
366	ENDDO
367	status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
368	ELSE IF (ndim==4) THEN
369	ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
370	global_field4d(:,:,:) = 0
371	DO ind=1,ndomain_glo
372	d=>domain_glo(ind)
373	DO j=d%jj_begin,d%jj_end
374	DO i=d%ii_begin,d%ii_end
375	DO k=0,5
376	IF (d%edge_assign_domain(k,i,j)==ind .AND. d%edge_assign_i(k,i,j)==i .AND. d%edge_assign_j(k,i,j)==j&
377	.AND. d%edge_assign_pos(k,i,j)==k) THEN
378	ij=(j-1)*d%iim+i
379	ind_glo=d%assign_cell_glo(i,j)
380	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
381	global_field4d(e,:,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)
382	ENDIF
383	ENDDO
384	ENDDO
385	ENDDO
386	ENDDO
387	status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
388	ENDIF
389
390	ENDIF
391
392	CALL deallocate_field_glo(field_glo)
393
394	ENDIF
395
396
397	END SUBROUTINE write_restart_field
398
399
400	SUBROUTINE read_start(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9, &
401	field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
402	USE prec
403	USE metric
404	USE field_mod
405	USE domain_mod
406	USE netcdf_mod
407	USE mpipara
408	USE getin_mod
409	USE spherical_geom_mod
410	USE transfert_mod
411	USE xios_mod
412
413	IMPLICIT NONE
414	INTEGER, INTENT(OUT) :: it
415	TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
416	TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
417
418	TYPE(t_field_array) :: field_array(20)
419	INTEGER :: nfield
420	INTEGER :: fieldId(20)
421
422	TYPE(t_field),POINTER :: field(:)
423
424	CHARACTER(LEN=255) :: start_file_name
425	INTEGER,PARAMETER :: nvert=6
426	INTEGER :: ncid
427	INTEGER :: nf
428	INTEGER :: status
429	REAL(rstd) :: it_real
430
431	IF (no_io) RETURN
432
433	start_file_name="start"
434	CALL getin("start_file_name",start_file_name)
435
436
437
438	IF (using_xios) THEN
439	IF (PRESENT(field0)) THEN ; CALL xios_read_field(TRIM(field0(1)%name)//'_start',field0) ; ENDIF
440	IF (PRESENT(field1)) THEN ; CALL xios_read_field(TRIM(field1(1)%name)//'_start',field1) ; ENDIF
441	IF (PRESENT(field2)) THEN ; CALL xios_read_field(TRIM(field2(1)%name)//'_start',field2) ; ENDIF
442	IF (PRESENT(field3)) THEN ; CALL xios_read_field(TRIM(field3(1)%name)//'_start',field3) ; ENDIF
443	IF (PRESENT(field4)) THEN ; CALL xios_read_field(TRIM(field4(1)%name)//'_start',field4) ; ENDIF
444	IF (PRESENT(field5)) THEN ; CALL xios_read_field(TRIM(field5(1)%name)//'_start',field5) ; ENDIF
445	IF (PRESENT(field6)) THEN ; CALL xios_read_field(TRIM(field6(1)%name)//'_start',field6) ; ENDIF
446	IF (PRESENT(field7)) THEN ; CALL xios_read_field(TRIM(field7(1)%name)//'_start',field7) ; ENDIF
447	IF (PRESENT(field8)) THEN ; CALL xios_read_field(TRIM(field8(1)%name)//'_start',field8) ; ENDIF
448	IF (PRESENT(field9)) THEN ; CALL xios_read_field(TRIM(field9(1)%name)//'_start',field9) ; ENDIF
449	IF (PRESENT(field10)) THEN ; CALL xios_read_field(TRIM(field10(1)%name)//'_start',field10) ; ENDIF
450	IF (PRESENT(field11)) THEN ; CALL xios_read_field(TRIM(field11(1)%name)//'_start',field11) ; ENDIF
451	IF (PRESENT(field12)) THEN ; CALL xios_read_field(TRIM(field12(1)%name)//'_start',field12) ; ENDIF
452	IF (PRESENT(field13)) THEN ; CALL xios_read_field(TRIM(field13(1)%name)//'_start',field13) ; ENDIF
453	IF (PRESENT(field14)) THEN ; CALL xios_read_field(TRIM(field14(1)%name)//'_start',field14) ; ENDIF
454	IF (PRESENT(field15)) THEN ; CALL xios_read_field(TRIM(field15(1)%name)//'_start',field15) ; ENDIF
455	IF (PRESENT(field16)) THEN ; CALL xios_read_field(TRIM(field16(1)%name)//'_start',field16) ; ENDIF
456	IF (PRESENT(field17)) THEN ; CALL xios_read_field(TRIM(field17(1)%name)//'_start',field17) ; ENDIF
457	IF (PRESENT(field18)) THEN ; CALL xios_read_field(TRIM(field18(1)%name)//'_start',field18) ; ENDIF
458	IF (PRESENT(field19)) THEN ; CALL xios_read_field(TRIM(field19(1)%name)//'_start',field19) ; ENDIF
459
460	! CALL xios_recv_field("it_start",it_real)
461	CALL xios_read_var("it_start",it_real)
462	it=INT(it_real)
463	ELSE
464
465	!$OMP MASTER
466
467	nfield=0
468	IF (PRESENT(field0)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0 ; ENDIF
469	IF (PRESENT(field1)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1 ; ENDIF
470	IF (PRESENT(field2)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2 ; ENDIF
471	IF (PRESENT(field3)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3 ; ENDIF
472	IF (PRESENT(field4)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4 ; ENDIF
473	IF (PRESENT(field5)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5 ; ENDIF
474	IF (PRESENT(field6)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6 ; ENDIF
475	IF (PRESENT(field7)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7 ; ENDIF
476	IF (PRESENT(field8)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8 ; ENDIF
477	IF (PRESENT(field9)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9 ; ENDIF
478	IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
479	IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
480	IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
481	IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
482	IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
483	IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
484	IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
485	IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
486	IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
487	IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
488
489
490
491	IF (is_mpi_root) THEN
492	status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid)
493	ENDIF
494
495	DO nf=1,nfield
496	field=>field_array(nf)%field
497	status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))
498	status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it)
499	CALL read_start_field(field,fieldId(nf),ncid)
500	ENDDO
501
502
503	IF (is_mpi_root) THEN
504	status = NF90_CLOSE(ncid)
505	ENDIF
506
507	!$OMP END MASTER
508
509	ENDIF
510
511	END SUBROUTINE read_start
512
513
514	SUBROUTINE read_start_field(field,fieldId,ncid)
515	USE prec
516	USE metric
517	USE field_mod
518	USE domain_mod
519	USE netcdf_mod
520	USE mpipara
521	USE getin_mod
522	USE spherical_geom_mod
523	USE transfert_mod
524	IMPLICIT NONE
525	TYPE(t_field),POINTER :: field(:)
526	INTEGER,INTENT(IN) :: fieldId
527	INTEGER,INTENT(IN) :: ncid
528
529	TYPE(t_domain),POINTER :: d
530	TYPE(t_field),POINTER :: field_glo(:)
531	REAL(rstd),ALLOCATABLE :: global_field2d(:)
532	REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
533	REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
534	INTEGER :: i,j,ij,k,e,ind,ind_glo
535	INTEGER :: ndim, field_type
536	INTEGER :: status
537
538	ndim=field(1)%ndim
539	field_Type= field(1)%field_type
540
541	IF (is_mpi_root) THEN
542
543	IF (ndim==2) THEN
544	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
545	ELSE IF (ndim==3) THEN
546	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
547	ELSE IF (ndim==4) THEN
548	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
549	ENDIF
550	ENDIF
551
552	IF (is_mpi_root) THEN
553
554	IF (field_type==field_T) THEN
555	IF (ndim==2) THEN
556	ALLOCATE(global_field2d(ncell_glo))
557	status=NF90_GET_VAR(ncid,fieldid, global_field2d, start=(/ 1 /), count=(/ ncell_glo /))
558	DO ind=1,ndomain_glo
559	d=>domain_glo(ind)
560	DO j=d%jj_begin,d%jj_end
561	DO i=d%ii_begin,d%ii_end
562	ij=(j-1)*d%iim+i
563	ind_glo=d%assign_cell_glo(i,j)
564	field_glo(ind)%rval2d(ij)=global_field2d(ind_glo)
565	ENDDO
566	ENDDO
567	ENDDO
568
569	ELSE IF (ndim==3) THEN
570	ALLOCATE(global_field3d(ncell_glo,llm))
571	status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
572	DO ind=1,ndomain_glo
573	d=>domain_glo(ind)
574	DO j=d%jj_begin,d%jj_end
575	DO i=d%ii_begin,d%ii_end
576	ij=(j-1)*d%iim+i
577	ind_glo=d%assign_cell_glo(i,j)
578	field_glo(ind)%rval3d(ij,:) = global_field3d(ind_glo,:)
579	ENDDO
580	ENDDO
581	ENDDO
582	ELSE IF (ndim==4) THEN
583	ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
584	status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
585	DO ind=1,ndomain_glo
586	d=>domain_glo(ind)
587	DO j=d%jj_begin,d%jj_end
588	DO i=d%ii_begin,d%ii_end
589	ij=(j-1)*d%iim+i
590	ind_glo=d%assign_cell_glo(i,j)
591	field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:)
592	ENDDO
593	ENDDO
594	ENDDO
595	ENDIF
596
597	ELSE IF (field_type==field_U) THEN
598
599	IF (ndim==2) THEN
600	ALLOCATE(global_field2d(3*ncell_glo))
601	status=NF90_GET_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ 3*ncell_glo /))
602
603	DO ind=1,ndomain_glo
604	d=>domain_glo(ind)
605	DO j=d%jj_begin,d%jj_end
606	DO i=d%ii_begin,d%ii_end
607	DO k=0,5
608	ij=(j-1)*d%iim+i
609	ind_glo=d%assign_cell_glo(i,j)
610	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
611	field_glo(ind)%rval2d(ij+d%u_pos(k))= global_field2d(ind_glo)*d%edge_assign_sign(k,i,j)
612	ENDDO
613	ENDDO
614	ENDDO
615	ENDDO
616	ELSE IF (ndim==3) THEN
617	ALLOCATE(global_field3d(3*ncell_glo,llm))
618	status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
619	DO ind=1,ndomain_glo
620	d=>domain_glo(ind)
621	DO j=d%jj_begin,d%jj_end
622	DO i=d%ii_begin,d%ii_end
623	DO k=0,5
624	ij=(j-1)*d%iim+i
625	ind_glo=d%assign_cell_glo(i,j)
626	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
627	field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j)
628	ENDDO
629	ENDDO
630	ENDDO
631	ENDDO
632	ELSE IF (ndim==4) THEN
633	ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
634	status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
635	DO ind=1,ndomain_glo
636	d=>domain_glo(ind)
637	DO j=d%jj_begin,d%jj_end
638	DO i=d%ii_begin,d%ii_end
639	DO k=0,5
640	ij=(j-1)*d%iim+i
641	ind_glo=d%assign_cell_glo(i,j)
642	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
643	field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j)
644	ENDDO
645	ENDDO
646	ENDDO
647	ENDDO
648	ENDIF
649
650	ENDIF
651	ENDIF
652
653	CALL scatter_field(field_glo,field)
654
655	IF (is_mpi_root) THEN
656	CALL deallocate_field_glo(field_glo)
657	ENDIF
658
659
660	END SUBROUTINE read_start_field
661
662	END MODULE restart_mod
663

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

Context Navigation

source: codes/icosagcm/trunk/src/output/restart.f90

Download in other formats: