Context Navigation

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

Last change on this file since 358 was 358, checked in by llfita, 9 years ago

Modifying code to be 'gfortran' compatible:

Change WRITE(' ',)... by PRINT *,
Shorten some code lines

File size: 22.9 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 &
272	.AND. d%edge_assign_pos(k,i,j)==k) THEN
273	ij=(j-1)*d%iim+i
274	ind_glo=d%assign_cell_glo(i,j)
275	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
276	global_field2d(ind_glo)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k))
277	ENDIF
278	ENDDO
279	ENDDO
280	ENDDO
281	ENDDO
282	status=NF90_PUT_VAR(ncid,fieldid,REAL(global_field2d,r8),start=(/ 1 /),count=(/ 3*ncell_glo /))
283	ELSE IF (ndim==3) THEN
284	ALLOCATE(global_field3d(3*ncell_glo,llm))
285	DO ind=1,ndomain_glo
286	d=>domain_glo(ind)
287	DO j=d%jj_begin,d%jj_end
288	DO i=d%ii_begin,d%ii_end
289	DO k=0,5
290	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 &
291	.AND. d%edge_assign_pos(k,i,j)==k) THEN
292	ij=(j-1)*d%iim+i
293	ind_glo=d%assign_cell_glo(i,j)
294	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
295	global_field3d(e,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)
296	ENDIF
297	ENDDO
298	ENDDO
299	ENDDO
300	ENDDO
301	status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
302	ELSE IF (ndim==4) THEN
303	ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
304	DO ind=1,ndomain_glo
305	d=>domain_glo(ind)
306	DO j=d%jj_begin,d%jj_end
307	DO i=d%ii_begin,d%ii_end
308	DO k=0,5
309	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&
310	.AND. d%edge_assign_pos(k,i,j)==k) THEN
311	ij=(j-1)*d%iim+i
312	ind_glo=d%assign_cell_glo(i,j)
313	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
314	global_field4d(e,:,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)
315	ENDIF
316	ENDDO
317	ENDDO
318	ENDDO
319	ENDDO
320	status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
321	ENDIF
322
323	ENDIF
324
325	CALL deallocate_field_glo(field_glo)
326
327	ENDIF
328
329
330	END SUBROUTINE write_restart_field
331
332
333	SUBROUTINE read_start(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9, &
334	field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
335	USE prec
336	USE metric
337	USE field_mod
338	USE domain_mod
339	USE netcdf_mod
340	USE mpipara
341	USE getin_mod
342	USE spherical_geom_mod
343	USE transfert_mod
344
345	IMPLICIT NONE
346	INTEGER, INTENT(OUT) :: it
347	TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
348	TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
349
350	TYPE(t_field_array) :: field_array(20)
351	INTEGER :: nfield
352	INTEGER :: fieldId(20)
353
354	TYPE(t_domain),POINTER :: d
355	TYPE(t_field),POINTER :: field_glo(:)
356	TYPE(t_field),POINTER :: field(:)
357
358	CHARACTER(LEN=255) :: start_file_name
359	INTEGER,PARAMETER :: nvert=6
360	INTEGER :: ncid, cellId, levId, edgeId, vertid, lonId, latId, bounds_lonId, bounds_latId
361	INTEGER :: ind,ind_glo,i,j,k,nf
362	INTEGER :: status
363	REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
364
365	start_file_name="start"
366	CALL getin("start_file_name",start_file_name)
367
368	!$OMP MASTER
369
370	nfield=0
371	IF (PRESENT(field0)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0 ; ENDIF
372	IF (PRESENT(field1)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1 ; ENDIF
373	IF (PRESENT(field2)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2 ; ENDIF
374	IF (PRESENT(field3)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3 ; ENDIF
375	IF (PRESENT(field4)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4 ; ENDIF
376	IF (PRESENT(field5)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5 ; ENDIF
377	IF (PRESENT(field6)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6 ; ENDIF
378	IF (PRESENT(field7)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7 ; ENDIF
379	IF (PRESENT(field8)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8 ; ENDIF
380	IF (PRESENT(field9)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9 ; ENDIF
381	IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
382	IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
383	IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
384	IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
385	IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
386	IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
387	IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
388	IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
389	IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
390	IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
391
392
393
394	IF (is_mpi_root) THEN
395	status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid)
396	ENDIF
397
398	DO nf=1,nfield
399	field=>field_array(nf)%field
400	status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))
401	status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it)
402	CALL read_start_field(field,fieldId(nf),ncid)
403	ENDDO
404
405
406	IF (is_mpi_root) THEN
407	status = NF90_CLOSE(ncid)
408	ENDIF
409	!$OMP END MASTER
410
411	END SUBROUTINE read_start
412
413
414	SUBROUTINE read_start_field(field,fieldId,ncid)
415	USE prec
416	USE metric
417	USE field_mod
418	USE domain_mod
419	USE netcdf_mod
420	USE mpipara
421	USE getin_mod
422	USE spherical_geom_mod
423	USE transfert_mod
424	IMPLICIT NONE
425	TYPE(t_field),POINTER :: field(:)
426	INTEGER,INTENT(IN) :: fieldId
427	INTEGER,INTENT(IN) :: ncid
428
429	TYPE(t_domain),POINTER :: d
430	TYPE(t_field),POINTER :: field_glo(:)
431	REAL(rstd),ALLOCATABLE :: global_field2d(:)
432	REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
433	REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
434	INTEGER :: i,j,ij,k,e,ind,ind_glo
435	INTEGER :: ndim, field_type
436	INTEGER :: status
437
438	ndim=field(1)%ndim
439	field_Type= field(1)%field_type
440
441	IF (is_mpi_root) THEN
442
443	IF (ndim==2) THEN
444	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
445	ELSE IF (ndim==3) THEN
446	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
447	ELSE IF (ndim==4) THEN
448	CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
449	ENDIF
450	ENDIF
451
452	IF (is_mpi_root) THEN
453
454	IF (field_type==field_T) THEN
455	IF (ndim==2) THEN
456	ALLOCATE(global_field2d(ncell_glo))
457	status=NF90_GET_VAR(ncid,fieldid, global_field2d, start=(/ 1 /), count=(/ ncell_glo /))
458	DO ind=1,ndomain_glo
459	d=>domain_glo(ind)
460	DO j=d%jj_begin,d%jj_end
461	DO i=d%ii_begin,d%ii_end
462	ij=(j-1)*d%iim+i
463	ind_glo=d%assign_cell_glo(i,j)
464	field_glo(ind)%rval2d(ij)=global_field2d(ind_glo)
465	ENDDO
466	ENDDO
467	ENDDO
468
469	ELSE IF (ndim==3) THEN
470	ALLOCATE(global_field3d(ncell_glo,llm))
471	status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
472	DO ind=1,ndomain_glo
473	d=>domain_glo(ind)
474	DO j=d%jj_begin,d%jj_end
475	DO i=d%ii_begin,d%ii_end
476	ij=(j-1)*d%iim+i
477	ind_glo=d%assign_cell_glo(i,j)
478	field_glo(ind)%rval3d(ij,:) = global_field3d(ind_glo,:)
479	ENDDO
480	ENDDO
481	ENDDO
482	ELSE IF (ndim==4) THEN
483	ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
484	status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
485	DO ind=1,ndomain_glo
486	d=>domain_glo(ind)
487	DO j=d%jj_begin,d%jj_end
488	DO i=d%ii_begin,d%ii_end
489	ij=(j-1)*d%iim+i
490	ind_glo=d%assign_cell_glo(i,j)
491	field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:)
492	ENDDO
493	ENDDO
494	ENDDO
495	ENDIF
496
497	ELSE IF (field_type==field_U) THEN
498
499	IF (ndim==2) THEN
500	ALLOCATE(global_field2d(3*ncell_glo))
501	status=NF90_GET_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ 3*ncell_glo /))
502
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)%rval2d(ij+d%u_pos(k))= global_field2d(ind_glo)*d%edge_assign_sign(k,i,j)
512	ENDDO
513	ENDDO
514	ENDDO
515	ENDDO
516	ELSE IF (ndim==3) THEN
517	ALLOCATE(global_field3d(3*ncell_glo,llm))
518	status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
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)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j)
528	ENDDO
529	ENDDO
530	ENDDO
531	ENDDO
532	ELSE IF (ndim==4) THEN
533	ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
534	status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
535	DO ind=1,ndomain_glo
536	d=>domain_glo(ind)
537	DO j=d%jj_begin,d%jj_end
538	DO i=d%ii_begin,d%ii_end
539	DO k=0,5
540	ij=(j-1)*d%iim+i
541	ind_glo=d%assign_cell_glo(i,j)
542	e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6))
543	field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j)
544	ENDDO
545	ENDDO
546	ENDDO
547	ENDDO
548	ENDIF
549
550	ENDIF
551	ENDIF
552
553	CALL scatter_field(field_glo,field)
554
555	IF (is_mpi_root) THEN
556	CALL deallocate_field_glo(field_glo)
557	ENDIF
558
559
560	END SUBROUTINE read_start_field
561
562	END MODULE restart_mod
563

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

Download in other formats: