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

Last change on this file since 581 was 548, checked in by dubos, 7 years ago

trunk : reorganize source tree
File size: 29.0 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            DO ind=1,ndomain_glo
332              d=>domain_glo(ind)
333              DO j=d%jj_begin,d%jj_end
334                DO i=d%ii_begin,d%ii_end
335                  DO k=0,5
336                   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 &
337                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
338                       ij=(j-1)*d%iim+i
339                      ind_glo=d%assign_cell_glo(i,j)
340                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
341                      global_field2d(e)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k))
342                    ENDIF
343                  ENDDO
344                ENDDO
345              ENDDO
346            ENDDO
347            status=NF90_PUT_VAR(ncid,fieldid,REAL(global_field2d,r8),start=(/ 1 /),count=(/ 3*ncell_glo /))
348          ELSE IF (ndim==3) THEN
349            ALLOCATE(global_field3d(3*ncell_glo,llm))
350            DO ind=1,ndomain_glo
351              d=>domain_glo(ind)
352              DO j=d%jj_begin,d%jj_end
353                DO i=d%ii_begin,d%ii_end
354                  DO k=0,5
355                   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 &
356                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
357                       ij=(j-1)*d%iim+i
358                      ind_glo=d%assign_cell_glo(i,j)
359                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
360                      global_field3d(e,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)
361                    ENDIF
362                  ENDDO
363                ENDDO
364              ENDDO
365            ENDDO
366            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
367          ELSE IF (ndim==4) THEN
368            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
369            DO ind=1,ndomain_glo
370              d=>domain_glo(ind)
371              DO j=d%jj_begin,d%jj_end
372                DO i=d%ii_begin,d%ii_end
373                  DO k=0,5
374                    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&
375                      .AND. d%edge_assign_pos(k,i,j)==k) THEN
376                      ij=(j-1)*d%iim+i
377                      ind_glo=d%assign_cell_glo(i,j)
378                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
379                      global_field4d(e,:,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)
380                    ENDIF
381                  ENDDO
382                ENDDO
383              ENDDO
384            ENDDO
385            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
386          ENDIF
387
388        ENDIF
389       
390        CALL deallocate_field_glo(field_glo)
391     
392      ENDIF
393     
394     
395  END SUBROUTINE write_restart_field
396
397
398  SUBROUTINE read_start(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   &
399                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
400  USE prec
401  USE metric
402  USE field_mod
403  USE domain_mod
404  USE netcdf_mod
405  USE mpipara
406  USE getin_mod
407  USE spherical_geom_mod
408  USE transfert_mod
409  USE xios_mod
410 
411  IMPLICIT NONE
412  INTEGER, INTENT(OUT)  :: it
413  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
414  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
415
416  TYPE(t_field_array) :: field_array(20)
417  INTEGER             :: nfield
418  INTEGER             :: fieldId(20)
419   
420  TYPE(t_domain),POINTER :: d
421  TYPE(t_field),POINTER :: field_glo(:)
422  TYPE(t_field),POINTER :: field(:)
423 
424  CHARACTER(LEN=255) :: start_file_name
425  INTEGER,PARAMETER  :: nvert=6
426  INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId
427  INTEGER    :: ind,ind_glo,i,j,k,nf
428  INTEGER    :: status
429  REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
430  REAL(rstd) :: it_real
431 
432    IF (no_io) RETURN
433   
434    start_file_name="start"
435    CALL getin("start_file_name",start_file_name)
436
437
438
439    IF (using_xios) THEN
440      IF (PRESENT(field0))  THEN ; CALL  xios_read_field(TRIM(field0(1)%name)//'_start',field0)  ; ENDIF
441      IF (PRESENT(field1))  THEN ; CALL  xios_read_field(TRIM(field1(1)%name)//'_start',field1)  ; ENDIF
442      IF (PRESENT(field2))  THEN ; CALL  xios_read_field(TRIM(field2(1)%name)//'_start',field2)  ; ENDIF
443      IF (PRESENT(field3))  THEN ; CALL  xios_read_field(TRIM(field3(1)%name)//'_start',field3)  ; ENDIF
444      IF (PRESENT(field4))  THEN ; CALL  xios_read_field(TRIM(field4(1)%name)//'_start',field4)  ; ENDIF
445      IF (PRESENT(field5))  THEN ; CALL  xios_read_field(TRIM(field5(1)%name)//'_start',field5)  ; ENDIF
446      IF (PRESENT(field6))  THEN ; CALL  xios_read_field(TRIM(field6(1)%name)//'_start',field6)  ; ENDIF
447      IF (PRESENT(field7))  THEN ; CALL  xios_read_field(TRIM(field7(1)%name)//'_start',field7)  ; ENDIF
448      IF (PRESENT(field8))  THEN ; CALL  xios_read_field(TRIM(field8(1)%name)//'_start',field8)  ; ENDIF
449      IF (PRESENT(field9))  THEN ; CALL  xios_read_field(TRIM(field9(1)%name)//'_start',field9)  ; ENDIF
450      IF (PRESENT(field10))  THEN ; CALL  xios_read_field(TRIM(field10(1)%name)//'_start',field10)  ; ENDIF
451      IF (PRESENT(field11))  THEN ; CALL  xios_read_field(TRIM(field11(1)%name)//'_start',field11)  ; ENDIF
452      IF (PRESENT(field12))  THEN ; CALL  xios_read_field(TRIM(field12(1)%name)//'_start',field12)  ; ENDIF
453      IF (PRESENT(field13))  THEN ; CALL  xios_read_field(TRIM(field13(1)%name)//'_start',field13)  ; ENDIF
454      IF (PRESENT(field14))  THEN ; CALL  xios_read_field(TRIM(field14(1)%name)//'_start',field14)  ; ENDIF
455      IF (PRESENT(field15))  THEN ; CALL  xios_read_field(TRIM(field15(1)%name)//'_start',field15)  ; ENDIF
456      IF (PRESENT(field16))  THEN ; CALL  xios_read_field(TRIM(field16(1)%name)//'_start',field16)  ; ENDIF
457      IF (PRESENT(field17))  THEN ; CALL  xios_read_field(TRIM(field17(1)%name)//'_start',field17)  ; ENDIF
458      IF (PRESENT(field18))  THEN ; CALL  xios_read_field(TRIM(field18(1)%name)//'_start',field18)  ; ENDIF
459      IF (PRESENT(field19))  THEN ; CALL  xios_read_field(TRIM(field19(1)%name)//'_start',field19)  ; ENDIF
460
461!      CALL xios_recv_field("it_start",it_real)
462      CALL xios_read_var("it_start",it_real)
463      it=it_real
464    ELSE
465
466    !$OMP MASTER
467
468      nfield=0
469      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
470      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
471      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
472      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
473      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
474      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
475      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
476      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
477      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
478      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
479      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
480      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
481      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
482      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
483      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
484      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
485      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
486      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
487      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
488      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
489     
490       
491
492      IF (is_mpi_root) THEN
493        status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid)
494      ENDIF
495     
496      DO nf=1,nfield
497        field=>field_array(nf)%field
498        status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))
499        status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it)
500        CALL read_start_field(field,fieldId(nf),ncid)
501      ENDDO
502
503
504      IF (is_mpi_root) THEN
505        status = NF90_CLOSE(ncid)     
506      ENDIF
507     
508     !$OMP END MASTER
509   
510    ENDIF
511 
512  END SUBROUTINE read_start
513
514
515  SUBROUTINE read_start_field(field,fieldId,ncid)
516  USE prec
517  USE metric
518  USE field_mod
519  USE domain_mod
520  USE netcdf_mod
521  USE mpipara
522  USE getin_mod
523  USE spherical_geom_mod
524  USE transfert_mod
525  IMPLICIT NONE
526    TYPE(t_field),POINTER :: field(:)
527    INTEGER,INTENT(IN)     :: fieldId
528    INTEGER,INTENT(IN)     :: ncid
529
530    TYPE(t_domain),POINTER :: d
531    TYPE(t_field),POINTER :: field_glo(:)
532    REAL(rstd),ALLOCATABLE :: global_field2d(:)
533    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
534    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
535    INTEGER :: i,j,ij,k,e,ind,ind_glo
536    INTEGER :: ndim, field_type
537    INTEGER :: status
538   
539      ndim=field(1)%ndim
540      field_Type= field(1)%field_type
541     
542      IF (is_mpi_root) THEN
543 
544        IF (ndim==2) THEN
545          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
546        ELSE IF (ndim==3) THEN
547          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
548        ELSE IF (ndim==4) THEN
549          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
550        ENDIF
551      ENDIF
552     
553      IF (is_mpi_root) THEN
554
555        IF (field_type==field_T) THEN
556          IF (ndim==2) THEN
557            ALLOCATE(global_field2d(ncell_glo))
558            status=NF90_GET_VAR(ncid,fieldid, global_field2d, start=(/ 1 /), count=(/ ncell_glo /))
559            DO ind=1,ndomain_glo
560              d=>domain_glo(ind)
561              DO j=d%jj_begin,d%jj_end
562                DO i=d%ii_begin,d%ii_end
563                    ij=(j-1)*d%iim+i
564                    ind_glo=d%assign_cell_glo(i,j)
565                    field_glo(ind)%rval2d(ij)=global_field2d(ind_glo)
566                ENDDO
567              ENDDO
568            ENDDO
569         
570          ELSE IF (ndim==3) THEN
571            ALLOCATE(global_field3d(ncell_glo,llm))
572            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
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)%rval3d(ij,:) = global_field3d(ind_glo,:)
580                ENDDO
581              ENDDO
582            ENDDO
583          ELSE IF (ndim==4) THEN
584            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
585            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
586            DO ind=1,ndomain_glo
587              d=>domain_glo(ind)
588              DO j=d%jj_begin,d%jj_end
589                DO i=d%ii_begin,d%ii_end
590                  ij=(j-1)*d%iim+i
591                  ind_glo=d%assign_cell_glo(i,j)
592                  field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:)
593                ENDDO
594              ENDDO
595            ENDDO
596          ENDIF
597       
598        ELSE IF (field_type==field_U) THEN
599       
600          IF (ndim==2) THEN
601            ALLOCATE(global_field2d(3*ncell_glo))
602            status=NF90_GET_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ 3*ncell_glo /))
603
604            DO ind=1,ndomain_glo
605              d=>domain_glo(ind)
606              DO j=d%jj_begin,d%jj_end
607                DO i=d%ii_begin,d%ii_end
608                  DO k=0,5
609                    ij=(j-1)*d%iim+i
610                    ind_glo=d%assign_cell_glo(i,j)
611                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
612                    field_glo(ind)%rval2d(ij+d%u_pos(k))= global_field2d(ind_glo)*d%edge_assign_sign(k,i,j)
613                  ENDDO
614                ENDDO
615              ENDDO
616            ENDDO
617          ELSE IF (ndim==3) THEN
618            ALLOCATE(global_field3d(3*ncell_glo,llm))
619            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
620            DO ind=1,ndomain_glo
621              d=>domain_glo(ind)
622              DO j=d%jj_begin,d%jj_end
623                DO i=d%ii_begin,d%ii_end
624                  DO k=0,5
625                    ij=(j-1)*d%iim+i
626                    ind_glo=d%assign_cell_glo(i,j)
627                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
628                    field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j)
629                  ENDDO
630                ENDDO
631              ENDDO
632            ENDDO
633          ELSE IF (ndim==4) THEN
634            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
635            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
636            DO ind=1,ndomain_glo
637              d=>domain_glo(ind)
638              DO j=d%jj_begin,d%jj_end
639                DO i=d%ii_begin,d%ii_end
640                  DO k=0,5
641                    ij=(j-1)*d%iim+i
642                    ind_glo=d%assign_cell_glo(i,j)
643                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
644                    field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j)
645                  ENDDO
646                ENDDO
647              ENDDO
648            ENDDO
649          ENDIF
650
651        ENDIF
652      ENDIF
653     
654      CALL scatter_field(field_glo,field)
655       
656      IF (is_mpi_root) THEN
657        CALL deallocate_field_glo(field_glo)
658      ENDIF
659     
660     
661  END SUBROUTINE read_start_field     
662   
663END MODULE restart_mod
664 
Note: See TracBrowser for help on using the repository browser.