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