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

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

New version independant of netcd I/O for benchmarking.

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    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_temp(1)
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! doesn't work for now, to be decomment when xios is ok
453!      CALL xios_recv_field("it_start",it_temp)
454!      it=it_temp(1)
455      it=0
456    ELSE
457
458    !$OMP MASTER
459
460      nfield=0
461      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
462      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
463      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
464      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
465      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
466      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
467      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
468      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
469      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
470      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
471      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
472      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
473      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
474      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
475      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
476      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
477      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
478      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
479      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
480      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
481     
482       
483
484      IF (is_mpi_root) THEN
485        status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid)
486      ENDIF
487     
488      DO nf=1,nfield
489        field=>field_array(nf)%field
490        status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))
491        status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it)
492        CALL read_start_field(field,fieldId(nf),ncid)
493      ENDDO
494
495
496      IF (is_mpi_root) THEN
497        status = NF90_CLOSE(ncid)     
498      ENDIF
499     
500     !$OMP END MASTER
501   
502    ENDIF
503 
504  END SUBROUTINE read_start
505
506
507  SUBROUTINE read_start_field(field,fieldId,ncid)
508  USE prec
509  USE metric
510  USE field_mod
511  USE domain_mod
512  USE netcdf_mod
513  USE mpipara
514  USE getin_mod
515  USE spherical_geom_mod
516  USE transfert_mod
517  IMPLICIT NONE
518    TYPE(t_field),POINTER :: field(:)
519    INTEGER,INTENT(IN)     :: fieldId
520    INTEGER,INTENT(IN)     :: ncid
521
522    TYPE(t_domain),POINTER :: d
523    TYPE(t_field),POINTER :: field_glo(:)
524    REAL(rstd),ALLOCATABLE :: global_field2d(:)
525    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
526    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
527    INTEGER :: i,j,ij,k,e,ind,ind_glo
528    INTEGER :: ndim, field_type
529    INTEGER :: status
530   
531      ndim=field(1)%ndim
532      field_Type= field(1)%field_type
533     
534      IF (is_mpi_root) THEN
535 
536        IF (ndim==2) THEN
537          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
538        ELSE IF (ndim==3) THEN
539          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
540        ELSE IF (ndim==4) THEN
541          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
542        ENDIF
543      ENDIF
544     
545      IF (is_mpi_root) THEN
546
547        IF (field_type==field_T) THEN
548          IF (ndim==2) THEN
549            ALLOCATE(global_field2d(ncell_glo))
550            status=NF90_GET_VAR(ncid,fieldid, global_field2d, start=(/ 1 /), count=(/ ncell_glo /))
551            DO ind=1,ndomain_glo
552              d=>domain_glo(ind)
553              DO j=d%jj_begin,d%jj_end
554                DO i=d%ii_begin,d%ii_end
555                    ij=(j-1)*d%iim+i
556                    ind_glo=d%assign_cell_glo(i,j)
557                    field_glo(ind)%rval2d(ij)=global_field2d(ind_glo)
558                ENDDO
559              ENDDO
560            ENDDO
561         
562          ELSE IF (ndim==3) THEN
563            ALLOCATE(global_field3d(ncell_glo,llm))
564            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
565            DO ind=1,ndomain_glo
566              d=>domain_glo(ind)
567              DO j=d%jj_begin,d%jj_end
568                DO i=d%ii_begin,d%ii_end
569                  ij=(j-1)*d%iim+i
570                  ind_glo=d%assign_cell_glo(i,j)
571                  field_glo(ind)%rval3d(ij,:) = global_field3d(ind_glo,:)
572                ENDDO
573              ENDDO
574            ENDDO
575          ELSE IF (ndim==4) THEN
576            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
577            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
578            DO ind=1,ndomain_glo
579              d=>domain_glo(ind)
580              DO j=d%jj_begin,d%jj_end
581                DO i=d%ii_begin,d%ii_end
582                  ij=(j-1)*d%iim+i
583                  ind_glo=d%assign_cell_glo(i,j)
584                  field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:)
585                ENDDO
586              ENDDO
587            ENDDO
588          ENDIF
589       
590        ELSE IF (field_type==field_U) THEN
591       
592          IF (ndim==2) THEN
593            ALLOCATE(global_field2d(3*ncell_glo))
594            status=NF90_GET_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ 3*ncell_glo /))
595
596            DO ind=1,ndomain_glo
597              d=>domain_glo(ind)
598              DO j=d%jj_begin,d%jj_end
599                DO i=d%ii_begin,d%ii_end
600                  DO k=0,5
601                    ij=(j-1)*d%iim+i
602                    ind_glo=d%assign_cell_glo(i,j)
603                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
604                    field_glo(ind)%rval2d(ij+d%u_pos(k))= global_field2d(ind_glo)*d%edge_assign_sign(k,i,j)
605                  ENDDO
606                ENDDO
607              ENDDO
608            ENDDO
609          ELSE IF (ndim==3) THEN
610            ALLOCATE(global_field3d(3*ncell_glo,llm))
611            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
612            DO ind=1,ndomain_glo
613              d=>domain_glo(ind)
614              DO j=d%jj_begin,d%jj_end
615                DO i=d%ii_begin,d%ii_end
616                  DO k=0,5
617                    ij=(j-1)*d%iim+i
618                    ind_glo=d%assign_cell_glo(i,j)
619                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
620                    field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j)
621                  ENDDO
622                ENDDO
623              ENDDO
624            ENDDO
625          ELSE IF (ndim==4) THEN
626            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
627            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
628            DO ind=1,ndomain_glo
629              d=>domain_glo(ind)
630              DO j=d%jj_begin,d%jj_end
631                DO i=d%ii_begin,d%ii_end
632                  DO k=0,5
633                    ij=(j-1)*d%iim+i
634                    ind_glo=d%assign_cell_glo(i,j)
635                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
636                    field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j)
637                  ENDDO
638                ENDDO
639              ENDDO
640            ENDDO
641          ENDIF
642
643        ENDIF
644      ENDIF
645     
646      CALL scatter_field(field_glo,field)
647       
648      IF (is_mpi_root) THEN
649        CALL deallocate_field_glo(field_glo)
650      ENDIF
651     
652     
653  END SUBROUTINE read_start_field     
654   
655END MODULE restart_mod
656 
Note: See TracBrowser for help on using the repository browser.