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

Last change on this file since 483 was 483, checked in by ymipsl, 8 years ago
  • Add functionnality to input/output field of type U (value on the edges)
  • Management of start/restart files by XIOS

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