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

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

Synchronize trunk and Saturn branch.
Merge modification from Saturn branch to trunk

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