source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/DYNAMICO/src/output/restart.f90 @ 6612

Last change on this file since 6612 was 6612, checked in by acosce, 10 months ago

DYNAMICO used for ICOLMDZORINCA_CO2_Transport_GMD_2023
File size: 35.5 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 :: is_write_start=.TRUE.
9  LOGICAL,SAVE :: is_read_start=.FALSE.
10  LOGICAL,SAVE :: is_read_interp=.FALSE.
11 
12CONTAINS
13 
14  SUBROUTINE set_write_start(flag)
15    LOGICAL :: flag
16    is_write_start=flag
17  END SUBROUTINE set_write_start
18 
19  SUBROUTINE set_read_start(flag)
20    LOGICAL :: flag
21    is_read_start=flag
22  END SUBROUTINE set_read_start
23
24  SUBROUTINE set_read_interp(flag)
25    LOGICAL :: flag
26    is_read_interp=flag
27  END SUBROUTINE set_read_interp
28
29
30  SUBROUTINE init_restart
31  USE xios_mod
32  USE icosa
33  USE time_mod
34  USE omp_para
35  USE tracer_icosa_mod
36  USE netcdf_mod
37  IMPLICIT NONE
38  CHARACTER(LEN=255) :: start_file_name
39  CHARACTER(LEN=255) :: restart_file_name
40  TYPE(xios_fieldgroup) :: tracers_restart
41  TYPE(xios_fieldgroup) :: tracers_start
42  TYPE(xios_fieldgroup) :: tracers_start_interp_read
43  TYPE(xios_fieldgroup) :: tracers_start_interp
44  TYPE(xios_field)      :: tracer_restart
45  TYPE(xios_field)      :: tracer_start
46  TYPE(xios_field)      :: tracer_start_interp_read
47  TYPE(xios_field)      :: tracer_start_interp
48  INTEGER               :: iq
49  LOGICAL               :: file_exist
50  INTEGER               :: status
51  INTEGER               :: ncid, varid
52 
53    IF (using_xios) THEN
54      start_file_name="start"
55      CALL getin("start_file_name",start_file_name)
56      restart_file_name="restart"
57      CALL getin("restart_file_name",restart_file_name)
58      IF (is_omp_master) THEN
59        CALL xios_set_file_attr("restart",name=TRIM(ADJUSTL(restart_file_name)),output_freq=itaumax*xios_timestep)
60        CALL xios_set_fieldgroup_attr("group_restart", freq_op=itaumax*xios_timestep)
61        CALL xios_get_handle("tracers_restart",tracers_restart)
62        IF (nqtot==0) CALL xios_set_field_attr("q_restart",enabled=.FALSE.)
63        DO iq=1,nqtot
64          CALL xios_add_child(tracers_restart,tracer_restart,TRIM(tracers(iq)%name)//"_restart")
65          CALL xios_set_attr(tracer_restart, name=TRIM(tracers(iq)%name))
66        ENDDO
67       
68        IF (is_write_start) THEN
69          CALL xios_set_file_attr("start0", enabled=.TRUE., output_freq=1*xios_timestep,name=TRIM(ADJUSTL(start_file_name))//"0")
70          CALL xios_get_handle("tracers_start0",tracers_start)
71          IF (nqtot==0) CALL xios_set_field_attr("q_start0",enabled=.FALSE.)
72          DO iq=1,nqtot
73            CALL xios_add_child(tracers_start,tracer_start,TRIM(tracers(iq)%name)//"_start0")
74            CALL xios_set_attr(tracer_start, name=TRIM(tracers(iq)%name))
75          ENDDO
76        ENDIF
77       
78        IF (is_read_start) THEN
79          IF (is_read_interp) THEN
80            CALL xios_set_file_attr("start_interp", enabled=.TRUE., output_freq=(itaumax+1)*xios_timestep, name=TRIM(ADJUSTL(start_file_name)))
81            CALL xios_set_fieldgroup_attr("start_interp", read_access=.TRUE.)
82            status = NF90_OPEN(TRIM(start_file_name)//'.nc', NF90_NOWRITE, ncid)
83            CALL xios_get_handle("tracers_start_interp_read",tracers_start_interp_read)
84            CALL xios_get_handle("tracers_start_interp",tracers_start_interp)
85            DO iq=1,nqtot
86              status = NF90_INQ_VARID(ncid, TRIM(tracers(iq)%name), varid)
87              IF (status == NF90_NOERR) THEN
88                CALL xios_add_child(tracers_start_interp_read,tracer_start_interp_read,TRIM(tracers(iq)%name)//"_start_interp_read")
89                CALL xios_add_child(tracers_start_interp,tracer_start_interp,TRIM(tracers(iq)%name)//"_start_interp")
90                CALL xios_set_attr(tracer_start_interp_read, name=TRIM(tracers(iq)%name))
91                CALL xios_set_attr(tracer_start_interp, field_ref=TRIM(tracers(iq)%name)//"_start_interp_read")
92              ENDIF 
93            ENDDO
94            status = NF90_CLOSE(ncid)
95          ELSE
96            CALL xios_set_file_attr("start", enabled=.TRUE., output_freq=(itaumax+1)*xios_timestep, name=TRIM(ADJUSTL(start_file_name)))
97            status = NF90_OPEN(TRIM(start_file_name)//'.nc', NF90_NOWRITE, ncid)
98            CALL xios_get_handle("tracers_start",tracers_start)
99            DO iq=1,nqtot
100              status = NF90_INQ_VARID(ncid, TRIM(tracers(iq)%name), varid)
101              IF (status == NF90_NOERR) THEN
102                CALL xios_add_child(tracers_start,tracer_start,TRIM(tracers(iq)%name)//"_start")
103                CALL xios_set_attr(tracer_start, name=TRIM(tracers(iq)%name))
104              ENDIF 
105            ENDDO
106            status = NF90_CLOSE(ncid)
107          ENDIF
108        ENDIF
109      ENDIF
110    ENDIF
111   
112  END SUBROUTINE init_restart
113 
114 
115  SUBROUTINE write_restart(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   &
116                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
117  USE prec
118  USE metric
119  USE field_mod
120  USE domain_mod
121  USE netcdf_mod
122  USE mpipara
123  USE omp_para
124  USE getin_mod
125  USE spherical_geom_mod
126  USE transfert_mod
127  USE disvert_mod
128  USE xios_mod
129  IMPLICIT NONE
130  INTEGER,INTENT(IN)     :: it
131
132  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
133  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
134
135  TYPE(t_field_array) :: field_array(20)
136  INTEGER             :: nfield
137  INTEGER             :: fieldId(20)
138   
139  TYPE(t_domain),POINTER :: d
140  TYPE(t_field),POINTER :: field(:)
141 
142  CHARACTER(LEN=255) :: file_name
143  CHARACTER(LEN=255) :: suffix
144  INTEGER,PARAMETER  :: nvert=6
145  INTEGER    ::  ncid, cellId, levId, edgeId,  vertid, lonId, latId, bounds_lonId, bounds_latId, nqId, levAxisId
146  INTEGER    :: ind,ind_glo,i,j,k,nf
147  INTEGER    :: status
148  REAL(rstd),ALLOCATABLE :: lon(:),lat(:),bounds_lon(:,:),bounds_lat(:,:)
149   
150    IF (no_io) RETURN
151   
152    IF (it==itau0 .AND. is_write_start) THEN
153      file_name="start"
154      CALL getin("start_file_name",file_name)
155      suffix="_start0"
156    ELSE
157      file_name="restart"
158      CALL getin("restart_file_name",file_name)
159      suffix="_restart"
160    ENDIF 
161     
162    IF (using_xios) THEN
163      IF (PRESENT(field0))  THEN ; CALL  write_xios_restart_field(TRIM(field0(1)%name),suffix,field0)  ; ENDIF
164      IF (PRESENT(field1))  THEN ; CALL  write_xios_restart_field(TRIM(field1(1)%name),suffix,field1)  ; ENDIF
165      IF (PRESENT(field2))  THEN ; CALL  write_xios_restart_field(TRIM(field2(1)%name),suffix,field2)  ; ENDIF
166      IF (PRESENT(field3))  THEN ; CALL  write_xios_restart_field(TRIM(field3(1)%name),suffix,field3)  ; ENDIF
167      IF (PRESENT(field4))  THEN ; CALL  write_xios_restart_field(TRIM(field4(1)%name),suffix,field4)  ; ENDIF
168      IF (PRESENT(field5))  THEN ; CALL  write_xios_restart_field(TRIM(field5(1)%name),suffix,field5)  ; ENDIF
169      IF (PRESENT(field6))  THEN ; CALL  write_xios_restart_field(TRIM(field6(1)%name),suffix,field6)  ; ENDIF
170      IF (PRESENT(field7))  THEN ; CALL  write_xios_restart_field(TRIM(field7(1)%name),suffix,field7)  ; ENDIF
171      IF (PRESENT(field8))  THEN ; CALL  write_xios_restart_field(TRIM(field8(1)%name),suffix,field8)  ; ENDIF
172      IF (PRESENT(field9))  THEN ; CALL  write_xios_restart_field(TRIM(field9(1)%name),suffix,field9)  ; ENDIF
173      IF (PRESENT(field10))  THEN ; CALL  write_xios_restart_field(TRIM(field10(1)%name),suffix,field10)  ; ENDIF
174      IF (PRESENT(field11))  THEN ; CALL  write_xios_restart_field(TRIM(field11(1)%name),suffix,field11)  ; ENDIF
175      IF (PRESENT(field12))  THEN ; CALL  write_xios_restart_field(TRIM(field12(1)%name),suffix,field12)  ; ENDIF
176      IF (PRESENT(field13))  THEN ; CALL  write_xios_restart_field(TRIM(field13(1)%name),suffix,field13)  ; ENDIF
177      IF (PRESENT(field14))  THEN ; CALL  write_xios_restart_field(TRIM(field14(1)%name),suffix,field14)  ; ENDIF
178      IF (PRESENT(field15))  THEN ; CALL  write_xios_restart_field(TRIM(field15(1)%name),suffix,field15)  ; ENDIF
179      IF (PRESENT(field16))  THEN ; CALL  write_xios_restart_field(TRIM(field16(1)%name),suffix,field16)  ; ENDIF
180      IF (PRESENT(field17))  THEN ; CALL  write_xios_restart_field(TRIM(field17(1)%name),suffix,field17)  ; ENDIF
181      IF (PRESENT(field18))  THEN ; CALL  write_xios_restart_field(TRIM(field18(1)%name),suffix,field18)  ; ENDIF
182      IF (PRESENT(field19))  THEN ; CALL  write_xios_restart_field(TRIM(field19(1)%name),suffix,field19)  ; ENDIF
183      IF (is_omp_master) CALL xios_send_field('it'//TRIM(suffix),it*1.0)
184
185    ELSE
186
187    !$OMP MASTER
188     
189      nfield=0
190      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
191      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
192      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
193      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
194      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
195      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
196      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
197      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
198      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
199      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
200      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
201      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
202      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
203      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
204      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
205      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
206      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
207      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
208      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
209      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
210     
211       
212
213      IF (is_mpi_root) THEN
214        status = NF90_CREATE(TRIM(ADJUSTL(file_name))//'.nc', NF90_CLOBBER, ncid)
215        status = NF90_DEF_DIM(ncid,'cell',ncell_glo,cellId)
216        status = NF90_DEF_DIM(ncid,'edge',3*ncell_glo,edgeId)
217        status = NF90_DEF_DIM(ncid,'lev',llm,levId)
218        status = NF90_DEF_DIM(ncid,'nvert',nvert,vertId)
219        status = NF90_DEF_DIM(ncid,'nq',nqtot,nqId)
220        status = NF90_PUT_ATT(ncid,NF90_GLOBAL,"iteration",it)
221       
222        status = NF90_DEF_VAR(ncid,'lon',NF90_DOUBLE,(/ cellId /),lonId)
223        status = NF90_PUT_ATT(ncid,lonId,"long_name","longitude")
224        status = NF90_PUT_ATT(ncid,lonId,"units","degrees_east")
225        status = NF90_PUT_ATT(ncid,lonId,"bounds","bounds_lon")
226        status = NF90_DEF_VAR(ncid,'lat',NF90_DOUBLE,(/ cellId /),latId)
227        status = NF90_PUT_ATT(ncid,latId,"long_name","latitude")
228        status = NF90_PUT_ATT(ncid,latId,"units","degrees_north")
229        status = NF90_PUT_ATT(ncid,latId,"bounds","bounds_lat")
230        status = NF90_DEF_VAR(ncid,'bounds_lon',NF90_DOUBLE,(/ vertId,cellId /),bounds_lonId)
231        status = NF90_DEF_VAR(ncid,'bounds_lat',NF90_DOUBLE,(/ vertId,cellId /),bounds_latId)
232        status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ levId /),levAxisId)
233        status = NF90_PUT_ATT(ncid,levAxisId,"axis","Z")
234        status = NF90_PUT_ATT(ncid,levAxisId,"units","Pa")
235        status = NF90_PUT_ATT(ncid,levAxisId,"positive","down")
236       
237        DO nf=1,nfield
238          field=>field_array(nf)%field
239          IF (field(1)%field_type==field_T) THEN
240            IF (field(1)%ndim==2) THEN
241              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId /),fieldId(nf))
242              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lon lat")
243            ELSE IF (field(1)%ndim==3) THEN
244              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId /),fieldId(nf))
245              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","lev lon lat")
246            ELSE IF (field(1)%ndim==4) THEN
247              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ cellId, levId,nqId /),fieldId(nf))
248              status = NF90_PUT_ATT(ncid,FieldId(nf),"coordinates","nq lev lon lat")
249            ENDIF
250          ELSE IF (field(1)%field_type==field_U) THEN
251            IF (field(1)%ndim==2) THEN
252              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId /),fieldId(nf))
253            ELSE IF (field(1)%ndim==3) THEN
254              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId /),fieldId(nf))
255            ELSE IF (field(1)%ndim==4) THEN
256              status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name)),NF90_DOUBLE,(/ edgeId, levId, nqId /),fieldId(nf))
257            ENDIF
258          ENDIF
259        ENDDO
260           
261       
262        status = NF90_ENDDEF(ncid)
263       
264        ALLOCATE(lon(ncell_glo),lat(ncell_glo),bounds_lon(0:nvert-1,ncell_glo),bounds_lat(0:nvert-1,ncell_glo))
265        DO ind=1,ndomain_glo
266          d=>domain_glo(ind)
267          DO j=d%jj_begin,d%jj_end
268            DO i=d%ii_begin,d%ii_end
269               ind_glo=d%assign_cell_glo(i,j)
270               CALL xyz2lonlat(d%xyz(:,i,j),lon(ind_glo),lat(ind_glo))
271               lon(ind_glo)=lon(ind_glo)*180/Pi
272               lat(ind_glo)=lat(ind_glo)*180/Pi
273               DO k=0,5
274                   CALL xyz2lonlat(d%vertex(:,k,i,j),bounds_lon(k,ind_glo), bounds_lat(k,ind_glo))
275                   bounds_lat(k,ind_glo)=bounds_lat(k,ind_glo)*180/Pi
276                   bounds_lon(k,ind_glo)=bounds_lon(k,ind_glo)*180/Pi
277               ENDDO
278            ENDDO
279          ENDDO
280        ENDDO
281
282        status=NF90_PUT_VAR(ncid,lonid,REAL(lon,r8),start=(/ 1 /),count=(/ ncell_glo /))
283        status=NF90_PUT_VAR(ncid,latid,REAL(lat,r8),start=(/ 1 /),count=(/ ncell_glo /))
284        status=NF90_PUT_VAR(ncid,bounds_lonId,REAL(bounds_lon,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
285        status=NF90_PUT_VAR(ncid,bounds_latId,REAL(bounds_lat,r8),start=(/ 1,1 /),count=(/ nvert,ncell_glo /))
286        status=NF90_PUT_VAR(ncid,levAxisId,REAL(presnivs,r8),start=(/ 1 /),count=(/ llm /))
287      ENDIF
288
289      DO nf=1,nfield
290        field=>field_array(nf)%field
291        CALL write_restart_field(field,fieldId(nf),ncid)
292      ENDDO
293           
294    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId /),fieldId(nf))
295    !        ELSE IF (field(1)%ndim==3) THEN
296    !          status = NF90_DEF_VAR(ncid,TRIM(ADJUSTL(field(1)%name),NF90_DOUBLE,(/ ncellId, levId /),fieldId(nf))
297    !        ENDIF
298    !      ENDDO
299
300
301      IF (is_mpi_root) THEN
302        status = NF90_CLOSE(ncid)     
303      ENDIF
304   
305    !$OMP END MASTER
306   
307    ENDIF
308 
309  END SUBROUTINE write_restart
310 
311  SUBROUTINE write_xios_restart_field(fieldId, suffix, f_field)
312  USE field_mod
313  USE grid_param
314  USE domain_mod
315  USE xios_mod
316  USE omp_para
317  USE tracer_icosa_mod
318  IMPLICIT NONE
319    CHARACTER(LEN=*),INTENT(IN)        :: fieldId
320    CHARACTER(LEN=*),INTENT(IN)        :: suffix
321    TYPE(t_field),POINTER,SAVE         :: f_tracer(:)
322    TYPE(t_field),POINTER,DIMENSION(:) :: f_field
323    INTEGER                            :: iq,ind,l
324   
325   
326      IF (TRIM(fieldId)=="q") THEN! hook for tracers
327        CALL allocate_field(f_tracer,field_t,type_real,llm)
328        DO iq=1,nqtot
329          DO ind=1,ndomain
330            IF (.NOT. assigned_domain(ind)) CYCLE
331            DO l=ll_begin,ll_end
332              f_tracer(ind)%rval3d(:,l) = f_field(ind)%rval4d(:,l,iq)
333            ENDDO
334          ENDDO
335          CALL xios_write_field(TRIM(tracers(iq)%name)//TRIM(suffix), f_tracer)
336        ENDDO
337        CALL deallocate_field(f_tracer)
338      ELSE
339        CALL xios_write_field(TRIM(fieldId)//TRIM(suffix), f_field)
340      ENDIF
341       
342   END SUBROUTINE write_xios_restart_field
343 
344  SUBROUTINE write_restart_field(field,fieldId,ncid)
345  USE prec
346  USE metric
347  USE grid_param
348  USE field_mod
349  USE domain_mod
350  USE netcdf_mod
351  USE mpipara
352  USE getin_mod
353  USE spherical_geom_mod
354  USE transfert_mod
355  USE xios_mod
356  IMPLICIT NONE
357    TYPE(t_field),POINTER :: field(:)
358    INTEGER,INTENT(IN)     :: fieldId
359    INTEGER,INTENT(IN)     :: ncid
360
361    TYPE(t_domain),POINTER :: d
362    TYPE(t_field),POINTER :: field_glo(:)
363    REAL(rstd),ALLOCATABLE :: global_field2d(:)
364    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
365    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
366    INTEGER :: i,j,ij,k,e,ind,ind_glo
367    INTEGER :: ndim, field_type
368    INTEGER :: status
369   
370      ndim=field(1)%ndim
371      field_Type= field(1)%field_type
372     
373      IF (is_mpi_root) THEN
374 
375        IF (ndim==2) THEN
376          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
377        ELSE IF (ndim==3) THEN
378          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
379        ELSE IF (ndim==4) THEN
380          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
381        ENDIF
382      ENDIF
383     
384      CALL gather_field(field,field_glo)
385     
386
387      IF (is_mpi_root) THEN
388
389        IF (field_type==field_T) THEN
390          IF (ndim==2) THEN
391            ALLOCATE(global_field2d(ncell_glo))
392            DO ind=1,ndomain_glo
393              d=>domain_glo(ind)
394              DO j=d%jj_begin,d%jj_end
395                DO i=d%ii_begin,d%ii_end
396                  IF (d%own(i,j)) THEN
397                    ij=(j-1)*d%iim+i
398                    ind_glo=d%assign_cell_glo(i,j)
399                    global_field2d(ind_glo)=field_glo(ind)%rval2d(ij)
400                  ENDIF
401                ENDDO
402              ENDDO
403            ENDDO
404            status=NF90_PUT_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ ncell_glo /))
405         
406          ELSE IF (ndim==3) THEN
407            ALLOCATE(global_field3d(ncell_glo,llm))
408            DO ind=1,ndomain_glo
409              d=>domain_glo(ind)
410              DO j=d%jj_begin,d%jj_end
411                DO i=d%ii_begin,d%ii_end
412                  IF (d%own(i,j)) THEN
413                    ij=(j-1)*d%iim+i
414                    ind_glo=d%assign_cell_glo(i,j)
415                    global_field3d(ind_glo,:)=field_glo(ind)%rval3d(ij,:)
416                  ENDIF
417                ENDDO
418              ENDDO
419            ENDDO
420            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
421          ELSE IF (ndim==4) THEN
422            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
423            DO ind=1,ndomain_glo
424              d=>domain_glo(ind)
425              DO j=d%jj_begin,d%jj_end
426                DO i=d%ii_begin,d%ii_end
427                  IF (d%own(i,j)) THEN
428                    ij=(j-1)*d%iim+i
429                    ind_glo=d%assign_cell_glo(i,j)
430                    global_field4d(ind_glo,:,:)=field_glo(ind)%rval4d(ij,:,:)
431                  ENDIF
432                ENDDO
433              ENDDO
434            ENDDO
435            status=NF90_PUT_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
436          ENDIF
437       
438        ELSE IF (field_type==field_U) THEN
439       
440          IF (ndim==2) THEN
441            ALLOCATE(global_field2d(3*ncell_glo))
442            global_field2d(:) = 0
443            DO ind=1,ndomain_glo
444              d=>domain_glo(ind)
445              DO j=d%jj_begin,d%jj_end
446                DO i=d%ii_begin,d%ii_end
447                  DO k=0,5
448                   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 &
449                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
450                       ij=(j-1)*d%iim+i
451                      ind_glo=d%assign_cell_glo(i,j)
452                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
453                      global_field2d(e)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval2d(ij+d%u_pos(k))
454                    ENDIF
455                  ENDDO
456                ENDDO
457              ENDDO
458            ENDDO
459            status=NF90_PUT_VAR(ncid,fieldid,REAL(global_field2d,r8),start=(/ 1 /),count=(/ 3*ncell_glo /))
460          ELSE IF (ndim==3) THEN
461            ALLOCATE(global_field3d(3*ncell_glo,llm))
462            global_field3d(:,:) = 0 
463            DO ind=1,ndomain_glo
464              d=>domain_glo(ind)
465              DO j=d%jj_begin,d%jj_end
466                DO i=d%ii_begin,d%ii_end
467                  DO k=0,5
468                   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 &
469                     .AND. d%edge_assign_pos(k,i,j)==k) THEN
470                       ij=(j-1)*d%iim+i
471                      ind_glo=d%assign_cell_glo(i,j)
472                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
473                      global_field3d(e,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)
474                    ENDIF
475                  ENDDO
476                ENDDO
477              ENDDO
478            ENDDO
479            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
480          ELSE IF (ndim==4) THEN
481            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
482            global_field4d(:,:,:) = 0
483            DO ind=1,ndomain_glo
484              d=>domain_glo(ind)
485              DO j=d%jj_begin,d%jj_end
486                DO i=d%ii_begin,d%ii_end
487                  DO k=0,5
488                    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&
489                      .AND. d%edge_assign_pos(k,i,j)==k) THEN
490                      ij=(j-1)*d%iim+i
491                      ind_glo=d%assign_cell_glo(i,j)
492                      e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
493                      global_field4d(e,:,:)=d%edge_assign_sign(k,i,j)*field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)
494                    ENDIF
495                  ENDDO
496                ENDDO
497              ENDDO
498            ENDDO
499            status=NF90_PUT_VAR(ncid,fieldid,global_field3d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
500          ENDIF
501
502        ENDIF
503       
504        CALL deallocate_field_glo(field_glo)
505     
506      ENDIF
507     
508     
509  END SUBROUTINE write_restart_field
510
511
512  SUBROUTINE read_start(it,field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9,   &
513                           field10,field11,field12,field13,field14,field15,field16,field17,field18,field19 )
514  USE prec
515  USE metric
516  USE grid_param
517  USE field_mod
518  USE domain_mod
519  USE netcdf_mod
520  USE mpipara
521  USE getin_mod
522  USE spherical_geom_mod
523  USE transfert_mod
524  USE xios_mod
525 
526  IMPLICIT NONE
527  INTEGER, OPTIONAL, INTENT(OUT)  :: it
528  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field0 ,field1 ,field2 ,field3 ,field4 ,field5 ,field6 ,field7 ,field8 ,field9
529  TYPE(t_field),POINTER,OPTIONAL,DIMENSION(:) :: field10,field11,field12,field13,field14,field15,field16,field17,field18,field19
530
531  TYPE(t_field_array) :: field_array(20)
532  INTEGER             :: nfield
533  INTEGER             :: fieldId(20)
534   
535  TYPE(t_field),POINTER :: field(:)
536 
537  CHARACTER(LEN=255) :: start_file_name
538  INTEGER,PARAMETER  :: nvert=6
539  INTEGER    ::  ncid
540  INTEGER    :: nf
541  INTEGER    :: status
542  REAL(rstd) :: it_real
543  CHARACTER(LEN=255) :: suffix
544    IF (no_io) RETURN
545   
546    start_file_name="start"
547    CALL getin("start_file_name",start_file_name)
548
549    IF (is_read_interp) THEN
550      suffix="_start_interp"
551    ELSE
552      suffix="_start"
553    ENDIF
554
555    IF (using_xios) THEN
556      IF (PRESENT(field0))  THEN ; CALL  read_xios_start_field(TRIM(field0(1)%name), TRIM(suffix), field0)  ; ENDIF
557      IF (PRESENT(field1))  THEN ; CALL  read_xios_start_field(TRIM(field1(1)%name), TRIM(suffix), field1)  ; ENDIF
558      IF (PRESENT(field2))  THEN ; CALL  read_xios_start_field(TRIM(field2(1)%name), TRIM(suffix), field2)  ; ENDIF
559      IF (PRESENT(field3))  THEN ; CALL  read_xios_start_field(TRIM(field3(1)%name), TRIM(suffix), field3)  ; ENDIF
560      IF (PRESENT(field4))  THEN ; CALL  read_xios_start_field(TRIM(field4(1)%name), TRIM(suffix), field4)  ; ENDIF
561      IF (PRESENT(field5))  THEN ; CALL  read_xios_start_field(TRIM(field5(1)%name), TRIM(suffix), field5)  ; ENDIF
562      IF (PRESENT(field6))  THEN ; CALL  read_xios_start_field(TRIM(field6(1)%name), TRIM(suffix), field6)  ; ENDIF
563      IF (PRESENT(field7))  THEN ; CALL  read_xios_start_field(TRIM(field7(1)%name), TRIM(suffix), field7)  ; ENDIF
564      IF (PRESENT(field8))  THEN ; CALL  read_xios_start_field(TRIM(field8(1)%name), TRIM(suffix), field8)  ; ENDIF
565      IF (PRESENT(field9))  THEN ; CALL  read_xios_start_field(TRIM(field9(1)%name), TRIM(suffix), field9)  ; ENDIF
566      IF (PRESENT(field10))  THEN ; CALL  read_xios_start_field(TRIM(field10(1)%name), TRIM(suffix), field10)  ; ENDIF
567      IF (PRESENT(field11))  THEN ; CALL  read_xios_start_field(TRIM(field11(1)%name), TRIM(suffix), field11)  ; ENDIF
568      IF (PRESENT(field12))  THEN ; CALL  read_xios_start_field(TRIM(field12(1)%name), TRIM(suffix), field12)  ; ENDIF
569      IF (PRESENT(field13))  THEN ; CALL  read_xios_start_field(TRIM(field13(1)%name), TRIM(suffix), field13)  ; ENDIF
570      IF (PRESENT(field14))  THEN ; CALL  read_xios_start_field(TRIM(field14(1)%name), TRIM(suffix), field14)  ; ENDIF
571      IF (PRESENT(field15))  THEN ; CALL  read_xios_start_field(TRIM(field15(1)%name), TRIM(suffix), field15)  ; ENDIF
572      IF (PRESENT(field16))  THEN ; CALL  read_xios_start_field(TRIM(field16(1)%name), TRIM(suffix), field16)  ; ENDIF
573      IF (PRESENT(field17))  THEN ; CALL  read_xios_start_field(TRIM(field17(1)%name), TRIM(suffix), field17)  ; ENDIF
574      IF (PRESENT(field18))  THEN ; CALL  read_xios_start_field(TRIM(field18(1)%name), TRIM(suffix), field18)  ; ENDIF
575      IF (PRESENT(field19))  THEN ; CALL  read_xios_start_field(TRIM(field19(1)%name), TRIM(suffix), field19)  ; ENDIF
576
577!      CALL xios_recv_field("it_start",it_real)
578      IF (PRESENT(it)) THEN
579        CALL xios_read_var("it"//TRIM(suffix),it_real)
580        it=INT(it_real)
581      ENDIF
582      RETURN
583    ELSE
584
585    !$OMP MASTER
586
587      nfield=0
588      IF (PRESENT(field0))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field0  ; ENDIF
589      IF (PRESENT(field1))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field1  ; ENDIF
590      IF (PRESENT(field2))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field2  ; ENDIF
591      IF (PRESENT(field3))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field3  ; ENDIF
592      IF (PRESENT(field4))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field4  ; ENDIF
593      IF (PRESENT(field5))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field5  ; ENDIF
594      IF (PRESENT(field6))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field6  ; ENDIF
595      IF (PRESENT(field7))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field7  ; ENDIF
596      IF (PRESENT(field8))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field8  ; ENDIF
597      IF (PRESENT(field9))  THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field9  ; ENDIF
598      IF (PRESENT(field10)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field10 ; ENDIF
599      IF (PRESENT(field11)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field11 ; ENDIF
600      IF (PRESENT(field12)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field12 ; ENDIF
601      IF (PRESENT(field13)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field13 ; ENDIF
602      IF (PRESENT(field14)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field14 ; ENDIF
603      IF (PRESENT(field15)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field15 ; ENDIF
604      IF (PRESENT(field16)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field16 ; ENDIF
605      IF (PRESENT(field17)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field17 ; ENDIF
606      IF (PRESENT(field18)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field18 ; ENDIF
607      IF (PRESENT(field19)) THEN ; nfield=nfield+1 ; field_array(nfield)%field=>field19 ; ENDIF
608     
609       
610
611      IF (is_mpi_root) THEN
612        status = NF90_OPEN(TRIM(ADJUSTL(start_file_name))//'.nc', NF90_NOWRITE, ncid)
613      ENDIF
614     
615      DO nf=1,nfield
616        field=>field_array(nf)%field
617        status = nf90_inq_varid(ncid, TRIM(ADJUSTL(field(1)%name)), fieldId(nf))
618        status = nf90_get_att(ncid, NF90_GLOBAL, "iteration", it)
619        CALL read_start_field(field,fieldId(nf),ncid)
620      ENDDO
621
622
623      IF (is_mpi_root) THEN
624        status = NF90_CLOSE(ncid)     
625      ENDIF
626     
627     !$OMP END MASTER
628   
629    ENDIF
630 
631  END SUBROUTINE read_start
632
633  SUBROUTINE read_xios_start_field(fieldId, suffix, f_field)
634  USE field_mod
635  USE grid_param
636  USE domain_mod
637  USE xios_mod
638  USE omp_para
639  USE tracer_icosa_mod
640  IMPLICIT NONE
641    CHARACTER(LEN=*),INTENT(IN)        :: fieldId
642    CHARACTER(LEN=*),INTENT(IN)        :: suffix
643    TYPE(t_field),POINTER,SAVE         :: f_tracer(:)
644    TYPE(t_field),POINTER,DIMENSION(:) :: f_field
645    INTEGER                            :: iq,ind,l
646   
647   
648      IF (TRIM(fieldId)=="q") THEN! hook for tracers
649        CALL allocate_field(f_tracer,field_t,type_real,llm)
650       
651        DO iq=1,nqtot
652          IF (xios_is_valid_field(TRIM(tracers(iq)%name)//TRIM(suffix))) THEN
653            CALL xios_read_field(TRIM(tracers(iq)%name)//TRIM(suffix), f_tracer)
654            DO ind=1,ndomain
655              IF (.NOT. assigned_domain(ind)) CYCLE
656              DO l=ll_begin,ll_end
657                f_field(ind)%rval4d(:,l,iq) = f_tracer(ind)%rval3d(:,l)
658              ENDDO
659            ENDDO
660            tracers(iq)%already_initialized=.TRUE.
661          ELSE
662            IF (.NOT. tracers(iq)%already_initialized .AND. tracers(iq)%has_default_init_value) THEN
663              DO ind=1,ndomain
664                IF (.NOT. assigned_domain(ind)) CYCLE
665                DO l=ll_begin,ll_end
666                  f_field(ind)%rval4d(:,l,iq) = tracers(iq)%default_init_value
667                ENDDO
668              ENDDO 
669              tracers(iq)%already_initialized=.TRUE.
670            ENDIF
671          ENDIF
672        ENDDO
673        CALL deallocate_field(f_tracer)
674      ELSE
675        CALL xios_read_field(TRIM(fieldId)//TRIM(suffix), f_field)
676      ENDIF
677       
678   END SUBROUTINE read_xios_start_field
679
680  SUBROUTINE read_start_field(field,fieldId,ncid)
681  USE prec
682  USE metric
683  USE grid_param
684  USE field_mod
685  USE domain_mod
686  USE netcdf_mod
687  USE mpipara
688  USE getin_mod
689  USE spherical_geom_mod
690  USE transfert_mod
691  IMPLICIT NONE
692    TYPE(t_field),POINTER :: field(:)
693    INTEGER,INTENT(IN)     :: fieldId
694    INTEGER,INTENT(IN)     :: ncid
695
696    TYPE(t_domain),POINTER :: d
697    TYPE(t_field),POINTER :: field_glo(:)
698    REAL(rstd),ALLOCATABLE :: global_field2d(:)
699    REAL(rstd),ALLOCATABLE :: global_field3d(:,:)
700    REAL(rstd),ALLOCATABLE :: global_field4d(:,:,:)
701    INTEGER :: i,j,ij,k,e,ind,ind_glo
702    INTEGER :: ndim, field_type
703    INTEGER :: status
704   
705      ndim=field(1)%ndim
706      field_Type= field(1)%field_type
707     
708      IF (is_mpi_root) THEN
709 
710        IF (ndim==2) THEN
711          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,name=field(1)%name)
712        ELSE IF (ndim==3) THEN
713          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,name=field(1)%name)
714        ELSE IF (ndim==4) THEN
715          CALL allocate_field_glo(field_glo,field(1)%field_type,field(1)%data_type,field(1)%dim3,field(1)%dim4,name=field(1)%name)
716        ENDIF
717      ENDIF
718     
719      IF (is_mpi_root) THEN
720
721        IF (field_type==field_T) THEN
722          IF (ndim==2) THEN
723            ALLOCATE(global_field2d(ncell_glo))
724            status=NF90_GET_VAR(ncid,fieldid, global_field2d, start=(/ 1 /), count=(/ ncell_glo /))
725            DO ind=1,ndomain_glo
726              d=>domain_glo(ind)
727              DO j=d%jj_begin,d%jj_end
728                DO i=d%ii_begin,d%ii_end
729                    ij=(j-1)*d%iim+i
730                    ind_glo=d%assign_cell_glo(i,j)
731                    field_glo(ind)%rval2d(ij)=global_field2d(ind_glo)
732                ENDDO
733              ENDDO
734            ENDDO
735         
736          ELSE IF (ndim==3) THEN
737            ALLOCATE(global_field3d(ncell_glo,llm))
738            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ ncell_glo,llm /))
739            DO ind=1,ndomain_glo
740              d=>domain_glo(ind)
741              DO j=d%jj_begin,d%jj_end
742                DO i=d%ii_begin,d%ii_end
743                  ij=(j-1)*d%iim+i
744                  ind_glo=d%assign_cell_glo(i,j)
745                  field_glo(ind)%rval3d(ij,:) = global_field3d(ind_glo,:)
746                ENDDO
747              ENDDO
748            ENDDO
749          ELSE IF (ndim==4) THEN
750            ALLOCATE(global_field4d(ncell_glo,llm,nqtot))
751            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ ncell_glo,llm,nqtot /))
752            DO ind=1,ndomain_glo
753              d=>domain_glo(ind)
754              DO j=d%jj_begin,d%jj_end
755                DO i=d%ii_begin,d%ii_end
756                  ij=(j-1)*d%iim+i
757                  ind_glo=d%assign_cell_glo(i,j)
758                  field_glo(ind)%rval4d(ij,:,:) = global_field4d(ind_glo,:,:)
759                ENDDO
760              ENDDO
761            ENDDO
762          ENDIF
763       
764        ELSE IF (field_type==field_U) THEN
765       
766          IF (ndim==2) THEN
767            ALLOCATE(global_field2d(3*ncell_glo))
768            status=NF90_GET_VAR(ncid,fieldid,global_field2d,start=(/ 1 /),count=(/ 3*ncell_glo /))
769
770            DO ind=1,ndomain_glo
771              d=>domain_glo(ind)
772              DO j=d%jj_begin,d%jj_end
773                DO i=d%ii_begin,d%ii_end
774                  DO k=0,5
775                    ij=(j-1)*d%iim+i
776                    ind_glo=d%assign_cell_glo(i,j)
777                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
778                    field_glo(ind)%rval2d(ij+d%u_pos(k))= global_field2d(ind_glo)*d%edge_assign_sign(k,i,j)
779                  ENDDO
780                ENDDO
781              ENDDO
782            ENDDO
783          ELSE IF (ndim==3) THEN
784            ALLOCATE(global_field3d(3*ncell_glo,llm))
785            status=NF90_GET_VAR(ncid,fieldid,global_field3d,start=(/ 1,1 /),count=(/ 3*ncell_glo,llm /))
786            DO ind=1,ndomain_glo
787              d=>domain_glo(ind)
788              DO j=d%jj_begin,d%jj_end
789                DO i=d%ii_begin,d%ii_end
790                  DO k=0,5
791                    ij=(j-1)*d%iim+i
792                    ind_glo=d%assign_cell_glo(i,j)
793                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
794                    field_glo(ind)%rval3d(ij+d%u_pos(k+1),:)=global_field3d(e,:)*d%edge_assign_sign(k,i,j)
795                  ENDDO
796                ENDDO
797              ENDDO
798            ENDDO
799          ELSE IF (ndim==4) THEN
800            ALLOCATE(global_field4d(3*ncell_glo,llm,nqtot))
801            status=NF90_GET_VAR(ncid,fieldid,global_field4d,start=(/ 1,1,1 /),count=(/ 3*ncell_glo,llm,nqtot /))
802            DO ind=1,ndomain_glo
803              d=>domain_glo(ind)
804              DO j=d%jj_begin,d%jj_end
805                DO i=d%ii_begin,d%ii_end
806                  DO k=0,5
807                    ij=(j-1)*d%iim+i
808                    ind_glo=d%assign_cell_glo(i,j)
809                    e=cell_glo(ind_glo)%edge(MOD(k+d%delta(i,j)+6,6)) 
810                    field_glo(ind)%rval4d(ij+d%u_pos(k+1),:,:)=global_field4d(e,:,:)*d%edge_assign_sign(k,i,j)
811                  ENDDO
812                ENDDO
813              ENDDO
814            ENDDO
815          ENDIF
816
817        ENDIF
818      ENDIF
819     
820      CALL scatter_field(field_glo,field)
821       
822      IF (is_mpi_root) THEN
823        CALL deallocate_field_glo(field_glo)
824      ENDIF
825     
826     
827  END SUBROUTINE read_start_field     
828   
829END MODULE restart_mod
830 
Note: See TracBrowser for help on using the repository browser.