NCEPLIBS-nemsio  2.5.3
•All Data Structures Files
nemsio_write.f90
Go to the documentation of this file.
1 
28 module nemsio_write
29  use nemsio_openclose
30 !
31  implicit none
32 !
33  private
34 !------------------------------------------------------------------------------
35 !----- interface
36 !
37  interface nemsio_writerec
38  module procedure nemsio_writerec4
39  module procedure nemsio_writerec8
40  end interface nemsio_writerec
41 !
42  interface nemsio_writerecv
43  module procedure nemsio_writerecv4
44  module procedure nemsio_writerecv8
45  end interface nemsio_writerecv
46 !
47  interface nemsio_writerecw34
48  module procedure nemsio_writerec4w34
49  module procedure nemsio_writerec8w34
50  end interface nemsio_writerecw34
51 !
52  interface nemsio_writerecvw34
53  module procedure nemsio_writerecv4w34
54  module procedure nemsio_writerecv8w34
55  end interface nemsio_writerecvw34
56 !
57 !public mehtods
58  public nemsio_writerec,nemsio_writerecv,nemsio_writerecw34,nemsio_writerecvw34
59 !
60 !---------------------------------------------------------
61 ! local data
62 !
63  character(8) :: mygdatatype
64  integer mydimx,mydimy,mydimz,mynframe,myfieldsize,mytlmeta,myflunit
65  integer kens,ibs,nbits
66  logical do_byteswap
67 !
68 contains
69 !
70 !------------------------------------------------------------------------------
71  subroutine nemsio_getgfile(gfile,iret)
72 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
73 ! abstract: read nemsio data by record number into a 2D 32 bits array
74 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
75  implicit none
76  type(nemsio_gfile),intent(in) :: gfile
77  integer(nemsio_intkind),optional,intent(out) :: iret
78  character(8) :: tmpgdatatype
79 !
80  if(present(iret)) iret=-61
81  call nemsio_getfilehead(gfile,iret=iret,gdatatype=tmpgdatatype,dimx=mydimx, &
82  dimy=mydimy,dimz=mydimz,nframe=mynframe,tlmeta=mytlmeta, &
83  flunit=myflunit,do_byteswap=do_byteswap)
84  myfieldsize=(mydimx+2*mynframe)*(mydimy+2*mynframe)
85  mygdatatype=tmpgdatatype(1:4)
86  if(present(iret)) iret=0
87 !
88 ! print *,'in nemsio_getgfile,dimx=',mydimx,mydimy,mydimz,'mygdatatype=', &
89 ! mygdatatype,'do_byteswap=',do_byteswap
90 !
91  end subroutine nemsio_getgfile
92 !
93 !------------------------------------------------------------------------------
94  subroutine nemsio_writerec4(gfile,jrec,data,iret,itr,zhour,precision)
95 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
96 ! abstract: write nemsio a 2D 32 bits array data into bin file using record number
97 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
98  implicit none
99  type(nemsio_gfile),intent(inout) :: gfile
100  integer(nemsio_intkind),intent(in) :: jrec
101  real(nemsio_realkind),intent(in) :: data(:)
102  integer(nemsio_intkind),optional,intent(out) :: iret
103  integer(nemsio_intkind),optional,intent(in) :: itr
104  real(nemsio_realkind),optional,intent(in) :: zhour
105  integer(nemsio_intkind),optional,intent(in) :: precision
106  integer :: ios
107  real(nemsio_dblekind),allocatable :: datatmp8(:)
108 !
109 !------------------------------------------------------------
110 ! write 4 byte rec
111 !------------------------------------------------------------
112 !
113  if(present(iret)) iret=-62
114  call nemsio_getgfile(gfile,iret)
115 !
116  if ( mygdatatype .eq. 'bin4') then
117  call nemsio_writerecbin4d4(gfile,jrec,data,ios)
118  else if ( mygdatatype .eq. 'bin8') then
119  allocate(datatmp8(myfieldsize) )
120  datatmp8(1:myfieldsize)=data(1:myfieldsize)
121  call nemsio_writerecbin8d8(gfile,jrec,datatmp8,ios)
122  deallocate(datatmp8)
123  else
124  call nemsio_writerecgrb4(gfile,jrec,data,ios,itr=itr,zhour=zhour, &
125  precision=precision)
126  endif
127  if ( ios .ne.0 ) then
128  if(present(iret)) then
129  iret=ios
130  return
131  else
132  call nemsio_stop
133  endif
134  endif
135  if(present(iret)) iret=0
136 !
137  return
138  end subroutine nemsio_writerec4
139 !------------------------------------------------------------------------------
140  subroutine nemsio_writerec8(gfile,jrec,data,iret,itr,zhour,precision)
141 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
142 ! abstract: write nemsio a 2D 64 bits array data into bin file using record number
143 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
144  implicit none
145  type(nemsio_gfile),intent(inout) :: gfile
146  integer(nemsio_intkind),intent(in) :: jrec
147  real(nemsio_dblekind),intent(in) :: data(:)
148  integer(nemsio_intkind),optional,intent(out) :: iret
149  integer(nemsio_intkind),optional,intent(in) :: itr
150  real(nemsio_realkind),optional,intent(in) :: zhour
151  integer(nemsio_intkind),optional,intent(in) :: precision
152  integer ios
153  real(nemsio_realkind),allocatable :: datatmp4(:)
154 !------------------------------------------------------------
155 ! write 4 byte rec
156 !------------------------------------------------------------
157 !
158  if(present(iret)) iret=-62
159  call nemsio_getgfile(gfile,iret)
160 !
161  if ( mygdatatype .eq. 'bin4') then
162  allocate(datatmp4(myfieldsize) )
163  datatmp4(1:myfieldsize)=data(1:myfieldsize)
164  call nemsio_writerecbin4d4(gfile,jrec,datatmp4,ios)
165  deallocate(datatmp4)
166  else if ( mygdatatype .eq. 'bin8') then
167  call nemsio_writerecbin8d8(gfile,jrec,data,ios)
168  else
169  call nemsio_writerecgrb8(gfile,jrec,data,ios,itr=itr,zhour=zhour, &
170  precision=precision)
171  endif
172  if ( ios .ne.0 ) then
173  if(present(iret)) then
174  iret=ios
175  return
176  else
177  call nemsio_stop
178  endif
179  endif
180  if(present(iret)) iret=0
181 !
182  return
183  end subroutine nemsio_writerec8
184 !------------------------------------------------------------------------------
185  subroutine nemsio_writerecv4(gfile,name,levtyp,lev,data,iret, &
186  itr,zhour,precision)
187 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
188 ! abstract: write nemsio a 2D 32 bits array data into bin file using record number
189 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
190  implicit none
191  type(nemsio_gfile),intent(inout) :: gfile
192  character(*),intent(in) :: name
193  character(*),optional,intent(in) :: levtyp
194  integer(nemsio_intkind),optional,intent(in) :: lev
195  real(nemsio_realkind),intent(in) :: data(:)
196  integer(nemsio_intkind),optional,intent(out) :: iret
197  integer(nemsio_intkind),optional,intent(in) :: itr
198  real(nemsio_realkind),optional,intent(in) :: zhour
199  integer(nemsio_intkind),optional,intent(in) :: precision
200  integer ios
201  real(nemsio_dblekind),allocatable :: datatmp8(:)
202 !------------------------------------------------------------
203 ! read 4 byte rec
204 !------------------------------------------------------------
205 !
206  if(present(iret))iret=-63
207 !
208  call nemsio_getgfile(gfile,iret)
209 !
210  if ( mygdatatype .eq. 'bin4') then
211  call nemsio_writerecvbin4d4(gfile,name,levtyp,lev,data,ios)
212  else if ( mygdatatype .eq. 'bin8') then
213  allocate(datatmp8(myfieldsize) )
214  datatmp8(1:myfieldsize)=data(1:myfieldsize)
215  call nemsio_writerecvbin8d8(gfile,name,levtyp,lev,datatmp8,ios)
216  deallocate(datatmp8)
217  else
218  call nemsio_writerecvgrb4(gfile,name,levtyp,lev,data,ios,itr=itr, &
219  zhour=zhour,precision=precision)
220  endif
221  if ( ios .ne.0 ) then
222  if(present(iret)) then
223  iret=ios
224  return
225  else
226  call nemsio_stop
227  endif
228  endif
229  if(present(iret)) iret=0
230 !
231  return
232  end subroutine nemsio_writerecv4
233 !------------------------------------------------------------------------------
234  subroutine nemsio_writerecv8(gfile,name,levtyp,lev,data,iret, &
235  itr,zhour,precision)
236 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
237 ! abstract: write nemsio a 2D 32 bits array data into bin file using record number
238 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
239  implicit none
240  type(nemsio_gfile),intent(inout) :: gfile
241  character(*),intent(in) :: name
242  character(*),optional,intent(in) :: levtyp
243  integer(nemsio_intkind),optional,intent(in) :: lev
244  real(nemsio_dblekind),intent(in) :: data(:)
245  integer(nemsio_intkind),optional,intent(out) :: iret
246  integer(nemsio_intkind),optional,intent(in) :: itr
247  real(nemsio_realkind),optional,intent(in) :: zhour
248  integer(nemsio_intkind),optional,intent(in) :: precision
249  integer ios
250  real(nemsio_realkind),allocatable :: datatmp4(:)
251 !------------------------------------------------------------
252 ! write 8 byte rec
253 !------------------------------------------------------------
254 !
255 ! print *,'in nemsio_write_recv8'
256  if(present(iret)) iret=-63
257 !
258  call nemsio_getgfile(gfile,iret)
259 ! print *,'in nemsio_write_recv8,aft nemsio_getgfile'
260 !
261  if ( mygdatatype .eq. 'bin4') then
262  allocate(datatmp4(myfieldsize) )
263  datatmp4(1:myfieldsize)=data(1:myfieldsize)
264  call nemsio_writerecvbin4d4(gfile,name,levtyp,lev,datatmp4,ios)
265  deallocate(datatmp4)
266  else if ( mygdatatype .eq. 'bin8') then
267  call nemsio_writerecvbin8d8(gfile,name,levtyp,lev,data,ios)
268  else
269  call nemsio_writerecvgrb8(gfile,name,levtyp,lev,data,ios,itr=itr, &
270  zhour=zhour,precision=precision)
271 ! print *,'in nemsio_write_recv8,af nemsio_getgfile'
272  endif
273  if ( ios .ne.0 ) then
274  if(present(iret)) then
275  iret=ios
276  return
277  else
278  call nemsio_stop
279  endif
280  endif
281  if(present(iret)) iret=0
282 !
283  return
284  end subroutine nemsio_writerecv8
285 !
286 !------------------------------------------------------------------------------
287  subroutine nemsio_writerec4w34(gfile,jrec,data,iret,itr,zhour,precision)
288 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
289 ! abstract: write nemsio a 2D 32 bits array data into bin file using record number
290 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
291  implicit none
292  type(nemsio_gfile),intent(inout) :: gfile
293  integer(nemsio_intkind),intent(in) :: jrec
294  real(nemsio_realkind),intent(in) :: data(:)
295  integer(nemsio_intkind),optional,intent(out) :: iret
296  integer(nemsio_intkind),optional,intent(in) :: itr
297  real(nemsio_realkind),optional,intent(in) :: zhour
298  integer(nemsio_intkind),optional,intent(in) :: precision
299  integer ios
300  real(nemsio_dblekind),allocatable :: datatmp8(:)
301 !
302 !------------------------------------------------------------
303 ! write 4 byte rec
304 !------------------------------------------------------------
305 !
306  if(present(iret)) iret=-64
307 !
308  call nemsio_getgfile(gfile,iret)
309 !
310  if ( mygdatatype .eq. 'bin4') then
311  call nemsio_writerecbin4d4(gfile,jrec,data,ios)
312  else if ( mygdatatype .eq. 'bin8') then
313  allocate(datatmp8(myfieldsize) )
314  datatmp8(1:myfieldsize)=data(1:myfieldsize)
315  call nemsio_writerecbin8d8(gfile,jrec,datatmp8,ios)
316  deallocate(datatmp8)
317  else
318  call nemsio_writerecgrb4w34(gfile,jrec,data,ios,itr=itr,zhour=zhour, &
319  precision=precision)
320  endif
321  if ( ios .ne.0 ) then
322  if(present(iret)) then
323  iret=ios
324  return
325  else
326  call nemsio_stop
327  endif
328  endif
329  if(present(iret)) iret=0
330 !
331  return
332  end subroutine nemsio_writerec4w34
333 !------------------------------------------------------------------------------
334  subroutine nemsio_writerec8w34(gfile,jrec,data,iret,itr,zhour,precision)
335 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
336 ! abstract: write nemsio a 2D 64 bits array data into bin file using record number
337 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
338  implicit none
339  type(nemsio_gfile),intent(inout) :: gfile
340  integer(nemsio_intkind),intent(in) :: jrec
341  real(nemsio_dblekind),intent(in) :: data(:)
342  integer(nemsio_intkind),optional,intent(out) :: iret
343  integer(nemsio_intkind),optional,intent(in) :: itr
344  real(nemsio_realkind),optional,intent(in) :: zhour
345  integer(nemsio_intkind),optional,intent(in) :: precision
346  real(nemsio_realkind),allocatable :: datatmp4(:)
347  integer ios
348 !------------------------------------------------------------
349 ! write 4 byte rec
350 !------------------------------------------------------------
351 !
352  if(present(iret)) iret=-64
353 !
354  call nemsio_getgfile(gfile,iret)
355 !
356  if ( mygdatatype .eq. 'bin4') then
357  allocate(datatmp4(myfieldsize) )
358  datatmp4(1:myfieldsize)=data(1:myfieldsize)
359  call nemsio_writerecbin4d4(gfile,jrec,datatmp4,ios)
360  deallocate(datatmp4)
361  else if ( mygdatatype .eq. 'bin8') then
362  call nemsio_writerecbin8d8(gfile,jrec,data,ios)
363  else
364  allocate(datatmp4(myfieldsize))
365  datatmp4(1:myfieldsize)=data(1:myfieldsize)
366  call nemsio_writerecgrb4w34(gfile,jrec,datatmp4,ios,itr=itr,zhour=zhour, &
367  precision=precision)
368  deallocate(datatmp4)
369  endif
370  if ( ios .ne.0 ) then
371  if(present(iret)) then
372  iret=ios
373  return
374  else
375  call nemsio_stop
376  endif
377  endif
378  if(present(iret)) iret=0
379 !
380  return
381  end subroutine nemsio_writerec8w34
382 !------------------------------------------------------------------------------
383  subroutine nemsio_writerecv4w34(gfile,name,levtyp,lev,data,iret, &
384  itr,zhour,precision)
385 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
386 ! abstract: write nemsio a 2D 32 bits array data into bin file using record number
387 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
388  implicit none
389  type(nemsio_gfile),intent(inout) :: gfile
390  character(*),intent(in) :: name
391  character(*),optional,intent(in) :: levtyp
392  integer(nemsio_intkind),optional,intent(in) :: lev
393  real(nemsio_realkind),intent(in) :: data(:)
394  integer(nemsio_intkind),optional,intent(out) :: iret
395  integer(nemsio_intkind),optional,intent(in) :: itr
396  real(nemsio_realkind),optional,intent(in) :: zhour
397  integer(nemsio_intkind),optional,intent(in) :: precision
398  integer ios
399  real(nemsio_dblekind),allocatable :: datatmp8(:)
400 !------------------------------------------------------------
401 ! read 4 byte rec
402 !------------------------------------------------------------
403 !
404  if(present(iret)) iret=-65
405 !
406  call nemsio_getgfile(gfile,iret)
407 !
408  if ( mygdatatype .eq. 'bin4') then
409  call nemsio_writerecvbin4d4(gfile,name,levtyp,lev,data,ios)
410  else if ( mygdatatype .eq. 'bin8') then
411  allocate(datatmp8(myfieldsize) )
412  datatmp8(1:myfieldsize)=data(1:myfieldsize)
413  call nemsio_writerecvbin8d8(gfile,name,levtyp,lev,datatmp8,ios)
414  deallocate(datatmp8)
415  else
416  call nemsio_writerecvgrb4w34(gfile,name,levtyp,lev,data,ios,itr=itr, &
417  zhour=zhour,precision=precision)
418  endif
419  if ( ios .ne.0 ) then
420  if(present(iret)) then
421  iret=ios
422  return
423  else
424  call nemsio_stop
425  endif
426  endif
427  if(present(iret)) iret=0
428 !
429  return
430  end subroutine nemsio_writerecv4w34
431 !------------------------------------------------------------------------------
432  subroutine nemsio_writerecv8w34(gfile,name,levtyp,lev,data,iret, &
433  itr,zhour,precision)
434 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
435 ! abstract: write nemsio a 2D 32 bits array data into bin file using record number
436 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
437  implicit none
438  type(nemsio_gfile),intent(inout) :: gfile
439  character(*),intent(in) :: name
440  character(*),optional,intent(in) :: levtyp
441  integer(nemsio_intkind),optional,intent(in) :: lev
442  real(nemsio_dblekind),intent(in) :: data(:)
443  integer(nemsio_intkind),optional,intent(out) :: iret
444  integer(nemsio_intkind),optional,intent(in) :: itr
445  real(nemsio_realkind),optional,intent(in) :: zhour
446  integer(nemsio_intkind),optional,intent(in) :: precision
447  real(nemsio_realkind),allocatable :: datatmp4(:)
448  integer ios
449 !------------------------------------------------------------
450 ! read 4 byte rec
451 !------------------------------------------------------------
452 !
453  if(present(iret)) iret=-65
454 !
455  call nemsio_getgfile(gfile,iret)
456 !
457  if ( mygdatatype .eq. 'bin4') then
458  allocate(datatmp4(myfieldsize) )
459  datatmp4(1:myfieldsize)=data(1:myfieldsize)
460  call nemsio_writerecvbin4d4(gfile,name,levtyp,lev,datatmp4,ios)
461  deallocate(datatmp4)
462  else if ( mygdatatype .eq. 'bin8') then
463  call nemsio_writerecvbin8d8(gfile,name,levtyp,lev,data,ios)
464  else
465  allocate(datatmp4(myfieldsize))
466  datatmp4(1:myfieldsize)=data(1:myfieldsize)
467  call nemsio_writerecvgrb4w34(gfile,name,levtyp,lev,datatmp4,ios,itr=itr, &
468  zhour=zhour,precision=precision)
469  deallocate(datatmp4)
470  endif
471  if ( ios .ne.0 ) then
472  if(present(iret)) then
473  iret=ios
474  return
475  else
476  call nemsio_stop
477  endif
478  endif
479  if(present(iret)) iret=0
480 !
481  return
482  end subroutine nemsio_writerecv8w34
483 !------------------------------------------------------------------------------
484 
485 !***************** write out bin data set : ********************************
486 
487 !------------------------------------------------------------------------------
488  subroutine nemsio_writerecbin4d4(gfile,jrec,data,iret)
489 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
490 ! abstract: read nemsio data (bin) by record number into a 2D 32 bits array
491 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
492  implicit none
493  type(nemsio_gfile),intent(in) :: gfile
494  integer(nemsio_intkind),intent(in) :: jrec
495  real(nemsio_realkind),intent(in) :: data(:)
496  integer(nemsio_intkind),intent(out) :: iret
497  integer(nemsio_intkind8) :: iskip,iwrite,nwrite
498 !
499  iret=-71
500  if(size(data)/=myfieldsize) then
501  print *,'ERROR: input data size ',size(data),' is not match the data domain ', &
502  myfieldsize,'please check dimension and nframe'
503  return
504  endif
505  iskip=mytlmeta+int(jrec-1,8)*int(nemsio_realkind*myfieldsize+8,8)
506  iwrite=int(nemsio_realkind,8)*int(size(data),8)
507  if(do_byteswap) call byteswap(data,nemsio_realkind,size(data))
508  call bafrwritel(myflunit,iskip,iwrite,nwrite,data)
509  if(nwrite.lt.iwrite) return
510  if(do_byteswap) call byteswap(data,nemsio_realkind,size(data))
511  iret=0
512 
513  return
514  end subroutine nemsio_writerecbin4d4
515 !------------------------------------------------------------------------------
516  subroutine nemsio_writerecvbin4d4(gfile,name,levtyp,lev,data,iret)
517 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
518 ! abstract: read nemsio data (bin) by record number into a 2D 32 bits array
519 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
520  implicit none
521  type(nemsio_gfile),intent(in) :: gfile
522  character(*),intent(in) :: name
523  character(*),optional,intent(in) :: levtyp
524  integer(nemsio_intkind),optional,intent(in) :: lev
525  real(nemsio_realkind),intent(in) :: data(:)
526  integer(nemsio_intkind),intent(out) :: iret
527  integer :: jrec, ierr
528  integer(nemsio_intkind8) :: iskip,iwrite,nwrite
529 
530  iret=-73
531  call nemsio_searchrecv(gfile,jrec,name,levtyp,lev,ierr)
532  if ( ierr .ne. 0) return
533  if(size(data)/=myfieldsize) then
534  print *,'ERROR: input data size ',size(data),' is not match the data domain ', &
535  myfieldsize,'please check dimension and nframe'
536  return
537  endif
538  iskip=mytlmeta+int(jrec-1,8)*int(nemsio_realkind*myfieldsize+8,8)
539  iwrite=int(nemsio_realkind,8)*int(size(data),8)
540  if(do_byteswap) call byteswap(data,nemsio_realkind,size(data))
541  call bafrwritel(myflunit,iskip,iwrite,nwrite,data)
542  if(nwrite.lt.iwrite) return
543  if(do_byteswap) call byteswap(data,nemsio_realkind,size(data))
544  iret=0
545 
546  return
547  end subroutine nemsio_writerecvbin4d4
548 !------------------------------------------------------------------------------
549  subroutine nemsio_writerecbin8d8(gfile,jrec,data,iret)
550 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
551 ! abstract: read nemsio data (bin) by record number into a 2D 32 bits array
552 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
553  implicit none
554  type(nemsio_gfile),intent(in) :: gfile
555  integer(nemsio_intkind),intent(in) :: jrec
556  real(nemsio_dblekind),intent(in) :: data(:)
557  integer(nemsio_intkind),intent(out) :: iret
558  integer(nemsio_intkind8) :: iskip,iwrite,nwrite
559 
560  iret=-72
561  if(size(data)/=myfieldsize) then
562  print *,'ERROR: input data size ',size(data),' is not match the data domain ', &
563  myfieldsize,'please check dimension and nframe'
564  return
565  endif
566  iskip=mytlmeta+int(jrec-1,8)*int(nemsio_dblekind*myfieldsize+8,8)
567  iwrite=int(nemsio_dblekind,8)*int(size(data),8)
568  if(do_byteswap) call byteswap(data,nemsio_dblekind,size(data))
569  call bafrwritel(myflunit,iskip,iwrite,nwrite,data)
570  if(nwrite.lt.iwrite) return
571  if(do_byteswap) call byteswap(data,nemsio_dblekind,size(data))
572  iret=0
573 
574  return
575  end subroutine nemsio_writerecbin8d8
576 !------------------------------------------------------------------------------
577  subroutine nemsio_writerecvbin8d8(gfile,name,levtyp,lev,data,iret)
578 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
579 ! abstract: read nemsio data (bin) by record number into a 2D 32 bits array
580 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
581  implicit none
582  type(nemsio_gfile),intent(in) :: gfile
583  character(*),intent(in) :: name
584  character(*),optional,intent(in) :: levtyp
585  integer(nemsio_intkind),optional,intent(in) :: lev
586  real(nemsio_dblekind),intent(in) :: data(:)
587  integer(nemsio_intkind),intent(out) :: iret
588  integer :: jrec, ierr
589  integer(nemsio_intkind8) :: iskip,iwrite,nwrite
590 
591  iret=-74
592  if(size(data)/=myfieldsize) then
593  print *,'ERROR: input data size ',size(data),' is not match the data domain ', &
594  myfieldsize,'please check dimension and nframe'
595  return
596  endif
597  call nemsio_searchrecv(gfile,jrec,name,levtyp,lev,ierr)
598  if ( ierr .ne. 0) return
599  iskip=mytlmeta+int(jrec-1,8)*int(nemsio_dblekind*myfieldsize+8,8)
600  iwrite=int(nemsio_dblekind,8)*int(size(data),8)
601  if(do_byteswap) call byteswap(data,nemsio_dblekind,size(data))
602  call bafrwritel(myflunit,iskip,iwrite,nwrite,data)
603  if(do_byteswap) call byteswap(data,nemsio_dblekind,size(data))
604  if(nwrite.lt.iwrite) return
605  iret=0
606 
607  return
608  end subroutine nemsio_writerecvbin8d8
609 !------------------------------------------------------------------------------
610 !
611 !***************** write out grb data set : ********************************
612 !
613 !------------------------------------------------------------------------------
614  subroutine nemsio_writerecgrb4w34(gfile,jrec,data,iret,idrt,itr,zhour,precision)
615 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
616 ! abstract: read nemsio data by record number into a 2D 32bits array,
617 ! using w3_4 library to compile
618 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
619  implicit none
620  type(nemsio_gfile),intent(inout) :: gfile
621  integer(nemsio_intkind),intent(in) :: jrec
622  real(nemsio_realkind),intent(in) :: data(:)
623  integer(nemsio_intkind),optional,intent(out):: iret
624  integer(nemsio_intkind),optional,intent(in) :: idrt
625  integer(nemsio_intkind),optional,intent(in) :: itr
626  real(nemsio_realkind),optional,intent(in) :: zhour
627  integer(nemsio_intkind),optional,intent(in) :: precision
628  type(nemsio_grbmeta) :: grbmeta
629  integer(nemsio_intkind) :: N=nemsio_kpds_intfill
630  integer(nemsio_intkind) :: nc,i
631  integer(nemsio_intkind) :: ios,w34,ibms
632 !---
633  real(nemsio_realkind) :: mymax
634 !------------------------------------------------------------
635 ! set up grib meta
636 !------------------------------------------------------------
637  if(present(iret)) iret=-75
638  w34=1
639 !------------------------------------------------------------
640 ! set up grib meta lbms
641 !------------------------------------------------------------
642  ibms=0
643  if(any(abs(data)>=nemsio_undef_grb)) ibms=1
644 !
645  if(present(idrt)) then
646  call nemsio_setrqst(gfile,grbmeta,ios,jrec=jrec,w34=w34, &
647  idrt=idrt,itr=itr,zhour=zhour,ibms=ibms, &
648  precision=precision)
649  else
650  call nemsio_setrqst(gfile,grbmeta,ios,jrec=jrec,w34=w34, &
651  itr=itr,zhour=zhour,ibms=ibms,precision=precision)
652  endif
653  if (ios.ne.0) then
654  if ( present(iret)) then
655  iret=ios
656  return
657  else
658  call nemsio_stop
659  endif
660  endif
661 !
662  grbmeta%lbms=.true.
663  where(abs(data)>=nemsio_undef_grb) grbmeta%lbms=.false.
664  mymax=minval(data)
665  do i=1,myfieldsize
666  if(abs(data(i))<nemsio_undef_grb) then
667  if(data(i) .gt.mymax) mymax=data(i)
668  endif
669  enddo
670 !
671 !------------------------------------------------------------
672 ! check precision -- for pressure now
673 !------------------------------------------------------------
674  if ( grbmeta%jpds(5).eq.1 .and. grbmeta%jpds(6).eq.109 ) then
675  grbmeta%jpds(22)=min(int(6-log10(mymax)),4)
676  endif
677 !------------------------------------------------------------
678 ! get data from putgb _w34
679 !------------------------------------------------------------
680 !call putgben instead of getgb for oytgben has maxbits set to
681 !24, GRADS has issues with number bits >24
682  kens=0;ibs=0;nbits=0
683  call putgben(myflunit,grbmeta%jf,grbmeta%jpds,grbmeta%jgds, &
684  kens,ibs,nbits,grbmeta%lbms,data,ios)
685  deallocate(grbmeta%lbms)
686  if(ios.ne.0) then
687  if ( present(iret)) then
688  print *,'putgben_ios=',ios
689  iret=ios
690  return
691  else
692  call nemsio_stop
693  endif
694  endif
695  if(present(iret)) iret=0
696  end subroutine nemsio_writerecgrb4w34
697 !------------------------------------------------------------------------------
698  subroutine nemsio_writerecgrb4(gfile,jrec,data,iret,idrt,itr,zhour,precision)
699 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
700 ! abstract: read nemsio data by record number into a 2D 32bits array,
701 ! using w3_d library to compile
702 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
703  implicit none
704  type(nemsio_gfile),intent(inout) :: gfile
705  integer(nemsio_intkind),intent(in) :: jrec
706  real(nemsio_realkind),intent(in) :: data(:)
707  integer(nemsio_intkind),optional,intent(out):: iret
708  integer(nemsio_intkind),optional,intent(in) :: idrt
709  integer(nemsio_intkind),optional,intent(in) :: itr
710  real(nemsio_realkind),optional,intent(in) :: zhour
711  integer(nemsio_intkind),optional,intent(in) :: precision
712  real(nemsio_dblekind),allocatable :: data8(:)
713  type(nemsio_grbmeta) :: grbmeta
714  integer(nemsio_intkind) :: N=nemsio_kpds_intfill
715  integer(nemsio_intkind) :: nc,i,nc1
716  integer(nemsio_intkind) :: ios,ibms
717  real(nemsio_dblekind) :: mymax
718 !------------------------------------------------------------
719 ! set up grib meta
720 !------------------------------------------------------------
721  if(present(iret)) iret=-77
722 !------------------------------------------------------------
723 ! set up grib meta ibms
724 !------------------------------------------------------------
725  ibms=0
726 !
727  allocate(data8(size(data)) )
728  data8=data
729  if(any(abs(data8)>=nemsio_undef_grb)) ibms=1
730 !
731 !------------------------------------------------------------
732 ! set up grib meta data
733 !------------------------------------------------------------
734  if(present(idrt)) then
735  call nemsio_setrqst(gfile,grbmeta,ios,jrec=jrec,idrt=idrt, &
736  itr=itr,zhour=zhour,ibms=ibms,precision=precision)
737  else
738  call nemsio_setrqst(gfile,grbmeta,ios,jrec=jrec, &
739  itr=itr,zhour=zhour,ibms=ibms,precision=precision)
740  endif
741  if (ios.ne.0) then
742  if ( present(iret)) then
743  iret=ios
744  return
745  else
746  call nemsio_stop
747  endif
748  endif
749 !
750 !------------------------------------------------------------
751 ! set up lbms
752 !------------------------------------------------------------
753  grbmeta%lbms=.true.
754  where(abs(data8)>=nemsio_undef_grb) grbmeta%lbms=.false.
755  mymax=minval(data8)
756  do i=1,myfieldsize
757  if(abs(data8(i))<nemsio_undef_grb) then
758  if(data8(i) .gt.mymax) mymax=data8(i)
759  endif
760  enddo
761 ! write(0,*)'in writerecgrb4,max=',mymax,'imb=',ibms, &
762 ! 'size(data)=',size(data),'size(lbms)=',size(grbmeta%lbms), &
763 ! grbmeta%lbms(1:15),data8(1:15)
764 !
765 !------------------------------------------------------------
766 ! check precision -- for pressure now
767 !------------------------------------------------------------
768  if ( grbmeta%jpds(5).eq.1 .and. grbmeta%jpds(6).eq.109 ) then
769  grbmeta%jpds(22)=min(int(6-log10(mymax)),4)
770  endif
771 !------------------------------------------------------------
772 ! get data from putgb _w3d
773 !------------------------------------------------------------
774 !call putgben instead of getgb for oytgben has maxbits set to
775 !24, GRADS has issues with number bits >24
776  kens=0;ibs=0;nbits=0
777  call putgben(myflunit,grbmeta%jf,grbmeta%jpds,grbmeta%jgds, &
778  kens,ibs,nbits,grbmeta%lbms,data8,ios)
779 ! write(0,*)'in writerecgrb4,after putgb,iret=',ios,'jpds=',grbmeta%jpds(1:25), &
780 ! 'gds=',grbmeta%jgds(1:25),'data=',maxval(data8),minval(data8)
781  deallocate(grbmeta%lbms)
782  if(ios.ne.0) then
783  if ( present(iret)) then
784  print *,'putgben_ios=',ios
785  iret=ios
786  return
787  else
788  call nemsio_stop
789  endif
790  endif
791  if(present(iret)) iret=0
792  end subroutine nemsio_writerecgrb4
793 !------------------------------------------------------------------------------
794  subroutine nemsio_writerecgrb8(gfile,jrec,data8,iret,idrt,itr,zhour,precision)
795 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
796 ! abstract: read nemsio data by record number into a 2D 64bits array,
797 ! using w3_d library to compile
798 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
799  implicit none
800  type(nemsio_gfile),intent(inout) :: gfile
801  integer(nemsio_intkind),intent(in) :: jrec
802  real(nemsio_dblekind),intent(in) :: data8(:)
803  integer(nemsio_intkind),optional,intent(out):: iret
804  integer(nemsio_intkind),optional,intent(in) :: idrt
805  integer(nemsio_intkind),optional,intent(in) :: itr
806  real(nemsio_realkind),optional,intent(in) :: zhour
807  integer(nemsio_intkind),optional,intent(in) :: precision
808  type(nemsio_grbmeta) :: grbmeta
809  integer(nemsio_intkind) :: N=nemsio_kpds_intfill
810  integer(nemsio_intkind) :: nc,i
811  integer(nemsio_intkind) :: ios,ibms
812 !---
813  real(nemsio_dblekind) :: mymax
814 !------------------------------------------------------------
815 ! set up grib meta
816 !------------------------------------------------------------
817  if(present(iret)) iret=-77
818 !------------------------------------------------------------
819 ! set up grib meta lbms
820 !------------------------------------------------------------
821  ibms=0
822  if(any(abs(data8)>=nemsio_undef_grb)) ibms=1
823 !
824  if(present(idrt)) then
825  call nemsio_setrqst(gfile,grbmeta,ios,jrec=jrec,idrt=idrt, &
826  itr=itr,zhour=zhour,ibms=ibms,precision=precision)
827  else
828  call nemsio_setrqst(gfile,grbmeta,ios,jrec=jrec, &
829  itr=itr,zhour=zhour,ibms=ibms,precision=precision)
830  endif
831  if (ios.ne.0) then
832  if ( present(iret)) then
833  iret=ios
834  return
835  else
836  call nemsio_stop
837  endif
838  endif
839 !
840  grbmeta%lbms=.true.
841  where(abs(data8)>=nemsio_undef_grb) grbmeta%lbms=.false.
842  mymax=minval(data8)
843  do i=1,myfieldsize
844  if(abs(data8(i))<nemsio_undef_grb) then
845  if(data8(i) .gt.mymax) mymax=data8(i)
846  endif
847  enddo
848 !
849 !------------------------------------------------------------
850 ! check precision -- for pressure now
851 !------------------------------------------------------------
852  if ( grbmeta%jpds(5).eq.1 .and. grbmeta%jpds(6).eq.109 ) then
853  grbmeta%jpds(22)=min(int(6-log10(mymax)),4)
854  endif
855 !------------------------------------------------------------
856 ! get data from putgb _w3d
857 !------------------------------------------------------------
858 !call putgben instead of getgb for oytgben has maxbits set to
859 !24, GRADS has issues with number bits >24
860  kens=0;ibs=0;nbits=0
861  call putgben(myflunit,grbmeta%jf,grbmeta%jpds,grbmeta%jgds, &
862  kens,ibs,nbits,grbmeta%lbms,data8,ios)
863  deallocate(grbmeta%lbms)
864  if(ios.ne.0) then
865  if ( present(iret)) then
866  print *,'putgben_ios=',ios
867  iret=ios
868  return
869  else
870  call nemsio_stop
871  endif
872  endif
873  if(present(iret)) iret=0
874  end subroutine nemsio_writerecgrb8
875 !------------------------------------------------------------------------------
876  subroutine nemsio_writerecvgrb4w34(gfile,vname,vlevtyp,vlev,data,iret,idrt, &
877  itr,zhour,precision)
878 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
879 ! abstract: read nemsio data by field name into a 2D 32bits array,
880 ! using w3_4 library to compile
881 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
882  implicit none
883  type(nemsio_gfile),intent(inout) :: gfile
884  character*(*),intent(in) :: vname,vlevtyp
885  integer(nemsio_intkind),intent(in) :: vlev
886  real(nemsio_realkind),intent(in) :: data(:)
887  integer(nemsio_intkind),optional,intent(out):: iret
888  integer(nemsio_intkind),optional,intent(in) :: idrt
889  integer(nemsio_intkind),optional,intent(in) :: itr
890  real(nemsio_realkind),optional,intent(in) :: zhour
891  integer(nemsio_intkind),optional,intent(in) :: precision
892  type(nemsio_grbmeta) :: grbmeta
893  integer(nemsio_intkind) :: N=nemsio_kpds_intfill
894  integer(nemsio_intkind) :: nc,i
895  integer(nemsio_intkind) :: ios,w34,ibms
896  real(nemsio_realkind) :: mymax
897 !------------------------------------------------------------
898 ! set up grib meta
899 !------------------------------------------------------------
900  if(present(iret)) iret=-76
901 !------------------------------------------------------------
902 ! set up grib meta lbms
903 !------------------------------------------------------------
904  ibms=0
905  if(any(abs(data)>=nemsio_undef_grb)) ibms=1
906 !
907  w34=1
908  if(present(idrt)) then
909  call nemsio_setrqst(gfile,grbmeta,ios,vname=vname, &
910  vlevtyp=vlevtyp, vlev=vlev, w34=w34, idrt=idrt, &
911  itr=itr,zhour=zhour,ibms=ibms,precision=precision)
912  else
913  call nemsio_setrqst(gfile,grbmeta,ios,vname=vname, &
914  vlevtyp=vlevtyp, vlev=vlev, w34=w34,itr=itr, &
915  zhour=zhour,ibms=ibms,precision=precision)
916  endif
917  if (ios.ne.0) then
918  if ( present(iret)) then
919  iret=ios
920  return
921  else
922  call nemsio_stop
923  endif
924  endif
925 !
926  grbmeta%lbms=.true.
927  where(abs(data)>=nemsio_undef_grb) grbmeta%lbms=.false.
928  mymax=minval(data)
929  do i=1,myfieldsize
930  if(abs(data(i))<nemsio_undef_grb) then
931  if(data(i) .gt.mymax) mymax=data(i)
932  endif
933  enddo
934 !
935 !------------------------------------------------------------
936 ! check precision -- for pressure now
937 !------------------------------------------------------------
938  if ( grbmeta%jpds(5).eq.1 .and. grbmeta%jpds(6).eq.109 ) then
939  grbmeta%jpds(22)=min(int(6-log10(mymax)),4)
940  endif
941 !------------------------------------------------------------
942 ! get data from putgb _w34
943 !------------------------------------------------------------
944 !call putgben instead of getgb for putgben has maxbits set to
945 !24, GRADS has issues with number bits >24
946  kens=0;ibs=0;nbits=0
947  call putgben(myflunit,grbmeta%jf,grbmeta%jpds,grbmeta%jgds, &
948  kens,ibs,nbits,grbmeta%lbms,data,ios)
949  deallocate(grbmeta%lbms)
950  if(ios.ne.0) then
951  if ( present(iret)) then
952  print *,'putgben_ios=',ios
953  iret=ios
954  return
955  else
956  call nemsio_stop
957  endif
958  endif
959  if(present(iret)) iret=0
960  end subroutine nemsio_writerecvgrb4w34
961 !------------------------------------------------------------------------------
962  Subroutine nemsio_writerecvgrb4(gfile,vname,vlevtyp,vlev,data,iret,idrt, &
963  itr,zhour,precision)
964 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
965 ! abstract: read nemsio data by field name into a 2D 32bits array,
966 ! using w3_d library to compile
967 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
968  implicit none
969  type(nemsio_gfile),intent(inout) :: gfile
970  character*(*),intent(in) :: vname,vlevtyp
971  integer(nemsio_intkind),intent(in) :: vlev
972  real(nemsio_realkind),intent(in) :: data(:)
973  integer(nemsio_intkind),optional,intent(out):: iret
974  integer(nemsio_intkind),optional,intent(in) :: idrt
975  integer(nemsio_intkind),optional,intent(in) :: itr
976  real(nemsio_realkind),optional,intent(in) :: zhour
977  integer(nemsio_intkind),optional,intent(in) :: precision
978  real(nemsio_dblekind),allocatable :: data8(:)
979  type(nemsio_grbmeta) :: grbmeta
980  integer(nemsio_intkind) :: N=nemsio_kpds_intfill
981  integer(nemsio_intkind) :: nc,i
982  integer(nemsio_intkind) :: ios,ibms
983  real(nemsio_dblekind) :: mymax
984 !------------------------------------------------------------
985 ! set up grib meta
986 !------------------------------------------------------------
987  if(present(iret)) iret=-78
988 !------------------------------------------------------------
989 ! set up grib meta lbms
990 !------------------------------------------------------------
991  ibms=0
992  if(any(abs(data)>=nemsio_undef_grb)) ibms=1
993 !
994  if(present(idrt)) then
995  call nemsio_setrqst(gfile,grbmeta,ios,vname=vname, &
996  vlevtyp=vlevtyp, vlev=vlev, idrt=idrt,itr=itr, &
997  zhour=zhour,ibms=ibms,precision=precision)
998  else
999  call nemsio_setrqst(gfile,grbmeta,ios,vname=vname, &
1000  vlevtyp=vlevtyp, vlev=vlev,itr=itr,zhour=zhour, &
1001  ibms=ibms,precision=precision)
1002  endif
1003  if (ios.ne.0) then
1004  if ( present(iret)) then
1005  iret=ios
1006  return
1007  else
1008  call nemsio_stop
1009  endif
1010  endif
1011 !
1012  allocate(data8(size(data)) )
1013  data8=data
1014 !
1015  grbmeta%lbms=.true.
1016  where(abs(data8)>=nemsio_undef_grb) grbmeta%lbms=.false.
1017  mymax=minval(data8)
1018  do i=1,myfieldsize
1019  if(abs(data8(i))<nemsio_undef_grb) then
1020  if(data8(i) .gt.mymax) mymax=data8(i)
1021  endif
1022  enddo
1023 !
1024 !------------------------------------------------------------
1025 ! check precision -- for pressure now
1026 !------------------------------------------------------------
1027  if ( grbmeta%jpds(5).eq.1 .and. grbmeta%jpds(6).eq.109 ) then
1028  grbmeta%jpds(22)=min(int(6-log10(mymax)),4)
1029  endif
1030 !------------------------------------------------------------
1031 ! get data from putgb _w3d
1032 !------------------------------------------------------------
1033 !call putgben instead of getgb for oytgben has maxbits set to
1034 !24, GRADS has issues with number bits >24
1035  kens=0;ibs=0;nbits=0
1036  call putgben(myflunit,grbmeta%jf,grbmeta%jpds,grbmeta%jgds, &
1037  kens,ibs,nbits,grbmeta%lbms,data8,ios)
1038  deallocate(grbmeta%lbms)
1039  if(ios.ne.0) then
1040  if ( present(iret)) then
1041  print *,'putgben_ios=',ios
1042  iret=ios
1043  return
1044  else
1045  call nemsio_stop
1046  endif
1047  endif
1048  if(present(iret)) iret=0
1049  end subroutine nemsio_writerecvgrb4
1050 !------------------------------------------------------------------------------
1051  subroutine nemsio_writerecvgrb8(gfile,vname,vlevtyp,vlev,data8,iret,idrt,itr, &
1052  zhour,precision)
1053 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
1054 ! abstract: read nemsio data by field name into a 2D 64bits array,
1055 ! using w3_d library to compile
1056 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- - - - - - - -
1057  implicit none
1058  type(nemsio_gfile),intent(inout) :: gfile
1059  character*(*),intent(in) :: vname,vlevtyp
1060  integer(nemsio_intkind),intent(in) :: vlev
1061  real(nemsio_dblekind),intent(in) :: data8(:)
1062  integer(nemsio_intkind),optional,intent(out):: iret
1063  integer(nemsio_intkind),optional,intent(in) :: idrt
1064  integer(nemsio_intkind),optional,intent(in) :: itr
1065  real(nemsio_realkind),optional,intent(in) :: zhour
1066  integer(nemsio_intkind),optional,intent(in) :: precision
1067  type(nemsio_grbmeta) :: grbmeta
1068  integer(nemsio_intkind) :: N=nemsio_kpds_intfill
1069  integer(nemsio_intkind) :: nc,i
1070  integer(nemsio_intkind) :: ios,ibms
1071  real(nemsio_dblekind) :: mymax
1072 !------------------------------------------------------------
1073 ! set up grib meta
1074 !------------------------------------------------------------
1075  if(present(iret)) iret=-78
1076 !------------------------------------------------------------
1077 ! set up grib meta lbms
1078 !------------------------------------------------------------
1079  ibms=0
1080  if(any(abs(data8)>=nemsio_undef_grb)) ibms=1
1081 !
1082  if(present(idrt)) then
1083  call nemsio_setrqst(gfile,grbmeta,ios,vname=vname, &
1084  vlevtyp=vlevtyp, vlev=vlev, idrt=idrt,itr=itr, &
1085  zhour=zhour,ibms=ibms,precision=precision)
1086  else
1087  call nemsio_setrqst(gfile,grbmeta,ios,vname=vname, &
1088  vlevtyp=vlevtyp, vlev=vlev,itr=itr,zhour=zhour, &
1089  ibms=ibms,precision=precision)
1090  endif
1091  if (ios.ne.0) then
1092  if ( present(iret)) then
1093  iret=ios
1094  return
1095  else
1096  call nemsio_stop
1097  endif
1098  endif
1099 !
1100  grbmeta%lbms=.true.
1101  where(abs(data8)>=nemsio_undef_grb) grbmeta%lbms=.false.
1102  mymax=minval(data8)
1103  do i=1,myfieldsize
1104  if(abs(data8(i))<nemsio_undef_grb) then
1105  if(data8(i) .gt.mymax) mymax=data8(i)
1106  endif
1107  enddo
1108 !
1109 !------------------------------------------------------------
1110 ! check precision -- for pressure now
1111 !------------------------------------------------------------
1112  if ( grbmeta%jpds(5).eq.1 .and. grbmeta%jpds(6).eq.109 ) then
1113  grbmeta%jpds(22)=min(int(6-log10(mymax)),4)
1114  endif
1115 !------------------------------------------------------------
1116 ! get data from putgb _w3d
1117 !------------------------------------------------------------
1118 !call putgben instead of getgb for oytgben has maxbits set to
1119 !24, GRADS has issues with number bits >24
1120  kens=0;ibs=0;nbits=0
1121  call putgben(myflunit,grbmeta%jf,grbmeta%jpds,grbmeta%jgds, &
1122  kens,ibs,nbits,grbmeta%lbms,data8,ios)
1123  deallocate(grbmeta%lbms)
1124  if(ios.ne.0) then
1125  if ( present(iret)) then
1126  print *,'putgben_ios=',ios
1127  iret=ios
1128  return
1129  else
1130  call nemsio_stop
1131  endif
1132  endif
1133  if(present(iret)) iret=0
1134  end subroutine nemsio_writerecvgrb8
1135 !----------------------------------------------------------------------------
1136 end module nemsio_write