Context Navigation

restart.f90 @ 319

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

Iteration number is appened to the restart file name.

File size: 25.0 KB

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

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

Context Navigation

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

Download in other formats: