Context Navigation

source: codes/icosagcm/trunk/src/restart.f90 @ 327

Last change on this file since 327 was 327, checked in by ymipsl, 9 years ago

Merge recent developments from saturn branch onto trunk.

lmdz generic physics interface
performance improvment on mix mpi/openmp
asynchrone and overlaping communication
best domain distribution between process and threads
....

This version is compatible with the actual saturn version and the both branches are considered merged on dynamico component.

YM

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

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

Download in other formats: