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

Last change on this file since 492 was 492, checked in by ymipsl, 8 years ago

Some bugs fixed in XIOS...
=> Some modifciation in restart and read fonctionnalities.

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