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

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

Solve the start/restart issue.

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