source: codes/icosagcm/devel/src/output/restart.f90 @ 912

Last change on this file since 912 was 912, checked in by dubos, 5 years ago

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