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

Last change on this file since 309 was 297, checked in by millour, 10 years ago

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