Oasis3-MCT
mod_oasis_io.F90
Go to the documentation of this file.
1 
2 !> Provides reusable IO routines for OASIS
3 
4 MODULE mod_oasis_io
5 
6  USE mod_oasis_kinds
7  USE mod_oasis_data
8  USE mod_oasis_parameters
9  USE mod_oasis_mpi
10  USE mod_oasis_sys
11  USE mod_oasis_ioshr
12  USE mct_mod
13  USE netcdf
14 
15  implicit none
16 
17  private
18 
19  !--- interfaces ---
20  public :: oasis_io_varexists
21  public :: oasis_io_read_avfld
22  public :: oasis_io_read_avfile
23  public :: oasis_io_write_avfile
24  public :: oasis_io_read_array
25  public :: oasis_io_write_array
26  public :: oasis_io_read_avfbf
27  public :: oasis_io_write_avfbf
28  public :: oasis_io_write_2dgridint_fromroot
29  public :: oasis_io_write_2dgridfld_fromroot
30  public :: oasis_io_write_3dgridfld_fromroot
31  public :: oasis_io_read_field_fromroot
32 
33 !===========================================================================
34 CONTAINS
35 !===========================================================================
36 
37 !===============================================================================
38 
39 !> Checks whether the var fldname is in the file
40 
41 logical function oasis_io_varexists(filename,fldname)
42 
43  implicit none
44 
45  character(len=*), intent(in) :: filename !< filename
46  character(len=*), intent(in) :: fldname !< fldname
47 
48  !--- local ---
49  logical :: exists ! file exist flag
50  integer(ip_i4_p) :: ncid ! netcf file id
51  integer(ip_i4_p) :: varid ! netcf variable id
52  integer(ip_i4_p) :: status ! error code
53  character(len=*),parameter :: subname = '(oasis_io_varexists)'
54 
55 !-------------------------------------------------------------------------------
56  call oasis_debug_enter(subname)
57 
58  oasis_io_varexists = .false.
59  inquire(file=trim(filename),exist=exists)
60  if (exists) then
61  status = nf90_open(filename,nf90_nowrite,ncid)
62  status = nf90_inq_varid(ncid,trim(fldname),varid)
63  if (status == nf90_noerr) then
64  oasis_io_varexists = .true.
65  endif
66  status = nf90_close(ncid)
67  endif
68 
69  call oasis_debug_exit(subname)
70 
71 end function oasis_io_varexists
72 
73 !===============================================================================
74 
75 !> Reads single field from a file into an attribute Vector
76 
77 subroutine oasis_io_read_avfld(filename,av,gsmap,mpicom,avfld,filefld,fldtype)
78 
79  implicit none
80 
81  character(len=*), intent(in) :: filename !< file name
82  type(mct_avect) , intent(inout) :: av !< avect
83  type(mct_gsmap) , intent(in) :: gsmap !< gsmap decomp
84  integer(ip_i4_p), intent(in) :: mpicom !< mpi comm
85  character(len=*), intent(in) :: avfld !< av field name
86  character(len=*), intent(in) :: filefld !< file field name
87  character(len=*), intent(in),optional :: fldtype !< kind
88 
89  !--- local ---
90  integer(ip_i4_p) :: n,n1,i,j,fk,fk1 ! index
91  integer(ip_i4_p) :: nx ! 2d global size nx
92  integer(ip_i4_p) :: ny ! 2d global size ny
93  type(mct_avect) :: av_g ! avect global data
94  integer(ip_i4_p) :: master_task,iam,ierr ! mpi info
95  integer(ip_i4_p) :: ncid,dimid,dimid2(2),varid ! netcdf info
96  integer(ip_i4_p) :: dlen ! dimension length
97  integer(ip_i4_p) :: status ! error code
98  logical :: exists ! file existance
99  real(ip_double_p),allocatable :: array2(:,:)
100  integer(ip_i4_p) ,allocatable :: array2i(:,:)
101  integer(ip_i4_p) :: ifldtype ! field type int (1) or real (2)
102 
103  character(len=*),parameter :: subname = '(oasis_io_read_avfld)'
104 
105 !-------------------------------------------------------------------------------
106 !
107 !-------------------------------------------------------------------------------
108 
109  IF (mpicom == mpi_comm_null) return
110 
111  ! empty filename, just return
112 
113  call oasis_debug_enter(subname)
114  if (len_trim(filename) < 1) then
115  call oasis_debug_exit(subname)
116  return
117  endif
118 
119  master_task = 0
120  call mpi_comm_rank(mpicom,iam,ierr)
121 
122  ifldtype = 2 ! real default
123  if (present(fldtype)) then
124  ifldtype = 0
125  if (trim(fldtype) == 'int') ifldtype = 1
126  if (trim(fldtype) == 'real') ifldtype = 2
127  if (ifldtype == 0) then
128  WRITE(nulprt,*) subname,estr,'in fldtype argument'
129  call oasis_abort(file=__file__,line=__line__)
130  endif
131  endif
132 
133  call mct_avect_gather(av,av_g,gsmap,master_task,mpicom)
134 
135  if (iam == master_task) then
136 
137  inquire(file=trim(filename),exist=exists)
138  if (exists) then
139  status = nf90_open(trim(filename),nf90_nowrite,ncid)
140  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
141  mpi_rank_local,':',trim(nf90_strerror(status))
142  else
143  write(nulprt,*) subname,estr,'file missing ',trim(filename)
144  call oasis_abort(file=__file__,line=__line__)
145  endif
146 
147  status = nf90_inq_varid(ncid,trim(filefld),varid)
148  if (status /= nf90_noerr) then
149  write(nulprt,*) subname,':',trim(nf90_strerror(status))
150  WRITE(nulprt,*) subname,estr,'filefld variable not found '//trim(filefld)
151  call oasis_abort(file=__file__,line=__line__)
152  endif
153  status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid2)
154  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
155  mpi_rank_local,':',trim(nf90_strerror(status))
156  if (dlen > 2) then
157  write(nulprt,*) subname,estr,'variable ndims gt 2 ',trim(filefld),dlen
158  call oasis_abort(file=__file__,line=__line__)
159  endif
160  status = nf90_inquire_dimension(ncid,dimid2(1),len=nx)
161  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
162  mpi_rank_local,':',trim(nf90_strerror(status))
163  ny = 1
164  if (dlen == 2) then
165  status = nf90_inquire_dimension(ncid,dimid2(2),len=ny)
166  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
167  mpi_rank_local,':',trim(nf90_strerror(status))
168  endif
169 
170  if (size(av_g%rAttr,dim=2) /= nx*ny) then
171  WRITE(nulprt,*) subname,estr,'av gsize nx ny mismatch in file :',&
172  trim(filename),SIZE(av_g%rAttr,dim=2),nx,ny
173  call oasis_abort(file=__file__,line=__line__)
174  endif
175 
176  if (ifldtype == 1) then
177  allocate(array2i(nx,ny))
178  status = nf90_get_var(ncid,varid,array2i)
179  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
180  mpi_rank_local,':',trim(nf90_strerror(status))
181 
182  n = mct_avect_indexia(av_g,trim(avfld))
183  n1 = 0
184  do j = 1,ny
185  do i = 1,nx
186  n1 = n1 + 1
187  av_g%iAttr(n,n1) = array2i(i,j)
188  enddo
189  enddo
190  deallocate(array2i)
191  else
192  allocate(array2(nx,ny))
193  status = nf90_get_var(ncid,varid,array2)
194  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
195  mpi_rank_local,':',trim(nf90_strerror(status))
196 
197  n = mct_avect_indexra(av_g,trim(avfld))
198  n1 = 0
199  do j = 1,ny
200  do i = 1,nx
201  n1 = n1 + 1
202  av_g%rAttr(n,n1) = array2(i,j)
203  enddo
204  enddo
205  deallocate(array2)
206  endif
207 
208  status = nf90_close(ncid)
209  IF (status /= nf90_noerr) THEN
210  WRITE(nulprt,*) subname,' model :',compid,' proc :',mpi_rank_local,':',&
211  trim(nf90_strerror(status))
212  ENDIF
213 
214  endif
215 
216  call mct_avect_scatter(av_g,av,gsmap,master_task,mpicom)
217  if (iam == master_task) then
218  call mct_avect_clean(av_g)
219  endif
220 
221  call oasis_debug_exit(subname)
222 
223 end subroutine oasis_io_read_avfld
224 
225 !===============================================================================
226 
227 !> Writes all fields from an attribute vector to a file
228 
229 subroutine oasis_io_write_avfile(rstfile,av,gsmap,mpicom,nx,ny,nampre)
230 
231  implicit none
232 
233  character(len=*), intent(in) :: rstfile !< filename
234  type(mct_avect) , intent(in) :: av !< avect
235  type(mct_gsmap) , intent(in) :: gsmap !< gsmap decomp
236  integer(ip_i4_p), intent(in) :: mpicom !< mpi comm
237  integer(ip_i4_p), intent(in) :: nx !< 2d global nx size
238  integer(ip_i4_p), intent(in) :: ny !< 2d global ny size
239  character(len=*), intent(in),optional :: nampre !< field name prepend string on file
240 
241  !--- local ---
242  integer(ip_i4_p) :: n,n1,i,j,fk,fk1 ! index
243  integer(ip_i4_p) :: nxf,nyf ! field size on file
244  type(mct_avect) :: av_g ! avect global data
245  type(mct_string) :: mstring ! mct char type
246  character(ic_med) :: itemc ! string converted to char
247  character(ic_med) :: lnampre ! local nampre
248  character(ic_med) :: lstring ! local filename
249  integer(ip_i4_p) :: master_task,iam,ierr ! mpi info
250  integer(ip_i4_p) :: ncid,dimid,dimid2(2),varid ! netcdf info
251  integer(ip_i4_p) :: dlen ! dimension length
252  integer(ip_i4_p) :: status ! error code
253  logical :: exists ! file existance
254  real(ip_double_p),allocatable :: array2(:,:)
255 
256  character(len=*),parameter :: subname = '(oasis_io_write_avfile)'
257 
258 !-------------------------------------------------------------------------------
259 !
260 !-------------------------------------------------------------------------------
261 
262  IF (mpicom == mpi_comm_null) return
263 
264  call oasis_debug_enter(subname)
265 
266  ! empty filename, just return
267 
268  if (len_trim(rstfile) < 1) then
269  call oasis_debug_exit(subname)
270  return
271  endif
272 
273  lnampre = ""
274  if (present(nampre)) then
275  lnampre = trim(nampre)
276  endif
277 
278  master_task = 0
279  call mpi_comm_rank(mpicom,iam,ierr)
280 
281  call mct_avect_gather(av,av_g,gsmap,master_task,mpicom)
282 
283  if (iam == master_task) then
284  if (size(av_g%rAttr,dim=2) /= nx*ny) then
285  write(nulprt,*) subname,estr,'av gsize nx ny mismatch in file :',&
286  trim(lstring),SIZE(av_g%rAttr,dim=2),nx,ny
287  call oasis_abort(file=__file__,line=__line__)
288  endif
289 
290  inquire(file=trim(rstfile),exist=exists)
291  if (exists) then
292  status = nf90_open(trim(rstfile),nf90_write,ncid)
293  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
294  mpi_rank_local,':',trim(nf90_strerror(status))
295  status = nf90_redef(ncid)
296  else
297  status = nf90_create(trim(rstfile),nf90_clobber,ncid)
298  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
299  mpi_rank_local,':',trim(nf90_strerror(status))
300  endif
301 
302  do n = 1,mct_avect_nrattr(av_g)
303  call mct_avect_getrlist(mstring,n,av_g)
304  itemc = mct_string_tochar(mstring)
305  itemc = trim(lnampre)//trim(itemc)
306  call mct_string_clean(mstring)
307 
308  status = nf90_inq_dimid(ncid,trim(itemc)//'_nx',dimid2(1))
309  if (status /= nf90_noerr) then
310  status = nf90_def_dim(ncid,trim(itemc)//'_nx',nx,dimid2(1))
311  endif
312 
313  status = nf90_inq_dimid(ncid,trim(itemc)//'_ny',dimid2(2))
314  if (status /= nf90_noerr) then
315  status = nf90_def_dim(ncid,trim(itemc)//'_ny',ny,dimid2(2))
316  endif
317 
318  status = nf90_inquire_dimension(ncid,dimid2(1),len=dlen)
319  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
320  mpi_rank_local,':',trim(nf90_strerror(status))
321  if (dlen /= nx) then
322  write(nulprt,*) subname,wstr,'dlen ne nx ',dlen,nx
323  CALL oasis_flush(nulprt)
324 ! call oasis_abort(file=__FILE__,line=__LINE__)
325  endif
326 
327  status = nf90_inquire_dimension(ncid,dimid2(2),len=dlen)
328  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
329  mpi_rank_local,':',trim(nf90_strerror(status))
330  if (dlen /= ny) then
331  write(nulprt,*) subname,wstr,'dlen ne ny ',dlen,ny
332  CALL oasis_flush(nulprt)
333 ! call oasis_abort(file=__FILE__,line=__LINE__)
334  endif
335 
336  status = nf90_inq_varid(ncid,trim(itemc),varid)
337  if (status /= nf90_noerr) then
338  status = nf90_def_var(ncid,trim(itemc),nf90_double,dimid2,varid)
339  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
340  mpi_rank_local,':',trim(nf90_strerror(status))
341  endif
342 
343  enddo
344 
345  status = nf90_enddef(ncid)
346  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
347  mpi_rank_local,':',trim(nf90_strerror(status))
348 
349  nxf = 0
350  nyf = 0
351  do n = 1,mct_avect_nrattr(av_g)
352  call mct_avect_getrlist(mstring,n,av_g)
353  itemc = mct_string_tochar(mstring)
354  itemc = trim(lnampre)//trim(itemc)
355  call mct_string_clean(mstring)
356  status = nf90_inq_varid(ncid,trim(itemc),varid)
357  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
358  mpi_rank_local,':',trim(nf90_strerror(status))
359  if (n == 1) then
360  status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid2)
361  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
362  mpi_rank_local,':',trim(nf90_strerror(status))
363  status = nf90_inquire_dimension(ncid,dimid2(1),len=nxf)
364  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
365  mpi_rank_local,':',trim(nf90_strerror(status))
366  status = nf90_inquire_dimension(ncid,dimid2(2),len=nyf)
367  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
368  mpi_rank_local,':',trim(nf90_strerror(status))
369  if (dlen /= 2 .or. nx*ny /= nxf*nyf) then
370  WRITE(nulprt,*) subname,estr,'ndims and size does not match on file'
371  call oasis_abort(file=__file__,line=__line__)
372  endif
373  allocate(array2(nxf,nyf))
374  endif
375 
376  n1 = 0
377  do j = 1,nyf
378  do i = 1,nxf
379  n1 = n1 + 1
380  array2(i,j) = av_g%rAttr(n,n1)
381  enddo
382  enddo
383 
384  status = nf90_put_var(ncid,varid,array2)
385  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
386  mpi_rank_local,':',trim(nf90_strerror(status))
387  enddo
388  deallocate(array2)
389  call mct_avect_clean(av_g)
390 
391  status = nf90_close(ncid)
392  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
393  mpi_rank_local,':',trim(nf90_strerror(status))
394 
395  endif
396 
397  call oasis_debug_exit(subname)
398 
399 end subroutine oasis_io_write_avfile
400 
401 !===============================================================================
402 
403 !> Reads all fields for an attribute vector from a file
404 
405 subroutine oasis_io_read_avfile(rstfile,av,gsmap,mpicom,abort,nampre,didread)
406 
407  implicit none
408 
409  character(len=*), intent(in) :: rstfile !< filename
410  type(mct_avect) , intent(inout) :: av !< avect
411  type(mct_gsmap) , intent(in) :: gsmap !< gsmap decomp
412  integer(ip_i4_p), intent(in) :: mpicom !< mpi comm
413  logical , intent(in) ,optional :: abort !< abort on error flag, default is true
414  character(len=*), intent(in) ,optional :: nampre !< name prepend string for fields on file
415  logical , intent(out),optional :: didread !< flag indicating that read was successful
416 
417  !--- local ---
418  integer(ip_i4_p) :: n,n1,i,j,fk,fk1 ! index
419  integer(ip_i4_p) :: nx ! 2d global size nx
420  integer(ip_i4_p) :: ny ! 2d global size ny
421  type(mct_avect) :: av_g ! avect global data
422  type(mct_string) :: mstring ! mct char type
423  character(ic_med) :: itemc ! string converted to char
424  character(ic_med) :: lnampre ! local nampre
425  character(ic_med) :: lstring ! local filename
426  integer(ip_i4_p) :: master_task,iam,ierr ! mpi info
427  integer(ip_i4_p) :: ncid,dimid,dimid2(2),varid ! netcdf info
428  integer(ip_i4_p) :: dlen ! dimension length
429  integer(ip_i4_p) :: status ! error code
430  logical :: exists ! file existance
431  logical :: labort ! local abort flag
432  real(ip_double_p),allocatable :: array2(:,:)
433 
434  character(len=*),parameter :: subname = '(oasis_io_read_avfile)'
435 
436 !-------------------------------------------------------------------------------
437 !
438 !-------------------------------------------------------------------------------
439 
440  IF (mpicom == mpi_comm_null) return
441 
442  call oasis_debug_enter(subname)
443 
444  if (present(didread)) didread = .false.
445 
446  ! empty filename, just return
447 
448  if (len_trim(rstfile) < 1) then
449  call oasis_debug_exit(subname)
450  return
451  endif
452 
453  labort = .true.
454  if (present(abort)) then
455  labort = abort
456  endif
457 
458  lnampre = ""
459  if (present(nampre)) then
460  lnampre = trim(nampre)
461  endif
462 
463  master_task = 0
464  call mpi_comm_rank(mpicom,iam,ierr)
465 
466  call mct_avect_gather(av,av_g,gsmap,master_task,mpicom)
467 
468  if (iam == master_task) then
469 
470  inquire(file=trim(rstfile),exist=exists)
471  if (.not.exists) then
472  IF (labort) THEN
473  write(nulprt,*) subname,estr,'file missing ',trim(rstfile)
474  call oasis_abort(file=__file__,line=__line__)
475  ELSE
476  write(nulprt,*) subname,wstr,'file missing ',trim(rstfile)
477  CALL oasis_flush(nulprt)
478  ENDIF
479  else
480  status = nf90_open(trim(rstfile),nf90_nowrite,ncid)
481  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
482  mpi_rank_local,':',trim(nf90_strerror(status))
483 
484  do n = 1,mct_avect_nrattr(av_g)
485  call mct_avect_getrlist(mstring,n,av_g)
486  itemc = mct_string_tochar(mstring)
487  itemc = trim(lnampre)//trim(itemc)
488  call mct_string_clean(mstring)
489 
490  status = nf90_inq_varid(ncid,trim(itemc),varid)
491 
492  if (status /= nf90_noerr) then
493  IF (labort) THEN
494  write(nulprt,*) subname,estr,'var missing on file = ',trim(itemc),':',trim(nf90_strerror(status))
495  call oasis_abort(file=__file__,line=__line__)
496 ! ELSE
497 ! write(nulprt,*) subname,wstr,'var missing on file = ',trim(itemc),':',trim(nf90_strerror(status))
498 ! CALL oasis_flush(nulprt)
499  ENDIF
500 
501  else
502  status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid2)
503  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
504  mpi_rank_local,':',trim(nf90_strerror(status))
505  if (dlen > 2) then
506  write(nulprt,*) subname,estr,'variable ndims gt 2 on file ',trim(itemc),dlen
507  call oasis_abort(file=__file__,line=__line__)
508  endif
509  status = nf90_inquire_dimension(ncid,dimid2(1),len=nx)
510  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
511  mpi_rank_local,':',trim(nf90_strerror(status))
512  ny = 1
513  if (dlen == 2) then
514  status = nf90_inquire_dimension(ncid,dimid2(2),len=ny)
515  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
516  mpi_rank_local,':',trim(nf90_strerror(status))
517  endif
518 
519  if (size(av_g%rAttr,dim=2) /= nx*ny) then
520  WRITE(nulprt,*) subname,estr,'av gsize nx ny mismatch in file = ',&
521  trim(rstfile),SIZE(av_g%rAttr,dim=2),nx,ny
522  call oasis_abort(file=__file__,line=__line__)
523  endif
524 
525  allocate(array2(nx,ny))
526 
527  status = nf90_get_var(ncid,varid,array2)
528  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
529  mpi_rank_local,':',trim(nf90_strerror(status))
530 
531  n1 = 0
532  do j = 1,ny
533  do i = 1,nx
534  n1 = n1 + 1
535  av_g%rAttr(n,n1) = array2(i,j)
536  enddo
537  enddo
538  if (present(didread)) didread = .true.
539 
540  deallocate(array2)
541  endif ! varid valid
542  enddo
543 
544  status = nf90_close(ncid)
545  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
546  mpi_rank_local,':',trim(nf90_strerror(status))
547 
548  endif ! file exists
549  endif
550 
551  call mct_avect_scatter(av_g,av,gsmap,master_task,mpicom)
552  if (iam == master_task) then
553  call mct_avect_clean(av_g)
554  endif
555 
556  call oasis_debug_exit(subname)
557 
558 end subroutine oasis_io_read_avfile
559 
560 !===============================================================================
561 
562 !> Reads an integer or real field from a file into an array
563 
564 subroutine oasis_io_read_array(rstfile,mpicom,iarray,ivarname,rarray,rvarname,abort)
565 
566  implicit none
567 
568  character(len=*), intent(in) :: rstfile !< filename
569  integer(ip_i4_p), intent(in) :: mpicom !< mpi comm
570  integer(ip_i4_p), intent(inout),optional :: iarray(:) !< integer data on root
571  character(len=*), intent(in),optional :: ivarname !< integer variable name on file
572  real(ip_double_p),intent(inout),optional :: rarray(:) !< real data on root
573  character(len=*), intent(in),optional :: rvarname !< real variable name on file
574  logical , intent(in),optional :: abort !< abort on error flag, default is true
575 
576  !--- local ---
577  integer(ip_i4_p) :: ncnt
578  integer(ip_i4_p) :: master_task,iam,ierr ! mpi info
579  integer(ip_i4_p) :: ncid,dimid,dimid1(1),varid ! netcdf info
580  integer(ip_i4_p) :: dlen ! dimension length
581  integer(ip_i4_p) :: status ! error code
582  logical :: exists ! file existance
583  logical :: labort ! local abort flag
584 
585  character(len=*),parameter :: subname = '(oasis_io_read_array)'
586 
587 !-------------------------------------------------------------------------------
588 !
589 !-------------------------------------------------------------------------------
590 
591  if (mpicom == mpi_comm_null) return
592 
593  call oasis_debug_enter(subname)
594 
595  ! empty filename, just return
596 
597  if (len_trim(rstfile) < 1) then
598  call oasis_debug_exit(subname)
599  return
600  endif
601 
602  labort = .true.
603  if (present(abort)) then
604  labort = abort
605  endif
606 
607  master_task = 0
608  call mpi_comm_rank(mpicom,iam,ierr)
609 
610  if (iam == master_task) then
611 
612  inquire(file=trim(rstfile),exist=exists)
613  if (.not.exists) then
614  IF (labort) THEN
615  write(nulprt,*) subname,estr,'file missing ',trim(rstfile)
616  call oasis_abort(file=__file__,line=__line__)
617  ELSE
618  write(nulprt,*) subname,wstr,'file missing ',trim(rstfile)
619  CALL oasis_flush(nulprt)
620  ENDIF
621  else
622  status = nf90_open(trim(rstfile),nf90_nowrite,ncid)
623  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
624  mpi_rank_local,':',trim(nf90_strerror(status))
625 
626  if (present(iarray)) then
627  if (.not. present(ivarname)) then
628  write(nulprt,*) subname,estr,'iarray must have ivarname set'
629  call oasis_abort(file=__file__,line=__line__)
630  endif
631 
632  ncnt = size(iarray)
633 
634  status = nf90_inq_varid(ncid,trim(ivarname),varid)
635  if (status /= nf90_noerr) then
636  IF (labort) THEN
637  write(nulprt,*) subname,estr,'var missing on file = ',trim(ivarname),':',trim(nf90_strerror(status))
638  call oasis_abort(file=__file__,line=__line__)
639 ! ELSE
640 ! write(nulprt,*) subname,wstr,'var missing on file = ',trim(ivarname),':',trim(nf90_strerror(status))
641 ! CALL oasis_flush(nulprt)
642  ENDIF
643  else
644  status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid1)
645  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
646  mpi_rank_local,':',trim(nf90_strerror(status))
647  if (dlen /= 1) then
648  write(nulprt,*) subname,estr,'variable ndims ne 1 ',trim(ivarname),dlen
649  call oasis_abort(file=__file__,line=__line__)
650  endif
651  status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
652  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
653  mpi_rank_local,':',trim(nf90_strerror(status))
654 
655  if (ncnt /= dlen) then
656  write(nulprt,*) subname,estr,'iarray ncnt dlen mismatch ',ncnt,dlen
657  call oasis_abort(file=__file__,line=__line__)
658  endif
659 
660  status = nf90_get_var(ncid,varid,iarray)
661  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
662  mpi_rank_local,':',trim(nf90_strerror(status))
663  endif
664  endif
665 
666  if (present(rarray)) then
667  if (.not. present(rvarname)) then
668  write(nulprt,*) subname,estr,'rarray must have rvarname set'
669  call oasis_abort(file=__file__,line=__line__)
670  endif
671 
672  ncnt = size(rarray)
673 
674  status = nf90_inq_varid(ncid,trim(rvarname),varid)
675  if (status /= nf90_noerr) then
676  IF (labort) THEN
677  write(nulprt,*) subname,estr,'var missing on file = ',trim(rvarname),':',trim(nf90_strerror(status))
678  call oasis_abort(file=__file__,line=__line__)
679 ! ELSE
680 ! write(nulprt,*) subname,wstr,'var missing on file = ',trim(rvarname),':',trim(nf90_strerror(status))
681 ! CALL oasis_flush(nulprt)
682  ENDIF
683  else
684  status = nf90_inquire_variable(ncid,varid,ndims=dlen,dimids=dimid1)
685  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
686  mpi_rank_local,':',trim(nf90_strerror(status))
687  if (dlen /= 1) then
688  write(nulprt,*) subname,estr,'variable ndims ne 1 ',trim(rvarname),dlen
689  call oasis_abort(file=__file__,line=__line__)
690  endif
691  status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
692  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
693  mpi_rank_local,':',trim(nf90_strerror(status))
694 
695  if (ncnt /= dlen) then
696  write(nulprt,*) subname,estr,'rarray ncnt dlen mismatch ',ncnt,dlen
697  call oasis_abort(file=__file__,line=__line__)
698  endif
699 
700  status = nf90_get_var(ncid,varid,rarray)
701  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
702  mpi_rank_local,':',trim(nf90_strerror(status))
703  endif
704  endif
705 
706  status = nf90_close(ncid)
707  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
708  mpi_rank_local,':',trim(nf90_strerror(status))
709 
710  endif
711  endif
712 
713  if (present(iarray)) then
714  call oasis_mpi_bcast(iarray,mpicom,trim(subname)//':iarray',master_task)
715  endif
716 
717  if (present(rarray)) then
718  call oasis_mpi_bcast(rarray,mpicom,trim(subname)//':rarray',master_task)
719  endif
720 
721  call oasis_debug_exit(subname)
722 
723 end subroutine oasis_io_read_array
724 
725 !===============================================================================
726 
727 !> Writes a real or integer array to a file
728 
729 subroutine oasis_io_write_array(rstfile,mpicom,iarray,ivarname,rarray,rvarname)
730 
731  implicit none
732 
733  character(len=*), intent(in) :: rstfile !< filename
734  integer(ip_i4_p), intent(in) :: mpicom !< mpi comm
735  integer(ip_i4_p), intent(in),optional :: iarray(:) !< integer data on root
736  character(len=*), intent(in),optional :: ivarname !< integer variable name on file
737  real(ip_double_p),intent(in),optional :: rarray(:) !< real data on root
738  character(len=*), intent(in),optional :: rvarname !< real variable name on file
739 
740  !--- local ---
741  integer(ip_i4_p) :: ncnt
742  integer(ip_i4_p) :: master_task,iam,ierr ! mpi info
743  integer(ip_i4_p) :: ncid,dimid,dimid1(1),varid ! netcdf info
744  integer(ip_i4_p) :: dlen ! dimension length
745  integer(ip_i4_p) :: status ! error code
746  logical :: exists ! file existance
747 
748  character(len=*),parameter :: subname = '(oasis_io_write_array)'
749 
750 !-------------------------------------------------------------------------------
751 !
752 !-------------------------------------------------------------------------------
753 
754  IF (mpicom == mpi_comm_null) return
755 
756  call oasis_debug_enter(subname)
757 
758  ! empty filename, just return
759 
760  if (len_trim(rstfile) < 1) then
761  call oasis_debug_exit(subname)
762  return
763  endif
764 
765  master_task = 0
766  call mpi_comm_rank(mpicom,iam,ierr)
767 
768  if (iam == master_task) then
769 
770  inquire(file=trim(rstfile),exist=exists)
771  if (exists) then
772  status = nf90_open(trim(rstfile),nf90_write,ncid)
773  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
774  mpi_rank_local,':',trim(nf90_strerror(status))
775  status = nf90_redef(ncid)
776  else
777  status = nf90_create(trim(rstfile),nf90_clobber,ncid)
778  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
779  mpi_rank_local,':',trim(nf90_strerror(status))
780  endif
781 
782  if (present(iarray)) then
783  if (.not. present(ivarname)) then
784  write(nulprt,*) subname,estr,'iarray must have ivarname set'
785  call oasis_abort(file=__file__,line=__line__)
786  endif
787 
788  ncnt = size(iarray)
789 
790  status = nf90_inq_dimid(ncid,trim(ivarname)//'_ncnt',dimid1(1))
791  if (status /= nf90_noerr) then
792  status = nf90_def_dim(ncid,trim(ivarname)//'_ncnt',ncnt,dimid1(1))
793  endif
794 
795  status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
796  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
797  mpi_rank_local,':',trim(nf90_strerror(status))
798  if (dlen /= ncnt) then
799  write(nulprt,*) subname,estr,'iarray dlen ne ncnt ',dlen,ncnt
800  call oasis_abort(file=__file__,line=__line__)
801  endif
802 
803  status = nf90_inq_varid(ncid,trim(ivarname),varid)
804  if (status /= nf90_noerr) then
805  status = nf90_def_var(ncid,trim(ivarname),nf90_int,dimid1,varid)
806  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
807  mpi_rank_local,':',trim(nf90_strerror(status))
808  endif
809  endif
810 
811  if (present(rarray)) then
812  if (.not. present(rvarname)) then
813  write(nulprt,*) subname,estr,'rarray must have rvarname set'
814  call oasis_abort(file=__file__,line=__line__)
815  endif
816 
817  ncnt = size(rarray)
818 
819  status = nf90_inq_dimid(ncid,trim(rvarname)//'_ncnt',dimid1(1))
820  if (status /= nf90_noerr) then
821  status = nf90_def_dim(ncid,trim(rvarname)//'_ncnt',ncnt,dimid1(1))
822  endif
823 
824  status = nf90_inquire_dimension(ncid,dimid1(1),len=dlen)
825  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
826  mpi_rank_local,':',trim(nf90_strerror(status))
827  if (dlen /= ncnt) then
828  write(nulprt,*) subname,estr,'rarray dlen ne ncnt ',dlen,ncnt
829  call oasis_abort(file=__file__,line=__line__)
830  endif
831 
832  status = nf90_inq_varid(ncid,trim(rvarname),varid)
833  if (status /= nf90_noerr) then
834  status = nf90_def_var(ncid,trim(rvarname),nf90_double,dimid1,varid)
835  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
836  mpi_rank_local,':',trim(nf90_strerror(status))
837  endif
838  endif
839 
840  status = nf90_enddef(ncid)
841  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
842  mpi_rank_local,':',trim(nf90_strerror(status))
843 
844  if (present(iarray)) then
845  status = nf90_inq_varid(ncid,trim(ivarname),varid)
846  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
847  mpi_rank_local,':',trim(nf90_strerror(status))
848  status = nf90_put_var(ncid,varid,iarray)
849  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
850  mpi_rank_local,':',trim(nf90_strerror(status))
851  endif
852 
853  if (present(rarray)) then
854  status = nf90_inq_varid(ncid,trim(rvarname),varid)
855  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
856  mpi_rank_local,':',trim(nf90_strerror(status))
857  status = nf90_put_var(ncid,varid,rarray)
858  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
859  mpi_rank_local,':',trim(nf90_strerror(status))
860  endif
861 
862  status = nf90_close(ncid)
863  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
864  mpi_rank_local,':',trim(nf90_strerror(status))
865 
866  endif
867 
868  call oasis_debug_exit(subname)
869 
870 end subroutine oasis_io_write_array
871 
872 !===============================================================================
873 
874 !> Write each field in an attribute vector to an individual files
875 
876 subroutine oasis_io_write_avfbf(av,gsmap,mpicom,nx,ny,msec,f_string,filename)
877 
878  ! ---------------------------------------
879  ! This works only for a single av to a file
880  ! Optionally can specify time info, and filename info
881  ! ---------------------------------------
882 
883  implicit none
884 
885  type(mct_avect) , intent(in) :: av !< avect
886  type(mct_gsmap) , intent(in) :: gsmap !< gsmap decomp
887  integer(ip_i4_p), intent(in) :: mpicom !< mpi comm
888  integer(ip_i4_p), intent(in) :: nx !< 2d global nx size
889  integer(ip_i4_p), intent(in) :: ny !< 2d global ny size
890  integer(ip_i4_p), intent(in),optional :: msec !< optional time info in seconds
891  character(len=*), intent(in),optional :: f_string !< optional f_string to append to filename
892  character(len=*), intent(in),optional :: filename !< optional output filename
893 
894  !--- local ---
895  integer(ip_i4_p) :: n,n1,i,j,fk,fk1 ! index
896  type(mct_avect) :: av_g ! avect global data
897  type(mct_string) :: mstring ! mct char type
898  character(ic_med) :: itemc ! f_string converted to char
899  character(ic_med) :: lfn ! local filename
900  character(ic_med) :: lstring ! local filename
901  integer(ip_i4_p) :: master_task,iam,ierr ! mpi info
902  integer(ip_i4_p) :: ncid,dimid,dimid3(3),varid ! netcdf info
903  integer(ip_i4_p) :: start3(3),count3(3) ! netcdf info
904  integer(ip_i4_p) :: start1(1),count1(1) ! netcdf info
905  integer(ip_i4_p) :: lmsec(1) ! local msec value
906  integer(ip_i4_p) :: dlen ! dimension length
907  integer(ip_i4_p) :: status ! error code
908  logical :: exists ! file existance
909  logical :: newfile ! to create a new history file
910  logical :: whead,wdata ! for writing restart/history cdf files
911  integer(ip_i4_p) ,allocatable :: time(:)
912  real(ip_double_p),allocatable :: array3(:,:,:)
913  real(ip_double_p) :: tbnds(2)
914 
915  character(len=*),parameter :: subname = '(oasis_io_write_avfbf)'
916 
917 !-------------------------------------------------------------------------------
918 !
919 !-------------------------------------------------------------------------------
920 
921  IF (mpicom == mpi_comm_null) return
922 
923  call oasis_debug_enter(subname)
924 
925  lmsec = 0
926  if (present(msec)) then
927  lmsec = msec
928  endif
929 
930  lstring = " "
931  if (present(f_string)) then
932  lstring = trim(f_string)
933  endif
934 
935  master_task = 0
936  call mpi_comm_rank(mpicom,iam,ierr)
937 
938 #if (PIO_DEFINED)
939 ! tcraig, not working as of Oct 2011
940  call oasis_ioshr_wopen(lfn,clobber=.true.,cdf64=.true.)
941 
942  do fk = fk1,2
943  if (fk == 1) then
944  whead = .true.
945  wdata = .false.
946  elseif (fk == 2) then
947  whead = .false.
948  wdata = .true.
949  else
950  WRITE(nulprt,*) subname,estr,'fk illegal'
951  call oasis_abort(file=__file__,line=__line__)
952  end if
953 
954  call oasis_ioshr_write(lfn,&
955  time_units='seconds',time_cal='seconds',time_val=real(lmsec,ip_double_p),&
956  nt=1,whead=whead,wdata=wdata)
957 
958  call oasis_ioshr_write(lfn, gsmap, av, 'pout', &
959  whead=whead,wdata=wdata,nx=nx,ny=ny,nt=1, &
960  use_float=.false.)
961 
962  if (fk == 1) call oasis_ioshr_enddef(lfn)
963  enddo
964 
965  call oasis_ioshr_close(lfn)
966 #else
967 
968  call mct_avect_gather(av,av_g,gsmap,master_task,mpicom)
969  if (iam == master_task) then
970  if (size(av_g%rAttr,dim=2) /= nx*ny) then
971  WRITE(nulprt,*) subname,estr,'av gsize nx ny mismatch in file :',&
972  trim(filename),SIZE(av_g%rAttr,dim=2),nx,ny
973  call oasis_abort(file=__file__,line=__line__)
974  endif
975 
976  allocate(array3(nx,ny,1))
977  do n = 1,mct_avect_nrattr(av_g)
978  call mct_avect_getrlist(mstring,n,av_g)
979  itemc = mct_string_tochar(mstring)
980  call mct_string_clean(mstring)
981  if (present(filename)) then
982  lfn = trim(filename)
983  else
984  lfn = trim(itemc)//trim(lstring)//'.nc'
985  endif
986  n1 = 0
987  do j = 1,ny
988  do i = 1,nx
989  n1 = n1 + 1
990  array3(i,j,1) = av_g%rAttr(n,n1)
991  enddo
992  enddo
993 
994  start1 = 1
995  count1 = 1
996  start3 = 1
997  count3(1) = nx
998  count3(2) = ny
999  count3(3) = 1
1000 
1001  newfile = .true.
1002  inquire(file=trim(lfn),exist=exists)
1003  if (exists) then
1004  newfile = .false.
1005  status = nf90_open(lfn,nf90_write,ncid)
1006  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1007  mpi_rank_local,':',trim(nf90_strerror(status))
1008  status = nf90_inq_dimid(ncid,'time',dimid)
1009  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1010  mpi_rank_local,':',trim(nf90_strerror(status))
1011  status = nf90_inquire_dimension(ncid,dimid,len=dlen)
1012  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1013  mpi_rank_local,':',trim(nf90_strerror(status))
1014  allocate(time(dlen))
1015  status = nf90_inq_varid(ncid,'time',varid)
1016  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1017  mpi_rank_local,':',trim(nf90_strerror(status))
1018  status = nf90_get_var(ncid,varid,time)
1019  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1020  mpi_rank_local,':',trim(nf90_strerror(status))
1021 
1022  !--- check whether the current time is less than the current file time axis
1023  !--- if so, then assume this is an old file and clobber it and start new
1024  do i = 1,dlen
1025  if (time(i) >= lmsec(1)) newfile=.true.
1026  enddo
1027  deallocate(time)
1028  if (.not.newfile) then
1029  start1(1) = dlen + 1
1030  start3(3) = start1(1)
1031  endif
1032  endif
1033 
1034  if (newfile) then
1035  status = nf90_create(lfn,nf90_clobber,ncid)
1036  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1037  mpi_rank_local,':',trim(nf90_strerror(status))
1038  status = nf90_def_dim(ncid,'nx',nx,dimid3(1))
1039  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1040  mpi_rank_local,':',trim(nf90_strerror(status))
1041  status = nf90_def_dim(ncid,'ny',ny,dimid3(2))
1042  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1043  mpi_rank_local,':',trim(nf90_strerror(status))
1044  status = nf90_def_dim(ncid,'time',nf90_unlimited,dimid)
1045  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1046  mpi_rank_local,':',trim(nf90_strerror(status))
1047  dimid3(3) = dimid
1048  status = nf90_def_var(ncid,'time',nf90_int,dimid,varid)
1049  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1050  mpi_rank_local,':',trim(nf90_strerror(status))
1051  status = nf90_def_var(ncid,trim(itemc),nf90_double,dimid3,varid)
1052  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1053  mpi_rank_local,':',trim(nf90_strerror(status))
1054  status = nf90_enddef(ncid)
1055  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1056  mpi_rank_local,':',trim(nf90_strerror(status))
1057  endif
1058 
1059  status = nf90_inq_varid(ncid,'time',varid)
1060  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1061  mpi_rank_local,':',trim(nf90_strerror(status))
1062  status = nf90_put_var(ncid,varid,lmsec,start1,count1)
1063  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1064  mpi_rank_local,':',trim(nf90_strerror(status))
1065  status = nf90_inq_varid(ncid,trim(itemc),varid)
1066  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1067  mpi_rank_local,':',trim(nf90_strerror(status))
1068  status = nf90_put_var(ncid,varid,array3,start3,count3)
1069  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1070  mpi_rank_local,':',trim(nf90_strerror(status))
1071  status = nf90_close(ncid)
1072  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1073  mpi_rank_local,':',trim(nf90_strerror(status))
1074  enddo
1075  deallocate(array3)
1076  call mct_avect_clean(av_g)
1077  endif
1078 
1079 
1080 #endif
1081 
1082  call oasis_debug_exit(subname)
1083 
1084 end subroutine oasis_io_write_avfbf
1085 
1086 !===============================================================================
1087 
1088 !> Read each field in an attribute vector from individual files
1089 
1090 subroutine oasis_io_read_avfbf(av,gsmap,mpicom,msec,f_string,filename)
1091 
1092  ! ---------------------------------------
1093  ! This works only for a single av from a file
1094  ! Optionally can specify time info, and filename info
1095  ! ---------------------------------------
1096 
1097  implicit none
1098 
1099  type(mct_avect) , intent(inout) :: av !< avect
1100  type(mct_gsmap) , intent(in) :: gsmap !< gsmap decomp
1101  integer(ip_i4_p), intent(in) :: mpicom !< mpi comm
1102  integer(ip_i4_p), intent(in),optional :: msec !< optional time info in seconds
1103  character(len=*), intent(in),optional :: f_string !< optional f_string to append to filename
1104  character(len=*), intent(in),optional :: filename !< optional input filename
1105 
1106  !--- local ---
1107  integer(ip_i4_p) :: n,n1,i,j,fk,fk1 ! index
1108  integer(ip_i4_p) :: nx,ny ! grid size from file
1109  type(mct_avect) :: av_g ! avect global data
1110  type(mct_string) :: mstring ! mct char type
1111  character(ic_med) :: itemc ! f_string converted to char
1112  character(ic_med) :: lfn ! local filename
1113  character(ic_med) :: lstring ! local filename
1114  integer(ip_i4_p) :: master_task,iam,ierr ! mpi info
1115  integer(ip_i4_p) :: ncid,dimid,dimid3(3),varid ! netcdf info
1116  integer(ip_i4_p) :: start3(3),count3(3) ! netcdf info
1117  integer(ip_i4_p) :: lmsec(1) ! local msec value
1118  integer(ip_i4_p) :: dlen ! dimension length
1119  integer(ip_i4_p) :: status ! error code
1120  logical :: exists ! file existance
1121  logical :: whead,wdata ! for writing restart/history cdf files
1122  real(ip_double_p),allocatable :: array3(:,:,:)
1123  integer(ip_i4_p) ,allocatable :: time(:)
1124  real(ip_double_p) :: tbnds(2)
1125 
1126  character(len=*),parameter :: subname = '(oasis_io_read_avfbf)'
1127 
1128 !-------------------------------------------------------------------------------
1129 !
1130 !-------------------------------------------------------------------------------
1131 
1132  IF (mpicom == mpi_comm_null) return
1133 
1134  call oasis_debug_enter(subname)
1135 
1136  lmsec = 0
1137  if (present(msec)) then
1138  lmsec = msec
1139  endif
1140 
1141  lstring = " "
1142  if (present(f_string)) then
1143  lstring = trim(f_string)
1144  endif
1145 
1146  master_task = 0
1147  call mpi_comm_rank(mpicom,iam,ierr)
1148 
1149  call mct_avect_gather(av,av_g,gsmap,master_task,mpicom)
1150  if (iam == master_task) then
1151  do n = 1,mct_avect_nrattr(av_g)
1152  call mct_avect_getrlist(mstring,n,av_g)
1153  itemc = mct_string_tochar(mstring)
1154  call mct_string_clean(mstring)
1155  if (present(filename)) then
1156  lfn = trim(filename)
1157  else
1158  lfn = trim(itemc)//trim(lstring)//'.nc'
1159  endif
1160 
1161  inquire(file=trim(lfn),exist=exists)
1162  if (.not.exists) then
1163  write(nulprt,*) subname,estr,'file not found ',trim(lfn)
1164  call oasis_abort(file=__file__,line=__line__)
1165  endif
1166 
1167  status = nf90_open(lfn,nf90_nowrite,ncid)
1168  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1169  mpi_rank_local,':',trim(nf90_strerror(status))
1170 
1171  status = nf90_inq_dimid(ncid,'time',dimid)
1172  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1173  mpi_rank_local,':',trim(nf90_strerror(status))
1174  status = nf90_inquire_dimension(ncid,dimid,len=dlen)
1175  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1176  mpi_rank_local,':',trim(nf90_strerror(status))
1177  allocate(time(dlen))
1178  status = nf90_inq_varid(ncid,'time',varid)
1179  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1180  mpi_rank_local,':',trim(nf90_strerror(status))
1181  status = nf90_get_var(ncid,varid,time)
1182  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1183  mpi_rank_local,':',trim(nf90_strerror(status))
1184  n1 = 0
1185  do j = 1,dlen
1186  if (time(j) == lmsec(1)) n1 = j
1187  enddo
1188  deallocate(time)
1189  if (n1 < 1) then
1190  write(nulprt,*) subname,estr,'time not found on file ',trim(lfn),lmsec
1191  call oasis_abort(file=__file__,line=__line__)
1192  endif
1193 
1194  status = nf90_inq_varid(ncid,trim(itemc),varid)
1195  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1196  mpi_rank_local,':',trim(nf90_strerror(status))
1197  status = nf90_inquire_variable(ncid,varid,dimids=dimid3)
1198  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1199  mpi_rank_local,':',trim(nf90_strerror(status))
1200  status = nf90_inquire_dimension(ncid,dimid3(1),len=nx)
1201  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1202  mpi_rank_local,':',trim(nf90_strerror(status))
1203  status = nf90_inquire_dimension(ncid,dimid3(2),len=ny)
1204  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1205  mpi_rank_local,':',trim(nf90_strerror(status))
1206 
1207  if (size(av_g%rAttr,dim=2) /= nx*ny) then
1208  WRITE(nulprt,*) subname,estr,'av gsize nx ny mismatch in file :',&
1209  trim(filename),SIZE(av_g%rAttr,dim=2),nx,ny
1210  call oasis_abort(file=__file__,line=__line__)
1211  endif
1212 
1213  start3 = 1
1214  count3(1) = nx
1215  count3(2) = ny
1216  count3(3) = 1
1217  start3(3) = n1
1218  allocate(array3(nx,ny,1))
1219 
1220  status = nf90_get_var(ncid,varid,array3,start3,count3)
1221  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1222  mpi_rank_local,':',trim(nf90_strerror(status))
1223  status = nf90_close(ncid)
1224  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1225  mpi_rank_local,':',trim(nf90_strerror(status))
1226 
1227  n1 = 0
1228  do j = 1,ny
1229  do i = 1,nx
1230  n1 = n1 + 1
1231  av_g%rAttr(n,n1) = array3(i,j,1)
1232  enddo
1233  enddo
1234 
1235  deallocate(array3)
1236 
1237  enddo
1238  endif
1239 
1240  call mct_avect_scatter(av_g,av,gsmap,master_task,mpicom)
1241  if (iam == master_task) then
1242  call mct_avect_clean(av_g)
1243  endif
1244 
1245  call oasis_debug_exit(subname)
1246 
1247 end subroutine oasis_io_read_avfbf
1248 
1249 !===============================================================================
1250 
1251 !> Read a field on the root task from a file into an array.
1252 
1253 subroutine oasis_io_read_field_fromroot(filename,fldname,ifld2,fld2,fld3,nx,ny,nz)
1254 
1255  ! ---------------------------------------
1256  ! Supports 2d integer or real and 3d real arrays.
1257  ! ---------------------------------------
1258 
1259  implicit none
1260 
1261  character(len=*) , intent(in) :: filename !< file name
1262  character(len=*) , intent(in) :: fldname !< field name
1263  integer(ip_i4_p) , intent(inout),optional :: ifld2(:,:) !< 2d integer array
1264  real(ip_realwp_p), intent(inout),optional :: fld2(:,:) !< 2d real array
1265  real(ip_realwp_p), intent(inout),optional :: fld3(:,:,:) !< 3d real array
1266  integer(ip_i4_p) , intent(inout),optional :: nx !< global nx size
1267  integer(ip_i4_p) , intent(inout),optional :: ny !< global ny size
1268  integer(ip_i4_p) , intent(inout),optional :: nz !< global nz size
1269 
1270  !--- local ---
1271  integer(ip_i4_p) :: ncid,varid ! cdf info
1272  integer(ip_i4_p) :: n,ndims,xtype
1273  integer(ip_i4_p),allocatable :: dimid(:),nd(:)
1274  integer(ip_i4_p) :: status ! error code
1275  integer(ip_i4_p) :: ind ! string index
1276  logical :: exists ! file existance
1277  character(len=ic_med) :: gridname ! grid name derived from fldname
1278 
1279  character(len=*),parameter :: subname = '(oasis_io_read_field_fromroot)'
1280 
1281 !-------------------------------------------------------------------------------
1282 !
1283 !-------------------------------------------------------------------------------
1284 
1285  call oasis_debug_enter(subname)
1286 
1287 ! expects to run only on 1 pe.
1288 ! if (iam == master_task) then
1289 
1290 ! EM Since parallel version, must be run only on 1 pe.
1291  if ( mpi_rank_local == 0 ) then
1292 
1293  if (oasis_debug >= 5) then
1294  write(nulprt,*) subname,' read ',trim(filename),' ',trim(fldname)
1295  endif
1296 
1297  inquire(file=trim(filename),exist=exists)
1298  if (exists) then
1299  status = nf90_open(filename,nf90_nowrite,ncid)
1300  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1301  mpi_rank_local,':',trim(nf90_strerror(status))
1302  else
1303  write(nulprt,*) subname,estr,'in filename ',trim(filename)
1304  call oasis_abort(file=__file__,line=__line__)
1305  endif
1306 
1307  status = nf90_inq_varid(ncid,trim(fldname),varid)
1308  if (status /= nf90_noerr) then
1309  write(nulprt,*) subname,estr,'in variable name ',trim(fldname)
1310  call oasis_abort(file=__file__,line=__line__)
1311  endif
1312 
1313  status = nf90_inquire_variable(ncid,varid,ndims=ndims,xtype=xtype)
1314  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1315  mpi_rank_local,':',trim(nf90_strerror(status))
1316 
1317  allocate(dimid(ndims),nd(ndims))
1318 
1319  status = nf90_inquire_variable(ncid,varid,dimids=dimid)
1320  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1321  mpi_rank_local,':',trim(nf90_strerror(status))
1322  do n = 1,ndims
1323  status = nf90_inquire_dimension(ncid,dimid(n),len=nd(n))
1324  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1325  mpi_rank_local,':',trim(nf90_strerror(status))
1326  enddo
1327 
1328  if (present(ifld2) .or. present(fld2) .or. present(fld3)) then
1329  if (xtype == nf90_int .and. ndims == 2 .and. present(ifld2)) then
1330  status = nf90_get_var(ncid,varid,ifld2)
1331  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1332  mpi_rank_local,':',trim(nf90_strerror(status))
1333  elseif (xtype /= nf90_int .and. ndims == 2 .and. present(fld2)) then
1334  status = nf90_get_var(ncid,varid,fld2)
1335  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1336  mpi_rank_local,':',trim(nf90_strerror(status))
1337  elseif (xtype /= nf90_int .and. ndims == 3 .and. present(fld3)) then
1338  status = nf90_get_var(ncid,varid,fld3)
1339  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1340  mpi_rank_local,':',trim(nf90_strerror(status))
1341  else
1342  write(nulprt,*) subname,estr,'mismatch in field and data'
1343  call oasis_abort(file=__file__,line=__line__)
1344  endif
1345  endif
1346 
1347  status = nf90_close(ncid)
1348  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1349  mpi_rank_local,':',trim(nf90_strerror(status))
1350 
1351  if (present(nx)) then
1352  nx = nd(1)
1353  endif
1354 
1355  if (present(ny)) then
1356  ny = nd(2)
1357  endif
1358 
1359  if (present(nz)) then
1360  nz = nd(3)
1361  endif
1362 
1363  deallocate(dimid,nd)
1364 
1365  endif
1366 
1367 ! Scatter info
1368 ! EM Since parallel version, must be broadcasted on a subset of mpi ranks
1369  call oasis_mpi_bcast(xtype,mpi_comm_map,subname//' xtype')
1370  call oasis_mpi_bcast(ndims,mpi_comm_map,subname//' ndims')
1371 
1372  if (present(ifld2) .or. present(fld2) .or. present(fld3)) then
1373  if (xtype == nf90_int .and. ndims == 2 .and. present(ifld2)) then
1374  call oasis_mpi_bcast(ifld2,mpi_comm_map,subname//' mask')
1375  elseif (xtype /= nf90_int .and. ndims == 2 .and. present(fld2)) then
1376  call oasis_mpi_bcast(fld2,mpi_comm_map,subname//' others')
1377  elseif (xtype /= nf90_int .and. ndims == 3 .and. present(fld3)) then
1378  call oasis_mpi_bcast(fld3,mpi_comm_map,subname//' corners')
1379  endif
1380  endif
1381 
1382  if (present(nx)) call oasis_mpi_bcast(nx,mpi_comm_map,subname//' nx')
1383  if (present(ny)) call oasis_mpi_bcast(ny,mpi_comm_map,subname//' nx')
1384  if (present(nz)) call oasis_mpi_bcast(nz,mpi_comm_map,subname//' nx')
1385 
1386 ! endif
1387 
1388  call oasis_debug_exit(subname)
1389 
1390 end subroutine oasis_io_read_field_fromroot
1391 
1392 !===============================================================================
1393 
1394 !> Write a real array named field from the root task to a file.
1395 
1396 subroutine oasis_io_write_2dgridfld_fromroot(filename,fldname,fld,nx,ny)
1397 
1398  ! ---------------------------------------
1399  ! Designed to work with oasis3 write_grid .
1400  ! ---------------------------------------
1401 
1402  implicit none
1403 
1404  character(len=*), intent(in) :: filename !< file name
1405  character(len=*), intent(in) :: fldname !< field name
1406  real(ip_realwp_p),intent(in) :: fld(:,:) !< 2d real field
1407  integer(ip_i4_p), intent(in) :: nx !< 2d global nx size
1408  integer(ip_i4_p), intent(in) :: ny !< 2d global ny size
1409 
1410  !--- local ---
1411  integer(ip_i4_p) :: ncid,dimid,dimid2(2),varid ! cdf info
1412  integer(ip_i4_p) :: status ! error code
1413  integer(ip_i4_p) :: ind ! string index
1414  logical :: exists ! file existance
1415  character(len=ic_med) :: gridname ! grid name derived from fldname
1416 
1417  character(len=*),parameter :: subname = '(oasis_io_write_2dgridfld_fromroot)'
1418 
1419 !-------------------------------------------------------------------------------
1420 !
1421 !-------------------------------------------------------------------------------
1422 
1423  call oasis_debug_enter(subname)
1424 
1425 ! expects to run only on 1 pe.
1426 ! if (iam == master_task) then
1427 
1428  if (oasis_debug >= 5) then
1429  write(nulprt,*) subname,' write ',trim(filename),' ',trim(fldname),nx,ny
1430  endif
1431 
1432  ind = index(trim(fldname),'.')
1433  if (ind < 2) then
1434  write(nulprt,*) subname,estr,'in fldname ',trim(fldname)
1435  call oasis_abort(file=__file__,line=__line__)
1436  endif
1437  gridname = fldname(1:ind-1)
1438 
1439  inquire(file=trim(filename),exist=exists)
1440  if (exists) then
1441  status = nf90_open(filename,nf90_write,ncid)
1442  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1443  mpi_rank_local,':',trim(nf90_strerror(status))
1444  status = nf90_redef(ncid)
1445  else
1446  status = nf90_create(filename,nf90_clobber,ncid)
1447  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1448  mpi_rank_local,':',trim(nf90_strerror(status))
1449  endif
1450 
1451  ! define x dimension if it doesn't exist
1452  status = nf90_inq_dimid(ncid,'x_'//trim(gridname),dimid2(1))
1453  if (status /= nf90_noerr) then
1454  status = nf90_def_dim(ncid,'x_'//trim(gridname),nx,dimid2(1))
1455  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1456  mpi_rank_local,':',trim(nf90_strerror(status))
1457  endif
1458 
1459  ! define y dimension if it doesn't exist
1460  status = nf90_inq_dimid(ncid,'y_'//trim(gridname),dimid2(2))
1461  if (status /= nf90_noerr) then
1462  status = nf90_def_dim(ncid,'y_'//trim(gridname),ny,dimid2(2))
1463  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1464  mpi_rank_local,':',trim(nf90_strerror(status))
1465  endif
1466 
1467  ! define var if it doesn't exist
1468  status = nf90_inq_varid(ncid,trim(fldname),varid)
1469  if (status /= nf90_noerr) then
1470  status = nf90_def_var(ncid,trim(fldname),nf90_double,dimid2,varid)
1471  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1472  mpi_rank_local,':',trim(nf90_strerror(status))
1473  status = nf90_enddef(ncid)
1474  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1475  mpi_rank_local,':',trim(nf90_strerror(status))
1476  status = nf90_put_var(ncid,varid,fld)
1477  if (status /= nf90_noerr) write(nulprt,*) subname,' model :',compid,' proc :',&
1478  mpi_rank_local,':',trim(nf90_strerror(status))
1479  else
1480  status = nf90_enddef(ncid)
1481  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1482  mpi_rank_local,':',trim(nf90_strerror(status))
1483  endif
1484 
1485  status = nf90_close(ncid)
1486  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1487  mpi_rank_local,':',trim(nf90_strerror(status))
1488 
1489 ! endif
1490 
1491  call oasis_debug_exit(subname)
1492 
1493 end subroutine oasis_io_write_2dgridfld_fromroot
1494 
1495 !===============================================================================
1496 
1497 !> Write an integer array named field from the root task to a file.
1498 
1499 subroutine oasis_io_write_2dgridint_fromroot(filename,fldname,fld,nx,ny)
1500 
1501  ! ---------------------------------------
1502  ! Designed to work with oasis3 write_grid .
1503  ! ---------------------------------------
1504 
1505  implicit none
1506 
1507  character(len=*), intent(in) :: filename !< file name
1508  character(len=*), intent(in) :: fldname !< field name
1509  integer(ip_i4_p), intent(in) :: fld(:,:) !< integer field
1510  integer(ip_i4_p), intent(in) :: nx !< 2d global nx size
1511  integer(ip_i4_p), intent(in) :: ny !< 2d global ny size
1512 
1513  !--- local ---
1514  integer(ip_i4_p) :: ncid,dimid,dimid2(2),varid ! cdf info
1515  integer(ip_i4_p) :: status ! error code
1516  integer(ip_i4_p) :: ind ! string index
1517  logical :: exists ! file existance
1518  character(len=ic_med) :: gridname ! grid name derived from fldname
1519 
1520  character(len=*),parameter :: subname = '(oasis_io_write_2dgridint_fromroot)'
1521 
1522 !-------------------------------------------------------------------------------
1523 !
1524 !-------------------------------------------------------------------------------
1525 
1526  call oasis_debug_enter(subname)
1527 
1528 ! expects to run only on 1 pe.
1529 ! if (iam == master_task) then
1530 
1531  if (oasis_debug >= 5) then
1532  write(nulprt,*) subname,' write ',trim(filename),' ',trim(fldname),nx,ny
1533  endif
1534 
1535  ind = index(trim(fldname),'.')
1536  if (ind < 2) then
1537  write(nulprt,*) subname,estr,'in fldname ',trim(fldname)
1538  call oasis_abort(file=__file__,line=__line__)
1539  endif
1540  gridname = fldname(1:ind-1)
1541 
1542  inquire(file=trim(filename),exist=exists)
1543  if (exists) then
1544  status = nf90_open(filename,nf90_write,ncid)
1545  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1546  mpi_rank_local,':',trim(nf90_strerror(status))
1547  status = nf90_redef(ncid)
1548  else
1549  status = nf90_create(filename,nf90_clobber,ncid)
1550  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1551  mpi_rank_local,':',trim(nf90_strerror(status))
1552  endif
1553 
1554  ! define x dimension if it doesn't exist
1555  status = nf90_inq_dimid(ncid,'x_'//trim(gridname),dimid2(1))
1556  if (status /= nf90_noerr) then
1557  status = nf90_def_dim(ncid,'x_'//trim(gridname),nx,dimid2(1))
1558  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1559  mpi_rank_local,':',trim(nf90_strerror(status))
1560  endif
1561 
1562  ! define y dimension if it doesn't exist
1563  status = nf90_inq_dimid(ncid,'y_'//trim(gridname),dimid2(2))
1564  if (status /= nf90_noerr) then
1565  status = nf90_def_dim(ncid,'y_'//trim(gridname),ny,dimid2(2))
1566  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1567  mpi_rank_local,':',trim(nf90_strerror(status))
1568  endif
1569 
1570  ! define var if it doesn't exist
1571  status = nf90_inq_varid(ncid,trim(fldname),varid)
1572  if (status /= nf90_noerr) then
1573  status = nf90_def_var(ncid,trim(fldname),nf90_int,dimid2,varid)
1574  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1575  mpi_rank_local,':',trim(nf90_strerror(status))
1576  status = nf90_enddef(ncid)
1577  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1578  mpi_rank_local,':',trim(nf90_strerror(status))
1579  status = nf90_put_var(ncid,varid,fld)
1580  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1581  mpi_rank_local,':',trim(nf90_strerror(status))
1582  else
1583  status = nf90_enddef(ncid)
1584  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1585  mpi_rank_local,':',trim(nf90_strerror(status))
1586  endif
1587 
1588  status = nf90_close(ncid)
1589  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1590  mpi_rank_local,':',trim(nf90_strerror(status))
1591 
1592 ! endif
1593 
1594  call oasis_debug_exit(subname)
1595 
1596 end subroutine oasis_io_write_2dgridint_fromroot
1597 
1598 !===============================================================================
1599 
1600 !> Write a 3d real array named field from the root task to a file.
1601 
1602 subroutine oasis_io_write_3dgridfld_fromroot(filename,fldname,fld,nx,ny,nc)
1603 
1604  ! ---------------------------------------
1605  ! Designed to work with oasis3 write_grid.
1606  ! ---------------------------------------
1607 
1608  implicit none
1609 
1610  character(len=*), intent(in) :: filename !< file name
1611  character(len=*), intent(in) :: fldname !< field name
1612  real(ip_realwp_p), intent(in) :: fld(:,:,:)!< 3d real array
1613  integer(ip_i4_p), intent(in) :: nx !< 3d global nx size
1614  integer(ip_i4_p), intent(in) :: ny !< 3d global ny size
1615  integer(ip_i4_p), intent(in) :: nc !< 3d global nz size or nc size for corners
1616 
1617  !--- local ---
1618  integer(ip_i4_p) :: ncid,dimid,dimid3(3),varid ! cdf info
1619  integer(ip_i4_p) :: status ! error code
1620  integer(ip_i4_p) :: ind ! string index
1621  logical :: exists ! file existance
1622  character(len=ic_med) :: gridname ! grid name derived from fldname
1623 
1624  character(len=*),parameter :: subname = '(oasis_io_write_3dgridfld_fromroot)'
1625 
1626 !-------------------------------------------------------------------------------
1627 !
1628 !-------------------------------------------------------------------------------
1629 
1630  call oasis_debug_enter(subname)
1631 
1632 ! expects to run only on 1 pe.
1633 ! if (iam == master_task) then
1634 
1635  if (oasis_debug >= 5) then
1636  write(nulprt,*) subname,' write ',trim(filename),' ',trim(fldname),nx,ny,nc
1637  endif
1638 
1639  ind = index(trim(fldname),'.')
1640  if (ind < 2) then
1641  write(nulprt,*) subname,estr,'in fldname ',trim(fldname)
1642  call oasis_abort(file=__file__,line=__line__)
1643  endif
1644  gridname = fldname(1:ind-1)
1645 
1646  inquire(file=trim(filename),exist=exists)
1647  if (exists) then
1648  status = nf90_open(filename,nf90_write,ncid)
1649  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1650  mpi_rank_local,':',trim(nf90_strerror(status))
1651  status = nf90_redef(ncid)
1652  else
1653  status = nf90_create(filename,nf90_clobber,ncid)
1654  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1655  mpi_rank_local,':',trim(nf90_strerror(status))
1656  endif
1657 
1658  ! define x dimension if it doesn't exist
1659  status = nf90_inq_dimid(ncid,'x_'//trim(gridname),dimid3(1))
1660  if (status /= nf90_noerr) then
1661  status = nf90_def_dim(ncid,'x_'//trim(gridname),nx,dimid3(1))
1662  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1663  mpi_rank_local,':',trim(nf90_strerror(status))
1664  endif
1665 
1666  ! define y dimension if it doesn't exist
1667  status = nf90_inq_dimid(ncid,'y_'//trim(gridname),dimid3(2))
1668  if (status /= nf90_noerr) then
1669  status = nf90_def_dim(ncid,'y_'//trim(gridname),ny,dimid3(2))
1670  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1671  mpi_rank_local,':',trim(nf90_strerror(status))
1672  endif
1673 
1674  ! define crn dimension if it doesn't exist
1675  status = nf90_inq_dimid(ncid,'crn_'//trim(gridname),dimid3(3))
1676  if (status /= nf90_noerr) then
1677  status = nf90_def_dim(ncid,'crn_'//trim(gridname),nc,dimid3(3))
1678  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1679  mpi_rank_local,':',trim(nf90_strerror(status))
1680  endif
1681 
1682  ! define var if it doesn't exist
1683  status = nf90_inq_varid(ncid,trim(fldname),varid)
1684  if (status /= nf90_noerr) then
1685  status = nf90_def_var(ncid,trim(fldname),nf90_double,dimid3,varid)
1686  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1687  mpi_rank_local,':',trim(nf90_strerror(status))
1688  status = nf90_enddef(ncid)
1689  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1690  mpi_rank_local,':',trim(nf90_strerror(status))
1691  status = nf90_put_var(ncid,varid,fld)
1692  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1693  mpi_rank_local,':',trim(nf90_strerror(status))
1694  else
1695  status = nf90_enddef(ncid)
1696  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1697  mpi_rank_local,':',trim(nf90_strerror(status))
1698  endif
1699 
1700  status = nf90_close(ncid)
1701  IF (status /= nf90_noerr) WRITE(nulprt,*) subname,' model :',compid,' proc :',&
1702  mpi_rank_local,':',trim(nf90_strerror(status))
1703 
1704 ! endif
1705 
1706  call oasis_debug_exit(subname)
1707 
1708 end subroutine oasis_io_write_3dgridfld_fromroot
1709 
1710 !-------------------------------------------------------------------
1711 
1712 END MODULE mod_oasis_io
mod_oasis_sys
System type methods.
Definition: mod_oasis_sys.F90:4
mod_oasis_io::oasis_io_read_array
subroutine, public oasis_io_read_array(rstfile, mpicom, iarray, ivarname, rarray, rvarname, abort)
Reads an integer or real field from a file into an array.
Definition: mod_oasis_io.F90:565
mod_oasis_data
Provides a common location for several OASIS variables.
Definition: mod_oasis_data.F90:4
mod_oasis_io
Provides reusable IO routines for OASIS.
Definition: mod_oasis_io.F90:4
mod_oasis_data::mpi_comm_map
integer(kind=ip_i4_p) mpi_comm_map
Definition: mod_oasis_data.F90:54
mod_oasis_io::oasis_io_write_avfile
subroutine, public oasis_io_write_avfile(rstfile, av, gsmap, mpicom, nx, ny, nampre)
Writes all fields from an attribute vector to a file.
Definition: mod_oasis_io.F90:230
mod_oasis_data::nulprt
integer(kind=ip_intwp_p) nulprt
Definition: mod_oasis_data.F90:20
mod_oasis_mpi::oasis_mpi_bcast
Generic overloaded interface into MPI broadcast.
Definition: mod_oasis_mpi.F90:58
mod_oasis_sys::oasis_abort
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
Definition: mod_oasis_sys.F90:44
mod_oasis_io::oasis_io_write_2dgridint_fromroot
subroutine, public oasis_io_write_2dgridint_fromroot(filename, fldname, fld, nx, ny)
Write an integer array named field from the root task to a file.
Definition: mod_oasis_io.F90:1500
mod_oasis_io::oasis_io_write_2dgridfld_fromroot
subroutine, public oasis_io_write_2dgridfld_fromroot(filename, fldname, fld, nx, ny)
Write a real array named field from the root task to a file.
Definition: mod_oasis_io.F90:1397
mod_oasis_data::compid
integer(kind=ip_i4_p) compid
Definition: mod_oasis_data.F90:41
mod_oasis_data::mpi_rank_local
integer(kind=ip_i4_p) mpi_rank_local
Definition: mod_oasis_data.F90:51
mod_oasis_kinds
Defines kinds for OASIS.
Definition: mod_oasis_kinds.F90:7
mod_oasis_mpi
Provides a generic and simpler interface into MPI calls for OASIS.
Definition: mod_oasis_mpi.F90:3
mod_oasis_sys::oasis_debug_enter
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
Definition: mod_oasis_sys.F90:209
mod_oasis_io::oasis_io_write_3dgridfld_fromroot
subroutine, public oasis_io_write_3dgridfld_fromroot(filename, fldname, fld, nx, ny, nc)
Write a 3d real array named field from the root task to a file.
Definition: mod_oasis_io.F90:1603
mod_oasis_io::oasis_io_read_field_fromroot
subroutine, public oasis_io_read_field_fromroot(filename, fldname, ifld2, fld2, fld3, nx, ny, nz)
Read a field on the root task from a file into an array.
Definition: mod_oasis_io.F90:1254
mod_oasis_parameters
Defines parameters for OASIS.
Definition: mod_oasis_parameters.F90:4
mod_oasis_io::oasis_io_read_avfld
subroutine, public oasis_io_read_avfld(filename, av, gsmap, mpicom, avfld, filefld, fldtype)
Reads single field from a file into an attribute Vector.
Definition: mod_oasis_io.F90:78
mod_oasis_io::oasis_io_write_avfbf
subroutine, public oasis_io_write_avfbf(av, gsmap, mpicom, nx, ny, msec, f_string, filename)
Write each field in an attribute vector to an individual files.
Definition: mod_oasis_io.F90:877
mod_oasis_data::oasis_debug
integer(kind=ip_i4_p) oasis_debug
Definition: mod_oasis_data.F90:21
mod_oasis_sys::estr
character(len= *), parameter, public estr
Definition: mod_oasis_sys.F90:12
mod_oasis_io::oasis_io_read_avfbf
subroutine, public oasis_io_read_avfbf(av, gsmap, mpicom, msec, f_string, filename)
Read each field in an attribute vector from individual files.
Definition: mod_oasis_io.F90:1091
mod_oasis_io::oasis_io_varexists
logical function, public oasis_io_varexists(filename, fldname)
Checks whether the var fldname is in the file.
Definition: mod_oasis_io.F90:42
mod_oasis_sys::oasis_flush
subroutine, public oasis_flush(nu)
Flushes output to file.
Definition: mod_oasis_sys.F90:94
mod_oasis_ioshr
IO interfaces based on pio (not supported yet)
Definition: mod_oasis_ioshr.F90:18
mod_oasis_io::oasis_io_write_array
subroutine, public oasis_io_write_array(rstfile, mpicom, iarray, ivarname, rarray, rvarname)
Writes a real or integer array to a file.
Definition: mod_oasis_io.F90:730
mod_oasis_sys::oasis_debug_exit
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
Definition: mod_oasis_sys.F90:236
mod_oasis_sys::wstr
character(len= *), parameter, public wstr
Definition: mod_oasis_sys.F90:13
mod_oasis_io::oasis_io_read_avfile
subroutine, public oasis_io_read_avfile(rstfile, av, gsmap, mpicom, abort, nampre, didread)
Reads all fields for an attribute vector from a file.
Definition: mod_oasis_io.F90:406
Generated on Fri Jun 29 2018 20:52:28 for Oasis3-MCT by   doxygen 1.8.13