source: codes/icosagcm/trunk/src/output/restart.f90 @ 893

Last change on this file since 893 was 893, checked in by adurocher, 5 years ago

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