Context Navigation

source: codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/restart.f90 @ 260

Last change on this file since 260 was 260, checked in by ymipsl, 10 years ago

Implement restartability for dynamico

YM

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

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

Download in other formats: