SCALE-RM
scale_external_io.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
14 module scale_external_io
15  !-----------------------------------------------------------------------------
16  !
17  !++ used modules
18  !
19  use gtool_file, only: &
20  filemakefname
21  use scale_precision
22  use scale_stdio
23  use scale_grid_index
24  use scale_process, only: &
25  prc_mpistop
26  !-----------------------------------------------------------------------------
27  implicit none
28  private
29  !-----------------------------------------------------------------------------
30  !
31  !++ Public procedure
32  !
33  public :: externalfilegetshape
34  public :: externalfilegetglobalattv
35  public :: externalfilegetglobalattc
36  public :: externalfilevarexistence
37  public :: externalfileread
38  public :: externalfilereadoffset
39 
40  interface externalfilegetglobalattv
41  module procedure externalfilegetglobalattvinteger
42  module procedure externalfilegetglobalattvrealsp
43  module procedure externalfilegetglobalattvrealdp
44  end interface externalfilegetglobalattv
45 
46  interface externalfileread
47  module procedure externalfileread2drealsp
48  module procedure externalfileread2drealdp
49  module procedure externalfileread3drealsp
50  module procedure externalfileread3drealdp
51  module procedure externalfileread4drealsp
52  module procedure externalfileread4drealdp
53  end interface externalfileread
54 
55  interface externalfilereadoffset
56  !module procedure ExternalFileRead2DRealSP
57  !module procedure ExternalFileRead2DRealDP
58  module procedure externalfilereadoffset3drealsp
59  module procedure externalfilereadoffset3drealdp
60  module procedure externalfilereadoffset4drealsp
61  module procedure externalfilereadoffset4drealdp
62  end interface externalfilereadoffset
63 
64  !-----------------------------------------------------------------------------
65  !
66  !++ Public parameters & variables
67  !
68  integer, public, parameter :: iscale = 1 ! use gtool, coz it's not external
69  integer, public, parameter :: iwrfarw = 2
70  integer, public, parameter :: inicam = 3
71  integer, public, parameter :: igrads = 4
72 
73 
74  !-----------------------------------------------------------------------------
75  !
76  !++ Private procedure
77  !
78  private :: externalfilemakefname
79  private :: externaltakedimension
80  private :: convertarrayorder
81  private :: handle_err
82 
83  interface convertarrayorder
84  module procedure convertarrayorderwrf2dsp
85  module procedure convertarrayorderwrf2ddp
86  module procedure convertarrayorderwrf3dsp
87  module procedure convertarrayorderwrf3ddp
88  module procedure convertarrayorderwrf4dsp
89  module procedure convertarrayorderwrf4ddp
90  end interface convertarrayorder
91 
92  !-----------------------------------------------------------------------------
93  !
94  !++ Private parameters & variables
95  !
96  !-----------------------------------------------------------------------------
97 contains
98 
99  !-----------------------------------------------------------------------------
100  ! ExternalFileGetShape
101  !-----------------------------------------------------------------------------
102  subroutine externalfilegetshape( &
103  dims, & ! (out)
104  timelen, & ! (out)
105  mdlid, & ! (in)
106  basename, & ! (in)
107  myrank, & ! (in)
108  single & ! (in) optional
109  )
110  use netcdf ![external lib]
111  implicit none
112 
113  integer, intent(out) :: dims(:)
114  integer, intent(out) :: timelen
115  integer, intent( in) :: mdlid
116  character(len=*), intent( in) :: basename
117  integer, intent( in) :: myrank
118  logical, intent( in), optional :: single
119 
120  integer :: status
121  integer :: ncid, unlimid
122  integer :: dims_org(7)
123  character(len=NF90_MAX_NAME) :: tname
124  character(len=H_LONG) :: fname = ''
125  logical :: single_ = .false.
126 
127  intrinsic size
128  intrinsic shape
129  !---------------------------------------------------------------------------
130 
131  if ( present(single) ) then
132  single_ = single
133  else
134  single_ = .false.
135  endif
136 
137  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
138 
139  status = nf90_open( trim(fname), nf90_nowrite, ncid )
140  if (status /= nf90_noerr) call handle_err(status, __line__)
141 
142  status = nf90_inquire( ncid, unlimiteddimid=unlimid )
143  if (status /= nf90_noerr) call handle_err(status, __line__)
144 
145  status = nf90_inquire_dimension( ncid, unlimid, tname, timelen )
146  if (status /= nf90_noerr) call handle_err(status, __line__)
147 
148  if( trim(tname)=='time' .OR. trim(tname)=='Time' ) then
149  if( io_l ) write(io_fid_log,*) 'Time Dimension Name: '//trim(tname)
150  else
151  write(*,*) 'xxx Not appropriate time dimension is used in the external file. Check!'
152  call prc_mpistop
153  endif
154 
155  call externaltakedimension( dims_org(:),ncid,mdlid )
156 
157  ! convert dimension order for return to scale-system
158  if( mdlid == iwrfarw )then !MODEL ID: WRF-ARW
159  dims(1) = dims_org(3)
160  dims(2) = dims_org(1)
161  dims(3) = dims_org(2)
162  dims(4) = dims_org(6)
163  dims(5) = dims_org(4)
164  dims(6) = dims_org(5)
165  dims(7) = dims_org(7)
166  else
167  dims(:) = dims_org(:)
168  endif
169 
170  status = nf90_close(ncid)
171  if (status /= nf90_noerr) call handle_err(status, __line__)
172 
173  return
174  end subroutine externalfilegetshape
175 
176  !-----------------------------------------------------------------------------
177  ! ExternalFileGet Global Attribute (value, real, single precision)
178  !-----------------------------------------------------------------------------
179  subroutine externalfilegetglobalattvinteger( &
180  var, & ! (out)
181  mdlid, & ! (in)
182  basename, & ! (in)
183  attname, & ! (in)
184  myrank, & ! (in)
185  single & ! (in) optional
186  )
187  use netcdf ![external lib]
188  implicit none
189 
190  integer, intent(out) :: var(:)
191  integer, intent( in) :: mdlid
192  character(len=*), intent( in) :: basename
193  character(len=*), intent( in) :: attname
194  integer, intent( in) :: myrank
195  logical, intent( in), optional :: single
196 
197  integer, allocatable :: work(:)
198 
199  integer :: status
200  integer :: i, ncid, length
201  character(len=H_LONG) :: fname = ''
202  logical :: single_ = .false.
203 
204  intrinsic size
205  intrinsic shape
206  !---------------------------------------------------------------------------
207 
208  if ( present(single) ) then
209  single_ = single
210  else
211  single_ = .false.
212  endif
213 
214  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
215 
216  status = nf90_open( trim(fname), nf90_nowrite, ncid )
217  if (status /= nf90_noerr) call handle_err(status, __line__)
218 
219  status = nf90_inquire_attribute(ncid, nf90_global, trim(attname), len=length)
220  if (status /= nf90_noerr) call handle_err(status, __line__)
221 
222  allocate( work(length) )
223 
224  status = nf90_get_att(ncid, nf90_global, trim(attname), work)
225  if (status /= nf90_noerr) call handle_err(status, __line__)
226 
227  do i = 1, length
228  var(i) = work(i)
229  enddo
230 
231  status = nf90_close(ncid)
232  if (status /= nf90_noerr) call handle_err(status, __line__)
233  deallocate( work )
234 
235  return
236  end subroutine externalfilegetglobalattvinteger
237 
238  !-----------------------------------------------------------------------------
239  ! ExternalFileGet Global Attribute (value, real, single precision)
240  !-----------------------------------------------------------------------------
241  subroutine externalfilegetglobalattvrealsp( &
242  var, & ! (out)
243  mdlid, & ! (in)
244  basename, & ! (in)
245  attname, & ! (in)
246  myrank, & ! (in)
247  single & ! (in) optional
248  )
249  use netcdf ![external lib]
250  implicit none
251 
252  real(SP), intent(out) :: var(:)
253  integer, intent( in) :: mdlid
254  character(len=*), intent( in) :: basename
255  character(len=*), intent( in) :: attname
256  integer, intent( in) :: myrank
257  logical, intent( in), optional :: single
258 
259  real(SP), allocatable :: work(:)
260 
261  integer :: status
262  integer :: i, ncid, length
263  character(len=H_LONG) :: fname = ''
264  logical :: single_ = .false.
265 
266  intrinsic size
267  intrinsic shape
268  !---------------------------------------------------------------------------
269 
270  if ( present(single) ) then
271  single_ = single
272  else
273  single_ = .false.
274  endif
275 
276  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
277 
278  status = nf90_open( trim(fname), nf90_nowrite, ncid )
279  if (status /= nf90_noerr) call handle_err(status, __line__)
280 
281  status = nf90_inquire_attribute(ncid, nf90_global, trim(attname), len=length)
282  if (status /= nf90_noerr) call handle_err(status, __line__)
283 
284  allocate( work(length) )
285 
286  status = nf90_get_att(ncid, nf90_global, trim(attname), work)
287  if (status /= nf90_noerr) call handle_err(status, __line__)
288 
289  do i = 1, length
290  var(i) = work(i)
291  enddo
292 
293  status = nf90_close(ncid)
294  if (status /= nf90_noerr) call handle_err(status, __line__)
295  deallocate( work )
296 
297  return
298  end subroutine externalfilegetglobalattvrealsp
299 
300  !-----------------------------------------------------------------------------
301  ! ExternalFileGet Global Attribute (value, real, single precision)
302  !-----------------------------------------------------------------------------
303  subroutine externalfilegetglobalattvrealdp( &
304  var, & ! (out)
305  mdlid, & ! (in)
306  basename, & ! (in)
307  attname, & ! (in)
308  myrank, & ! (in)
309  single & ! (in) optional
310  )
311  use netcdf ![external lib]
312  implicit none
313 
314  real(DP), intent(out) :: var(:)
315  integer, intent( in) :: mdlid
316  character(len=*), intent( in) :: basename
317  character(len=*), intent( in) :: attname
318  integer, intent( in) :: myrank
319  logical, intent( in), optional :: single
320 
321  real(DP), allocatable :: work(:)
322 
323  integer :: status
324  integer :: i, ncid, length
325  character(len=H_LONG) :: fname = ''
326  logical :: single_ = .false.
327 
328  intrinsic size
329  intrinsic shape
330  !---------------------------------------------------------------------------
331 
332  if ( present(single) ) then
333  single_ = single
334  else
335  single_ = .false.
336  endif
337 
338  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
339 
340  status = nf90_open( trim(fname), nf90_nowrite, ncid )
341  if (status /= nf90_noerr) call handle_err(status, __line__)
342 
343  status = nf90_inquire_attribute(ncid, nf90_global, trim(attname), len=length)
344  if (status /= nf90_noerr) call handle_err(status, __line__)
345 
346  allocate( work(length) )
347 
348  status = nf90_get_att(ncid, nf90_global, trim(attname), work)
349  if (status /= nf90_noerr) call handle_err(status, __line__)
350 
351  do i = 1, length
352  var(i) = work(i)
353  enddo
354 
355  status = nf90_close(ncid)
356  if (status /= nf90_noerr) call handle_err(status, __line__)
357  deallocate( work )
358 
359  return
360  end subroutine externalfilegetglobalattvrealdp
361 
362  !-----------------------------------------------------------------------------
363  ! ExternalFileGet Global Attribute (character)
364  !-----------------------------------------------------------------------------
365  subroutine externalfilegetglobalattc( &
366  chr, & ! (out)
367  mdlid, & ! (in)
368  basename, & ! (in)
369  attname, & ! (in)
370  myrank, & ! (in)
371  single & ! (in) optional
372  )
373  use netcdf ![external lib]
374  implicit none
375 
376  character(len=*), intent(out) :: chr(:)
377  integer, intent( in) :: mdlid
378  character(len=*), intent( in) :: basename
379  character(len=*), intent( in) :: attname
380  integer, intent( in) :: myrank
381  logical, intent( in), optional :: single
382 
383  integer :: status
384  integer :: ncid, length
385  character(len=H_LONG) :: fname = ''
386  character(len=80) :: work
387  logical :: single_ = .false.
388 
389  intrinsic size
390  intrinsic shape
391  !---------------------------------------------------------------------------
392 
393  if ( present(single) ) then
394  single_ = single
395  else
396  single_ = .false.
397  endif
398 
399  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
400 
401  status = nf90_open( trim(fname), nf90_nowrite, ncid )
402  if (status /= nf90_noerr) call handle_err(status, __line__)
403 
404  status = nf90_inquire_attribute(ncid, nf90_global, trim(attname), len=length)
405  if (status /= nf90_noerr) call handle_err(status, __line__)
406 
407  if( len(work) < length ) then
408  write(*,*) 'xxx Not enough space to put attribute values. [externalio/scalelib]'
409  call prc_mpistop
410  endif
411 
412  status = nf90_get_att(ncid, nf90_global, trim(attname), work)
413  if (status /= nf90_noerr) call handle_err(status, __line__)
414 
415  chr = trim(work)
416 
417  return
418  end subroutine externalfilegetglobalattc
419 
420  !-----------------------------------------------------------------------------
422  !-----------------------------------------------------------------------------
423  subroutine externalfilevarexistence( &
424  existence, & ! (out)
425  basename, & ! (in)
426  varname, & ! (in)
427  myrank, & ! (in)
428  mdlid, & ! (in)
429  single & ! (in) optional
430  )
431  use netcdf ![external lib]
432  implicit none
433 
434  logical, intent(out) :: existence
435  character(len=*), intent( in) :: basename
436  character(len=*), intent( in) :: varname
437  integer, intent( in) :: myrank
438  integer, intent( in) :: mdlid
439  logical, intent( in), optional :: single
440 
441  integer :: ncid, varid
442  integer :: status
443 
444  character(len=H_LONG) :: fname = ''
445  logical :: single_ = .false.
446 
447  intrinsic size
448  intrinsic shape
449  !---------------------------------------------------------------------------
450 
451  if ( present(single) ) then
452  single_ = single
453  else
454  single_ = .false.
455  endif
456 
457  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
458 
459  status = nf90_open( trim(fname), nf90_nowrite, ncid )
460  if (status /= nf90_noerr) call handle_err(status, __line__)
461 
462  status = nf90_inq_varid( ncid, trim(varname), varid )
463  if (status == nf90_noerr) then
464  existence = .true.
465  else
466  existence = .false.
467  if( io_l ) write(io_fid_log,*) '+++ not exist variable: ', trim(varname)
468  endif
469 
470  status = nf90_close(ncid)
471  if (status /= nf90_noerr) call handle_err(status, __line__)
472 
473  return
474  end subroutine externalfilevarexistence
475 
476  !-----------------------------------------------------------------------------
478  !-----------------------------------------------------------------------------
479  subroutine externalfileread2drealsp( &
480  var, & ! (out)
481  basename, & ! (in)
482  varname, & ! (in)
483  ts, & ! (in)
484  te, & ! (in)
485  myrank, & ! (in)
486  mdlid, & ! (in)
487  nx, & ! (in)
488  single & ! (in) optional
489  )
490  use netcdf ![external lib]
491  implicit none
492 
493  real(SP), intent(out) :: var(:,:)
494  character(len=*), intent( in) :: basename
495  character(len=*), intent( in) :: varname
496  integer, intent( in) :: ts
497  integer, intent( in) :: te
498  integer, intent( in) :: myrank
499  integer, intent( in) :: mdlid
500  integer, intent( in) :: nx
501  logical, intent( in), optional :: single
502 
503  real(SP), allocatable :: var_org(:,:)
504  integer :: ncid, varid
505  integer :: status
506  integer :: precis
507 
508  integer :: tcount
509  character(len=H_LONG) :: fname = ''
510  logical :: single_ = .false.
511 
512  intrinsic size
513  intrinsic shape
514  !---------------------------------------------------------------------------
515 
516  tcount = te - ts + 1
517 
518  if ( present(single) ) then
519  single_ = single
520  else
521  single_ = .false.
522  endif
523 
524  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
525 
526  status = nf90_open( trim(fname), nf90_nowrite, ncid )
527  if (status /= nf90_noerr) call handle_err(status, __line__)
528 
529  ! based on specified dimension size
530  allocate( var_org(nx,tcount) )
531 
532  status = nf90_inq_varid( ncid, trim(varname), varid )
533  if (status /= nf90_noerr) call handle_err(status, __line__)
534 
535  status = nf90_inquire_variable( ncid, varid, xtype=precis )
536  if(status /= nf90_noerr) call handle_err(status, __line__)
537  if(precis /= nf90_float) then
538  write(*,*) 'xxx Internal Error: [scale_external_io]/[ExternalFileRead2DSP]'
539  call prc_mpistop
540  endif
541 
542  status = nf90_get_var( ncid, varid, var_org(:,:), start = (/ 1,ts /), &
543  count = (/ nx,tcount /) )
544  if (status /= nf90_noerr) call handle_err(status, __line__)
545 
546  status = nf90_close(ncid)
547  if (status /= nf90_noerr) call handle_err(status, __line__)
548 
549  call convertarrayorder( var,var_org,tcount,nx )
550 
551  deallocate( var_org )
552 
553  return
554  end subroutine externalfileread2drealsp
555  subroutine externalfileread2drealdp( &
556  var, & ! (out)
557  basename, & ! (in)
558  varname, & ! (in)
559  ts, & ! (in)
560  te, & ! (in)
561  myrank, & ! (in)
562  mdlid, & ! (in)
563  nx, & ! (in)
564  single & ! (in) optional
565  )
566  use netcdf ![external lib]
567  implicit none
568 
569  real(DP), intent(out) :: var(:,:)
570  character(len=*), intent( in) :: basename
571  character(len=*), intent( in) :: varname
572  integer, intent( in) :: ts
573  integer, intent( in) :: te
574  integer, intent( in) :: myrank
575  integer, intent( in) :: mdlid
576  integer, intent( in) :: nx
577  logical, intent( in), optional :: single
578 
579  real(DP), allocatable :: var_org(:,:)
580  integer :: ncid, varid
581  integer :: status
582  integer :: precis
583 
584  integer :: tcount
585  character(len=H_LONG) :: fname = ''
586  logical :: single_ = .false.
587 
588  intrinsic size
589  intrinsic shape
590  !---------------------------------------------------------------------------
591 
592  tcount = te - ts + 1
593 
594  if ( present(single) ) then
595  single_ = single
596  else
597  single_ = .false.
598  endif
599 
600  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
601 
602  status = nf90_open( trim(fname), nf90_nowrite, ncid )
603  if (status /= nf90_noerr) call handle_err(status, __line__)
604 
605  ! based on specified dimension size
606  allocate( var_org(nx,tcount) )
607 
608  status = nf90_inq_varid( ncid, trim(varname), varid )
609  if (status /= nf90_noerr) call handle_err(status, __line__)
610 
611  status = nf90_inquire_variable( ncid, varid, xtype=precis )
612  if(status /= nf90_noerr) call handle_err(status, __line__)
613  if(precis /= nf90_double) then
614  write(*,*) 'xxx Internal Error: [scale_external_io]/[ExternalFileRead2DDP]'
615  call prc_mpistop
616  endif
617 
618  status = nf90_get_var( ncid, varid, var_org(:,:), start = (/ 1,ts /), &
619  count = (/ nx,tcount /) )
620  if (status /= nf90_noerr) call handle_err(status, __line__)
621 
622  status = nf90_close(ncid)
623  if (status /= nf90_noerr) call handle_err(status, __line__)
624 
625  call convertarrayorder( var,var_org,tcount,nx )
626 
627  deallocate( var_org )
628 
629  return
630  end subroutine externalfileread2drealdp
631  subroutine externalfileread3drealsp( &
632  var, & ! (out)
633  basename, & ! (in)
634  varname, & ! (in)
635  ts, & ! (in)
636  te, & ! (in)
637  myrank, & ! (in)
638  mdlid, & ! (in)
639  single, & ! (in) optional
640  xstag, & ! (in) optional
641  ystag, & ! (in) optional
642  option & ! (in) optional
643  )
644  use netcdf ![external lib]
645  implicit none
646 
647  real(SP), intent(out) :: var(:,:,:)
648  character(len=*), intent( in) :: basename
649  character(len=*), intent( in) :: varname
650  integer, intent( in) :: ts
651  integer, intent( in) :: te
652  integer, intent( in) :: myrank
653  integer, intent( in) :: mdlid
654  logical, intent( in), optional :: single
655  logical, intent( in), optional :: xstag
656  logical, intent( in), optional :: ystag
657  logical, intent( in), optional :: option
658 
659  real(SP), allocatable :: var_org(:,:,:)
660  integer :: ncid, varid
661  integer :: status
662  integer :: precis
663  integer :: nx, ny
664  integer :: dims(7)
665 
666  integer :: tcount
667  character(len=H_LONG) :: fname = ''
668  logical :: single_ = .false.
669  logical :: option_ = .false.
670 
671  intrinsic size
672  intrinsic shape
673  !---------------------------------------------------------------------------
674 
675  tcount = te - ts + 1
676 
677  if ( present(single) ) then
678  single_ = single
679  endif
680 
681  if ( present(option) ) then
682  option_ = option
683  end if
684 
685  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
686 
687  status = nf90_open( trim(fname), nf90_nowrite, ncid )
688  if (status /= nf90_noerr) then
689  if ( option_ ) then
690  return
691  else
692  call handle_err(status, __line__)
693  end if
694  end if
695 
696  ! retrieve dimension size in data original order
697  call externaltakedimension( dims(:),ncid,mdlid )
698  nx = dims(1)
699  if ( present(xstag) ) then
700  if ( xstag ) then
701  nx = dims(4)
702  endif
703  endif
704  ny = dims(2)
705  if ( present(ystag) ) then
706  if ( ystag ) then
707  ny = dims(5)
708  endif
709  endif
710  allocate( var_org(nx,ny,tcount) )
711 
712  status = nf90_inq_varid( ncid, trim(varname), varid )
713  if (status /= nf90_noerr) call handle_err(status, __line__)
714 
715  status = nf90_inquire_variable( ncid, varid, xtype=precis )
716  if(status /= nf90_noerr) call handle_err(status, __line__)
717  if(precis /= nf90_float) then
718  write(*,*) 'xxx Internal Error: [scale_external_io]/[ExternalFileRead3DSP]'
719  call prc_mpistop
720  endif
721 
722  status = nf90_get_var( ncid, varid, var_org(:,:,:), start = (/ 1,1,ts /), &
723  count = (/ nx,ny,tcount /) )
724  if (status /= nf90_noerr) call handle_err(status, __line__)
725 
726  status = nf90_close(ncid)
727  if (status /= nf90_noerr) call handle_err(status, __line__)
728 
729  call convertarrayorder( var,var_org,tcount,nx,ny )
730 
731  deallocate( var_org )
732 
733  return
734  end subroutine externalfileread3drealsp
735  subroutine externalfileread3drealdp( &
736  var, & ! (out)
737  basename, & ! (in)
738  varname, & ! (in)
739  ts, & ! (in)
740  te, & ! (in)
741  myrank, & ! (in)
742  mdlid, & ! (in)
743  single, & ! (in) optional
744  xstag, & ! (in) optional
745  ystag & ! (in) optional
746  )
747  use netcdf ![external lib]
748  implicit none
749 
750  real(DP), intent(out) :: var(:,:,:)
751  character(len=*), intent( in) :: basename
752  character(len=*), intent( in) :: varname
753  integer, intent( in) :: ts
754  integer, intent( in) :: te
755  integer, intent( in) :: myrank
756  integer, intent( in) :: mdlid
757  logical, intent( in), optional :: single
758  logical, intent( in), optional :: xstag
759  logical, intent( in), optional :: ystag
760 
761  real(DP), allocatable :: var_org(:,:,:)
762  integer :: ncid, varid
763  integer :: status
764  integer :: precis
765  integer :: nx, ny
766  integer :: dims(7)
767 
768  integer :: tcount
769  character(len=H_LONG) :: fname = ''
770  logical :: single_ = .false.
771 
772  intrinsic size
773  intrinsic shape
774  !---------------------------------------------------------------------------
775 
776  tcount = te - ts + 1
777 
778  if ( present(single) ) then
779  single_ = single
780  else
781  single_ = .false.
782  endif
783 
784  call externalfilemakefname( fname,mdlid,basename,myrank,single )
785 
786  status = nf90_open( trim(fname), nf90_nowrite, ncid )
787  if (status /= nf90_noerr) call handle_err(status, __line__)
788 
789  ! retrieve dimension size in data original order
790  call externaltakedimension( dims(:),ncid,mdlid )
791  nx = dims(1)
792  if ( present(xstag) ) then
793  if ( xstag ) then
794  nx = dims(4)
795  endif
796  endif
797  ny = dims(2)
798  if ( present(ystag) ) then
799  if ( ystag ) then
800  ny = dims(5)
801  endif
802  endif
803  allocate( var_org(nx,ny,tcount) )
804 
805  status = nf90_inq_varid( ncid, trim(varname), varid )
806  if (status /= nf90_noerr) call handle_err(status, __line__)
807 
808  status = nf90_inquire_variable( ncid, varid, xtype=precis )
809  if(status /= nf90_noerr) call handle_err(status, __line__)
810  if(precis /= nf90_double) then
811  write(*,*) 'xxx Internal Error: [scale_external_io]/[ExternalFileRead3DDP]'
812  call prc_mpistop
813  endif
814 
815  status = nf90_get_var( ncid, varid, var_org(:,:,:), start = (/ 1,1,ts /), &
816  count = (/ nx,ny,tcount /) )
817  if (status /= nf90_noerr) call handle_err(status, __line__)
818 
819  status = nf90_close(ncid)
820  if (status /= nf90_noerr) call handle_err(status, __line__)
821 
822  call convertarrayorder( var,var_org,tcount,nx,ny )
823 
824  deallocate( var_org )
825 
826  return
827  end subroutine externalfileread3drealdp
828  subroutine externalfileread4drealsp( &
829  var, & ! (out)
830  basename, & ! (in)
831  varname, & ! (in)
832  ts, & ! (in)
833  te, & ! (in)
834  myrank, & ! (in)
835  mdlid, & ! (in)
836  single, & ! (in) optional
837  xstag, & ! (in) optional
838  ystag, & ! (in) optional
839  zstag, & ! (in) optional
840  landgrid, & ! (in) optional
841  option & ! (in) optional
842  )
843  use netcdf ![external lib]
844  implicit none
845 
846  real(SP), intent(out) :: var(:,:,:,:)
847  character(len=*), intent( in) :: basename
848  character(len=*), intent( in) :: varname
849  integer, intent( in) :: ts
850  integer, intent( in) :: te
851  integer, intent( in) :: myrank
852  integer, intent( in) :: mdlid
853  logical, intent( in), optional :: single
854  logical, intent( in), optional :: xstag
855  logical, intent( in), optional :: ystag
856  logical, intent( in), optional :: zstag
857  logical, intent( in), optional :: landgrid
858  logical, intent( in), optional :: option
859 
860  real(SP), allocatable :: var_org(:,:,:,:)
861  integer :: ncid, varid
862  integer :: status
863  integer :: precis
864  integer :: nx, ny, nz
865  integer :: dims(7)
866 
867  integer :: tcount
868  character(len=H_LONG) :: fname = ''
869  logical :: single_ = .false.
870  logical :: option_ = .false.
871 
872  intrinsic size
873  intrinsic shape
874  !---------------------------------------------------------------------------
875 
876  tcount = te - ts + 1
877 
878  if ( present(single) ) then
879  single_ = single
880  endif
881 
882  if ( present(option) ) then
883  option_ = option
884  endif
885 
886  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
887 
888  status = nf90_open( trim(fname), nf90_nowrite, ncid )
889  if (status /= nf90_noerr) then
890  if ( option_ ) then
891  return
892  else
893  write(*,*) trim(fname)
894  call handle_err(status, __line__)
895  end if
896  end if
897 
898  ! retrieve dimension size in data original order
899  call externaltakedimension( dims(:),ncid,mdlid )
900  nx = dims(1)
901  if ( present(xstag) ) then
902  if ( xstag ) then
903  nx = dims(4)
904  endif
905  endif
906  ny = dims(2)
907  if ( present(ystag) ) then
908  if ( ystag ) then
909  ny = dims(5)
910  endif
911  endif
912  nz = dims(3)
913  if ( present(zstag) ) then
914  if ( zstag ) then
915  nz = dims(6)
916  endif
917  endif
918  if ( present(landgrid) ) then
919  if ( landgrid ) then
920  nz = dims(7)
921  endif
922  endif
923  allocate( var_org(nx,ny,nz,tcount) )
924 
925  status = nf90_inq_varid( ncid, trim(varname), varid )
926  if (status /= nf90_noerr) call handle_err(status, __line__)
927 
928  status = nf90_inquire_variable( ncid, varid, xtype=precis )
929  if(status /= nf90_noerr) call handle_err(status, __line__)
930  if(precis /= nf90_float) then
931  write(*,*) 'xxx Internal Error: [scale_external_io]/[ExternalFileRead4DSP]'
932  call prc_mpistop
933  endif
934 
935  status = nf90_get_var( ncid, varid, var_org(:,:,:,:), start = (/ 1,1,1,ts /), &
936  count = (/ nx,ny,nz,tcount /) )
937  if (status /= nf90_noerr) call handle_err(status, __line__)
938 
939  status = nf90_close(ncid)
940  if (status /= nf90_noerr) call handle_err(status, __line__)
941 
942  call convertarrayorder( var,var_org,tcount,nz,nx,ny )
943 
944  deallocate( var_org )
945 
946  return
947  end subroutine externalfileread4drealsp
948  subroutine externalfileread4drealdp( &
949  var, & ! (out)
950  basename, & ! (in)
951  varname, & ! (in)
952  ts, & ! (in)
953  te, & ! (in)
954  myrank, & ! (in)
955  mdlid, & ! (in)
956  single, & ! (in) optional
957  xstag, & ! (in) optional
958  ystag, & ! (in) optional
959  zstag, & ! (in) optional
960  landgrid & ! (in) optional
961  )
962  use netcdf ![external lib]
963  implicit none
964 
965  real(DP), intent(out) :: var(:,:,:,:)
966  character(len=*), intent( in) :: basename
967  character(len=*), intent( in) :: varname
968  integer, intent( in) :: ts
969  integer, intent( in) :: te
970  integer, intent( in) :: myrank
971  integer, intent( in) :: mdlid
972  logical, intent( in), optional :: single
973  logical, intent( in), optional :: xstag
974  logical, intent( in), optional :: ystag
975  logical, intent( in), optional :: zstag
976  logical, intent( in), optional :: landgrid
977 
978  real(DP), allocatable :: var_org(:,:,:,:)
979  integer :: ncid, varid
980  integer :: status
981  integer :: precis
982  integer :: nx, ny, nz
983  integer :: dims(7)
984 
985  integer :: tcount
986  character(len=H_LONG) :: fname = ''
987  logical :: single_ = .false.
988 
989  intrinsic size
990  intrinsic shape
991  !---------------------------------------------------------------------------
992 
993  tcount = te - ts + 1
994 
995  if ( present(single) ) then
996  single_ = single
997  else
998  single_ = .false.
999  endif
1000 
1001  call externalfilemakefname( fname,mdlid,basename,myrank,single )
1002 
1003  status = nf90_open( trim(fname), nf90_nowrite, ncid )
1004  if (status /= nf90_noerr) call handle_err(status, __line__)
1005 
1006  ! retrieve dimension size in data original order
1007  call externaltakedimension( dims(:),ncid,mdlid )
1008  nx = dims(1)
1009  if ( present(xstag) ) then
1010  if ( xstag ) then
1011  nx = dims(4)
1012  endif
1013  endif
1014  ny = dims(2)
1015  if ( present(ystag) ) then
1016  if ( ystag ) then
1017  ny = dims(5)
1018  endif
1019  endif
1020  nz = dims(3)
1021  if ( present(zstag) ) then
1022  if ( zstag ) then
1023  nz = dims(6)
1024  endif
1025  endif
1026  if ( present(landgrid) ) then
1027  if ( landgrid ) then
1028  nz = dims(7)
1029  endif
1030  endif
1031  allocate( var_org(nx,ny,nz,tcount) )
1032 
1033  status = nf90_inq_varid( ncid, trim(varname), varid )
1034  if (status /= nf90_noerr) call handle_err(status, __line__)
1035 
1036  status = nf90_inquire_variable( ncid, varid, xtype=precis )
1037  if(status /= nf90_noerr) call handle_err(status, __line__)
1038  if(precis /= nf90_double) then
1039  write(*,*) 'xxx Internal Error: [scale_external_io]/[ExternalFileRead4DDP]'
1040  call prc_mpistop
1041  endif
1042 
1043  status = nf90_get_var( ncid, varid, var_org(:,:,:,:), start = (/ 1,1,1,ts /), &
1044  count = (/ nx,ny,nz,tcount /) )
1045  if (status /= nf90_noerr) call handle_err(status, __line__)
1046 
1047  status = nf90_close(ncid)
1048  if (status /= nf90_noerr) call handle_err(status, __line__)
1049 
1050  call convertarrayorder( var,var_org,tcount,nz,nx,ny )
1051 
1052  deallocate( var_org )
1053 
1054  return
1055  end subroutine externalfileread4drealdp
1056 
1057  subroutine externalfilereadoffset3drealsp( &
1058  var, & ! (out)
1059  basename, & ! (in)
1060  varname, & ! (in)
1061  ts, & ! (in)
1062  te, & ! (in)
1063  myrank, & ! (in)
1064  mdlid, & ! (in)
1065  single, & ! (in) optional
1066  xstag, & ! (in) optional
1067  ystag & ! (in) optional
1068  )
1069  use netcdf ![external lib]
1070  implicit none
1071 
1072  real(SP), intent(out) :: var(:,:,:)
1073  character(len=*), intent( in) :: basename
1074  character(len=*), intent( in) :: varname
1075  integer, intent( in) :: ts
1076  integer, intent( in) :: te
1077  integer, intent( in) :: myrank
1078  integer, intent( in) :: mdlid
1079  logical, intent( in), optional :: single
1080  logical, intent( in), optional :: xstag
1081  logical, intent( in), optional :: ystag
1082 
1083  real(SP), allocatable :: var_org(:,:,:)
1084  integer(2), allocatable :: short(:,:,:)
1085 
1086  real(4) :: scale_factor, add_offset
1087 
1088  integer :: ncid, varid
1089  integer :: status
1090  integer :: precis
1091  integer :: nx, ny
1092  integer :: dims(7)
1093 
1094  integer :: tcount
1095  character(len=H_LONG) :: fname = ''
1096  logical :: single_ = .false.
1097 
1098  intrinsic size
1099  intrinsic shape
1100  !---------------------------------------------------------------------------
1101 
1102  tcount = te - ts + 1
1103 
1104  if ( present(single) ) then
1105  single_ = single
1106  else
1107  single_ = .false.
1108  endif
1109 
1110  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
1111 
1112  status = nf90_open( trim(fname), nf90_nowrite, ncid )
1113  if (status /= nf90_noerr) call handle_err(status, __line__)
1114 
1115  ! retrieve dimension size in data original order
1116  call externaltakedimension( dims(:),ncid,mdlid )
1117  nx = dims(1)
1118  if ( present(xstag) ) then
1119  if ( xstag ) then
1120  nx = dims(4)
1121  endif
1122  endif
1123  ny = dims(2)
1124  if ( present(ystag) ) then
1125  if ( ystag ) then
1126  ny = dims(5)
1127  endif
1128  endif
1129  allocate( var_org(nx,ny,tcount) )
1130  allocate( short(nx,ny,tcount) )
1131 
1132  status = nf90_inq_varid( ncid, trim(varname), varid )
1133  if (status /= nf90_noerr) call handle_err(status, __line__)
1134 
1135  status = nf90_inquire_variable( ncid, varid, xtype=precis )
1136  if(status /= nf90_noerr) call handle_err(status, __line__)
1137 
1138  if(precis /= nf90_short) then
1139  status = nf90_get_var( ncid, varid, var_org(:,:,:), start = (/ 1,1,ts /), &
1140  count = (/ nx,ny,tcount /) )
1141  if (status /= nf90_noerr) call handle_err(status, __line__)
1142  else
1143  status = nf90_get_att(ncid, varid, "scale_factor", scale_factor)
1144  if (status /= nf90_noerr) call handle_err(status, __line__)
1145 
1146  status = nf90_get_att(ncid, varid, "add_offset", add_offset)
1147  if (status /= nf90_noerr) call handle_err(status, __line__)
1148 
1149  status = nf90_get_var( ncid, varid, short(:,:,:), start = (/ 1,1,ts /), &
1150  count = (/ nx,ny,tcount /) )
1151  if (status /= nf90_noerr) call handle_err(status, __line__)
1152 
1153  var_org(:,:,:) = real( short(:,:,:),kind=sp )*scale_factor + add_offset
1154  end if
1155 
1156  status = nf90_close(ncid)
1157  if (status /= nf90_noerr) call handle_err(status, __line__)
1158 
1159  call convertarrayorder( var,var_org,tcount,nx,ny )
1160 
1161  deallocate( var_org )
1162  deallocate( short )
1163 
1164  return
1165  end subroutine externalfilereadoffset3drealsp
1166  subroutine externalfilereadoffset3drealdp( &
1167  var, & ! (out)
1168  basename, & ! (in)
1169  varname, & ! (in)
1170  ts, & ! (in)
1171  te, & ! (in)
1172  myrank, & ! (in)
1173  mdlid, & ! (in)
1174  single, & ! (in) optional
1175  xstag, & ! (in) optional
1176  ystag & ! (in) optional
1177  )
1178  use netcdf ![external lib]
1179  implicit none
1180 
1181  real(DP), intent(out) :: var(:,:,:)
1182  character(len=*), intent( in) :: basename
1183  character(len=*), intent( in) :: varname
1184  integer, intent( in) :: ts
1185  integer, intent( in) :: te
1186  integer, intent( in) :: myrank
1187  integer, intent( in) :: mdlid
1188  logical, intent( in), optional :: single
1189  logical, intent( in), optional :: xstag
1190  logical, intent( in), optional :: ystag
1191 
1192  real(DP), allocatable :: var_org(:,:,:)
1193  integer(2), allocatable :: short(:,:,:)
1194 
1195  real(4) :: scale_factor, add_offset
1196 
1197  integer :: ncid, varid
1198  integer :: status
1199  integer :: precis
1200  integer :: nx, ny
1201  integer :: dims(7)
1202 
1203  integer :: tcount
1204  character(len=H_LONG) :: fname = ''
1205  logical :: single_ = .false.
1206 
1207  intrinsic size
1208  intrinsic shape
1209  !---------------------------------------------------------------------------
1210 
1211  tcount = te - ts + 1
1212 
1213  if ( present(single) ) then
1214  single_ = single
1215  else
1216  single_ = .false.
1217  endif
1218 
1219  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
1220 
1221  status = nf90_open( trim(fname), nf90_nowrite, ncid )
1222  if (status /= nf90_noerr) call handle_err(status, __line__)
1223 
1224  ! retrieve dimension size in data original order
1225  call externaltakedimension( dims(:),ncid,mdlid )
1226  nx = dims(1)
1227  if ( present(xstag) ) then
1228  if ( xstag ) then
1229  nx = dims(4)
1230  endif
1231  endif
1232  ny = dims(2)
1233  if ( present(ystag) ) then
1234  if ( ystag ) then
1235  ny = dims(5)
1236  endif
1237  endif
1238  allocate( var_org(nx,ny,tcount) )
1239  allocate( short(nx,ny,tcount) )
1240 
1241  status = nf90_inq_varid( ncid, trim(varname), varid )
1242  if (status /= nf90_noerr) call handle_err(status, __line__)
1243 
1244  status = nf90_inquire_variable( ncid, varid, xtype=precis )
1245  if(status /= nf90_noerr) call handle_err(status, __line__)
1246 
1247  if(precis /= nf90_short) then
1248  status = nf90_get_var( ncid, varid, var_org(:,:,:), start = (/ 1,1,ts /), &
1249  count = (/ nx,ny,tcount /) )
1250  if (status /= nf90_noerr) call handle_err(status, __line__)
1251  else
1252  status = nf90_get_att(ncid, varid, "scale_factor", scale_factor)
1253  if (status /= nf90_noerr) call handle_err(status, __line__)
1254 
1255  status = nf90_get_att(ncid, varid, "add_offset", add_offset)
1256  if (status /= nf90_noerr) call handle_err(status, __line__)
1257 
1258  status = nf90_get_var( ncid, varid, short(:,:,:), start = (/ 1,1,ts /), &
1259  count = (/ nx,ny,tcount /) )
1260  if (status /= nf90_noerr) call handle_err(status, __line__)
1261 
1262  var_org(:,:,:) = real( real(short(:,:,:),kind=sp)*scale_factor + add_offset, kind=dp )
1263  endif
1264 
1265  status = nf90_close(ncid)
1266  if (status /= nf90_noerr) call handle_err(status, __line__)
1267 
1268  call convertarrayorder( var,var_org,tcount,nx,ny )
1269 
1270  deallocate( var_org )
1271  deallocate( short )
1272 
1273  return
1274  end subroutine externalfilereadoffset3drealdp
1275  subroutine externalfilereadoffset4drealsp( &
1276  var, & ! (out)
1277  basename, & ! (in)
1278  varname, & ! (in)
1279  ts, & ! (in)
1280  te, & ! (in)
1281  myrank, & ! (in)
1282  mdlid, & ! (in)
1283  single, & ! (in) optional
1284  xstag, & ! (in) optional
1285  ystag, & ! (in) optional
1286  zstag, & ! (in) optional
1287  landgrid & ! (in) optional
1288  )
1289  use netcdf ![external lib]
1290  implicit none
1291 
1292  real(SP), intent(out) :: var(:,:,:,:)
1293  character(len=*), intent( in) :: basename
1294  character(len=*), intent( in) :: varname
1295  integer, intent( in) :: ts
1296  integer, intent( in) :: te
1297  integer, intent( in) :: myrank
1298  integer, intent( in) :: mdlid
1299  logical, intent( in), optional :: single
1300  logical, intent( in), optional :: xstag
1301  logical, intent( in), optional :: ystag
1302  logical, intent( in), optional :: zstag
1303  logical, intent( in), optional :: landgrid
1304 
1305  real(SP), allocatable :: var_org(:,:,:,:)
1306  integer(2), allocatable :: short(:,:,:,:)
1307 
1308  real(4) :: scale_factor, add_offset
1309 
1310  integer :: ncid, varid
1311  integer :: status
1312  integer :: precis
1313  integer :: nx, ny, nz
1314  integer :: dims(7)
1315 
1316  integer :: tcount
1317  character(len=H_LONG) :: fname = ''
1318  logical :: single_ = .false.
1319 
1320  intrinsic size
1321  intrinsic shape
1322  !---------------------------------------------------------------------------
1323 
1324  tcount = te - ts + 1
1325 
1326  if ( present(single) ) then
1327  single_ = single
1328  else
1329  single_ = .false.
1330  endif
1331 
1332  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
1333 
1334  status = nf90_open( trim(fname), nf90_nowrite, ncid )
1335  if (status /= nf90_noerr) call handle_err(status, __line__)
1336 
1337  ! retrieve dimension size in data original order
1338  call externaltakedimension( dims(:),ncid,mdlid )
1339  nx = dims(1)
1340  if ( present(xstag) ) then
1341  if ( xstag ) then
1342  nx = dims(4)
1343  endif
1344  endif
1345  ny = dims(2)
1346  if ( present(ystag) ) then
1347  if ( ystag ) then
1348  ny = dims(5)
1349  endif
1350  endif
1351  nz = dims(3)
1352  if ( present(zstag) ) then
1353  if ( zstag ) then
1354  nz = dims(6)
1355  endif
1356  endif
1357  if ( present(landgrid) ) then
1358  if ( landgrid ) then
1359  nz = dims(7)
1360  endif
1361  endif
1362  allocate( var_org(nx,ny,nz,tcount) )
1363  allocate( short(nx,ny,nz,tcount) )
1364 
1365  status = nf90_inq_varid( ncid, trim(varname), varid )
1366  if (status /= nf90_noerr) call handle_err(status, __line__)
1367 
1368  status = nf90_inquire_variable( ncid, varid, xtype=precis )
1369  if (status /= nf90_noerr) call handle_err(status, __line__)
1370 
1371  if(precis /= nf90_short) then
1372  status = nf90_get_var( ncid, varid, var_org(:,:,:,:), start = (/ 1,1,1,ts /), &
1373  count = (/ nx,ny,nz,tcount /) )
1374  if (status /= nf90_noerr) call handle_err(status, __line__)
1375  else
1376  status = nf90_get_att(ncid, varid, "scale_factor", scale_factor)
1377  if (status /= nf90_noerr) call handle_err(status, __line__)
1378 
1379  status = nf90_get_att(ncid, varid, "add_offset", add_offset)
1380  if (status /= nf90_noerr) call handle_err(status, __line__)
1381 
1382  status = nf90_get_var( ncid, varid, short(:,:,:,:), start = (/ 1,1,1,ts /), &
1383  count = (/ nx,ny,nz,tcount /) )
1384  if (status /= nf90_noerr) call handle_err(status, __line__)
1385 
1386  var_org(:,:,:,:) = real( short(:,:,:,:),kind=sp )*scale_factor + add_offset
1387  end if
1388 
1389  status = nf90_close(ncid)
1390  if (status /= nf90_noerr) call handle_err(status, __line__)
1391 
1392  call convertarrayorder( var,var_org,tcount,nz,nx,ny )
1393 
1394  deallocate( var_org )
1395  deallocate( short )
1396 
1397  return
1398  end subroutine externalfilereadoffset4drealsp
1399  subroutine externalfilereadoffset4drealdp( &
1400  var, & ! (out)
1401  basename, & ! (in)
1402  varname, & ! (in)
1403  ts, & ! (in)
1404  te, & ! (in)
1405  myrank, & ! (in)
1406  mdlid, & ! (in)
1407  single, & ! (in) optional
1408  xstag, & ! (in) optional
1409  ystag, & ! (in) optional
1410  zstag, & ! (in) optional
1411  landgrid & ! (in) optional
1412  )
1413  use netcdf ![external lib]
1414  implicit none
1415 
1416  real(DP), intent(out) :: var(:,:,:,:)
1417  character(len=*), intent( in) :: basename
1418  character(len=*), intent( in) :: varname
1419  integer, intent( in) :: ts
1420  integer, intent( in) :: te
1421  integer, intent( in) :: myrank
1422  integer, intent( in) :: mdlid
1423  logical, intent( in), optional :: single
1424  logical, intent( in), optional :: xstag
1425  logical, intent( in), optional :: ystag
1426  logical, intent( in), optional :: zstag
1427  logical, intent( in), optional :: landgrid
1428 
1429  real(DP), allocatable :: var_org(:,:,:,:)
1430  integer(2), allocatable :: short(:,:,:,:)
1431 
1432  real(4) :: scale_factor, add_offset
1433 
1434  integer :: ncid, varid
1435  integer :: status
1436  integer :: precis
1437  integer :: nx, ny, nz
1438  integer :: dims(7)
1439 
1440  integer :: tcount
1441  character(len=H_LONG) :: fname = ''
1442  logical :: single_ = .false.
1443 
1444  intrinsic size
1445  intrinsic shape
1446  !---------------------------------------------------------------------------
1447 
1448  tcount = te - ts + 1
1449 
1450  if ( present(single) ) then
1451  single_ = single
1452  else
1453  single_ = .false.
1454  endif
1455 
1456  call externalfilemakefname( fname,mdlid,basename,myrank,single_ )
1457 
1458  status = nf90_open( trim(fname), nf90_nowrite, ncid )
1459  if (status /= nf90_noerr) call handle_err(status, __line__)
1460 
1461  ! retrieve dimension size in data original order
1462  call externaltakedimension( dims(:),ncid,mdlid )
1463  nx = dims(1)
1464  if ( present(xstag) ) then
1465  if ( xstag ) then
1466  nx = dims(4)
1467  endif
1468  endif
1469  ny = dims(2)
1470  if ( present(ystag) ) then
1471  if ( ystag ) then
1472  ny = dims(5)
1473  endif
1474  endif
1475  nz = dims(3)
1476  if ( present(zstag) ) then
1477  if ( zstag ) then
1478  nz = dims(6)
1479  endif
1480  endif
1481  if ( present(landgrid) ) then
1482  if ( landgrid ) then
1483  nz = dims(7)
1484  endif
1485  endif
1486  allocate( var_org(nx,ny,nz,tcount) )
1487  allocate( short(nx,ny,nz,tcount) )
1488 
1489  status = nf90_inq_varid( ncid, trim(varname), varid )
1490  if (status /= nf90_noerr) call handle_err(status, __line__)
1491 
1492  status = nf90_inquire_variable( ncid, varid, xtype=precis )
1493  if(status /= nf90_noerr) call handle_err(status, __line__)
1494 
1495  if(precis /= nf90_short) then
1496  status = nf90_get_var( ncid, varid, var_org(:,:,:,:), start = (/ 1,1,1,ts /), &
1497  count = (/ nx,ny,nz,tcount /) )
1498  if (status /= nf90_noerr) call handle_err(status, __line__)
1499  else
1500  status = nf90_get_att(ncid, varid, "scale_factor", scale_factor)
1501  if (status /= nf90_noerr) call handle_err(status, __line__)
1502 
1503  status = nf90_get_att(ncid, varid, "add_offset", add_offset)
1504  if (status /= nf90_noerr) call handle_err(status, __line__)
1505 
1506  status = nf90_get_var( ncid, varid, short(:,:,:,:), start = (/ 1,1,1,ts /), &
1507  count = (/ nx,ny,nz,tcount /) )
1508  if (status /= nf90_noerr) call handle_err(status, __line__)
1509 
1510  var_org(:,:,:,:) = real( real(short(:,:,:,:),kind=sp)*scale_factor + add_offset, kind=dp )
1511  end if
1512 
1513  status = nf90_close(ncid)
1514  if (status /= nf90_noerr) call handle_err(status, __line__)
1515 
1516  call convertarrayorder( var,var_org,tcount,nz,nx,ny )
1517 
1518  deallocate( var_org )
1519  deallocate( short )
1520 
1521  return
1522  end subroutine externalfilereadoffset4drealdp
1523 
1524  !-----------------------------------------------------------------------------
1525  ! ExternalMakeFName
1526  !-----------------------------------------------------------------------------
1527  subroutine externalfilemakefname( &
1528  fname, & ! (out)
1529  mdlid, & ! (in)
1530  basename, & ! (in)
1531  myrank, & ! (in)
1532  single & ! (in) optional
1533  )
1534  implicit none
1535 
1536  character(len=*), intent(out) :: fname
1537  integer, intent( in) :: mdlid
1538  character(len=*), intent( in) :: basename
1539  integer, intent( in) :: myrank
1540  logical, intent( in) :: single
1541 
1542  intrinsic size
1543  intrinsic shape
1544  !---------------------------------------------------------------------------
1545 
1546  if( mdlid == iwrfarw )then !TYPE: WRF-ARW
1547  if ( single ) then
1548  fname = trim(basename)
1549  else
1550  call filemakefname(fname,trim(basename),'_',myrank,4)
1551  endif
1552  elseif( mdlid == inicam )then !TYPE: NICAM-NETCDF
1553  if ( single ) then
1554  fname = trim(basename)//'.peall.nc'
1555  else
1556  call filemakefname(fname,trim(basename),'anl.pe',myrank,6)
1557  endif
1558  !elseif( mdlid == iGrADS )then !TYPE: GrADS
1559  ! if ( single ) then
1560  ! fname = trim(basename)//'.anl'
1561  ! else
1562  ! call FileMakeFname(fname,trim(basename),'anl.pe',myrank,6)
1563  ! endif
1564  else
1565  write(*,*) 'xxx failed, wrong filetype: [scale_external_io]/[ExternalFileMakeFName]'
1566  call prc_mpistop
1567  endif
1568 
1569  return
1570  end subroutine externalfilemakefname
1571 
1572  !-----------------------------------------------------------------------------
1573  ! ExternalMakeFName
1574  !-----------------------------------------------------------------------------
1575  subroutine externaltakedimension( &
1576  dims, & ! (out)
1577  ncid, & ! (in)
1578  mdlid & ! (in)
1579  )
1580  use netcdf ![external lib]
1581  implicit none
1582 
1583  integer, intent(out) :: dims(:)
1584  integer, intent( in) :: ncid
1585  integer, intent( in) :: mdlid
1586 
1587  integer :: dimid
1588  integer :: status
1589 
1590  intrinsic size
1591  intrinsic shape
1592  !---------------------------------------------------------------------------
1593 
1594  if( mdlid == iwrfarw )then !MODEL ID: WRF-ARW
1595  status = nf90_inq_dimid( ncid, "west_east", dimid )
1596  status = nf90_inquire_dimension( ncid, dimid,len=dims(1) )
1597  status = nf90_inq_dimid( ncid, "south_north", dimid )
1598  status = nf90_inquire_dimension( ncid, dimid,len=dims(2) )
1599  status = nf90_inq_dimid( ncid, "bottom_top", dimid )
1600  status = nf90_inquire_dimension( ncid, dimid,len=dims(3) )
1601  status = nf90_inq_dimid( ncid, "west_east_stag", dimid )
1602  status = nf90_inquire_dimension( ncid, dimid,len=dims(4) )
1603  status = nf90_inq_dimid( ncid, "south_north_stag", dimid )
1604  status = nf90_inquire_dimension( ncid, dimid,len=dims(5) )
1605  status = nf90_inq_dimid( ncid, "bottom_top_stag", dimid )
1606  status = nf90_inquire_dimension( ncid, dimid,len=dims(6) )
1607  status = nf90_inq_dimid( ncid, "soil_layers_stag", dimid )
1608  status = nf90_inquire_dimension( ncid, dimid,len=dims(7) )
1609 
1610  elseif( mdlid == inicam )then !MODEL ID: NICAM-NETCDF
1611  status = nf90_inq_dimid( ncid, "lon", dimid )
1612  status = nf90_inquire_dimension( ncid, dimid,len=dims(1) )
1613  status = nf90_inq_dimid( ncid, "lat", dimid )
1614  status = nf90_inquire_dimension( ncid, dimid,len=dims(2) )
1615  status = nf90_inq_dimid( ncid, "lev", dimid )
1616  status = nf90_inquire_dimension( ncid, dimid,len=dims(3) )
1617 
1618  else
1619  write(*,*) 'xxx This external file format is not supported, Sorry.'
1620  call prc_mpistop
1621  endif
1622 
1623  return
1624  end subroutine externaltakedimension
1625 
1626  !-----------------------------------------------------------------------------
1627  subroutine convertarrayorderwrf2dsp( &
1628  var, & ! (out)
1629  var_org, & ! (in)
1630  tcount, & ! (in)
1631  nx & ! (in)
1632  )
1633  implicit none
1634 
1635  real(SP), intent(out) :: var(:,:)
1636  real(SP), intent( in) :: var_org(:,:)
1637  integer, intent( in) :: tcount
1638  integer, intent( in) :: nx
1639  integer :: n, i
1640  intrinsic shape
1641 
1642  do n = 1, tcount
1643  do i = 1, nx
1644  var(i,n) = var_org(i,n)
1645  end do
1646  end do
1647 
1648  return
1649  end subroutine convertarrayorderwrf2dsp
1650  subroutine convertarrayorderwrf2ddp( &
1651  var, & ! (out)
1652  var_org, & ! (in)
1653  tcount, & ! (in)
1654  nx & ! (in)
1655  )
1656  implicit none
1657 
1658  real(DP), intent(out) :: var(:,:)
1659  real(DP), intent( in) :: var_org(:,:)
1660  integer, intent( in) :: tcount
1661  integer, intent( in) :: nx
1662  integer :: n, i
1663  intrinsic shape
1664 
1665  do n = 1, tcount
1666  do i = 1, nx
1667  var(i,n) = var_org(i,n)
1668  end do
1669  end do
1670 
1671  return
1672  end subroutine convertarrayorderwrf2ddp
1673  subroutine convertarrayorderwrf3dsp( &
1674  var, & ! (out)
1675  var_org, & ! (in)
1676  tcount, & ! (in)
1677  nx, & ! (in)
1678  ny & ! (in)
1679  )
1680  implicit none
1681 
1682  real(SP), intent(out) :: var(:,:,:)
1683  real(SP), intent( in) :: var_org(:,:,:)
1684  integer, intent( in) :: tcount
1685  integer, intent( in) :: nx
1686  integer, intent( in) :: ny
1687  integer :: n, i, j
1688  intrinsic shape
1689 
1690  do n = 1, tcount
1691  do j = 1, ny
1692  do i = 1, nx
1693  var(i,j,n) = var_org(i,j,n)
1694  end do
1695  end do
1696  end do
1697 
1698  return
1699  end subroutine convertarrayorderwrf3dsp
1700  subroutine convertarrayorderwrf3ddp( &
1701  var, & ! (out)
1702  var_org, & ! (in)
1703  tcount, & ! (in)
1704  nx, & ! (in)
1705  ny & ! (in)
1706  )
1707  implicit none
1708 
1709  real(DP), intent(out) :: var(:,:,:)
1710  real(DP), intent( in) :: var_org(:,:,:)
1711  integer, intent( in) :: tcount
1712  integer, intent( in) :: nx
1713  integer, intent( in) :: ny
1714  integer :: n, i, j
1715  intrinsic shape
1716 
1717  do n = 1, tcount
1718  do j = 1, ny
1719  do i = 1, nx
1720  var(i,j,n) = var_org(i,j,n)
1721  end do
1722  end do
1723  end do
1724 
1725  return
1726  end subroutine convertarrayorderwrf3ddp
1727  subroutine convertarrayorderwrf4dsp( &
1728  var, & ! (out)
1729  var_org, & ! (in)
1730  tcount, & ! (in)
1731  nz, & ! (in)
1732  nx, & ! (in)
1733  ny & ! (in)
1734  )
1735  implicit none
1736 
1737  real(SP), intent(out) :: var(:,:,:,:)
1738  real(SP), intent( in) :: var_org(:,:,:,:)
1739  integer, intent( in) :: tcount
1740  integer, intent( in) :: nz
1741  integer, intent( in) :: nx
1742  integer, intent( in) :: ny
1743  integer :: n, k, i, j
1744  intrinsic shape
1745 
1746  do n = 1, tcount
1747  do j = 1, ny
1748  do i = 1, nx
1749  do k = 1, nz
1750  var(k,i,j,n) = var_org(i,j,k,n)
1751  end do
1752  end do
1753  end do
1754  end do
1755 
1756  return
1757  end subroutine convertarrayorderwrf4dsp
1758  subroutine convertarrayorderwrf4ddp( &
1759  var, & ! (out)
1760  var_org, & ! (in)
1761  tcount, & ! (in)
1762  nz, & ! (in)
1763  nx, & ! (in)
1764  ny & ! (in)
1765  )
1766  implicit none
1767 
1768  real(DP), intent(out) :: var(:,:,:,:)
1769  real(DP), intent( in) :: var_org(:,:,:,:)
1770  integer, intent( in) :: tcount
1771  integer, intent( in) :: nz
1772  integer, intent( in) :: nx
1773  integer, intent( in) :: ny
1774  integer :: n, k, i, j
1775  intrinsic shape
1776 
1777  do n = 1, tcount
1778  do j = 1, ny
1779  do i = 1, nx
1780  do k = 1, nz
1781  var(k,i,j,n) = var_org(i,j,k,n)
1782  end do
1783  end do
1784  end do
1785  end do
1786 
1787  return
1788  end subroutine convertarrayorderwrf4ddp
1789 
1790  !-----------------------------------------------------------------------------
1791  subroutine handle_err(status, line)
1792  use netcdf ![external lib]
1793  use scale_process, only: &
1794  prc_mpistop
1795  implicit none
1796  integer, intent(in) :: status
1797  integer, intent(in) :: line
1798 
1799  write(*,*) 'xxx Error in scale_external_io.f90 at line', line
1800  write(*,*) nf90_strerror(status)
1801 
1802  call prc_mpistop
1803 
1804  return
1805  end subroutine handle_err
1806 
1807 end module scale_external_io
gtool_file
module GTOOL_FILE
Definition: gtool_file.f90:17
scale_external_io::externalfileread2drealdp
subroutine externalfileread2drealdp(var, basename, varname, ts, te, myrank, mdlid, nx, single)
Definition: scale_external_io.F90:566
scale_external_io::externalfilevarexistence
subroutine, public externalfilevarexistence(existence, basename, varname, myrank, mdlid, single)
Check Existence of a Variable.
Definition: scale_external_io.F90:431
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:234
scale_external_io::inicam
integer, parameter, public inicam
Definition: scale_external_io.F90:70
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:59
scale_external_io::convertarrayorderwrf2dsp
subroutine convertarrayorderwrf2dsp(var, var_org, tcount, nx)
Definition: scale_external_io.F90:1633
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_external_io::igrads
integer, parameter, public igrads
Definition: scale_external_io.F90:71
scale_external_io::iwrfarw
integer, parameter, public iwrfarw
Definition: scale_external_io.F90:69
scale_external_io::iscale
integer, parameter, public iscale
Definition: scale_external_io.F90:68
scale_external_io::externalfileread3drealdp
subroutine externalfileread3drealdp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag)
Definition: scale_external_io.F90:747
scale_external_io::externalfileread2drealsp
subroutine externalfileread2drealsp(var, basename, varname, ts, te, myrank, mdlid, nx, single)
File Read.
Definition: scale_external_io.F90:490
scale_external_io
module FILE I/O (netcdf)
Definition: scale_external_io.F90:14
scale_external_io::externalfileread4drealdp
subroutine externalfileread4drealdp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag, zstag, landgrid)
Definition: scale_external_io.F90:962
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_external_io::externalfilereadoffset3drealdp
subroutine externalfilereadoffset3drealdp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag)
Definition: scale_external_io.F90:1178
dc_types::dp
integer, parameter, public dp
Definition: dc_types.f90:27
scale_external_io::externalfilegetshape
subroutine, public externalfilegetshape(dims, timelen, mdlid, basename, myrank, single)
Definition: scale_external_io.F90:110
gtool_file::filemakefname
subroutine, public filemakefname(fname, basename, prefix, myrank, len)
Definition: gtool_file.f90:2939
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_external_io::externalfilegetglobalattvrealsp
subroutine externalfilegetglobalattvrealsp(var, mdlid, basename, attname, myrank, single)
Definition: scale_external_io.F90:249
scale_external_io::externalfilegetglobalattc
subroutine, public externalfilegetglobalattc(chr, mdlid, basename, attname, myrank, single)
Definition: scale_external_io.F90:373
scale_external_io::externalfileread4drealsp
subroutine externalfileread4drealsp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag, zstag, landgrid, option)
Definition: scale_external_io.F90:843
dc_types::sp
integer, parameter, public sp
Definition: dc_types.f90:30
scale_external_io::externalfilereadoffset3drealsp
subroutine externalfilereadoffset3drealsp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag)
Definition: scale_external_io.F90:1069
scale_external_io::externalfilereadoffset4drealsp
subroutine externalfilereadoffset4drealsp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag, zstag, landgrid)
Definition: scale_external_io.F90:1289
scale_precision
module PRECISION
Definition: scale_precision.F90:13
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
scale_external_io::externalfileread3drealsp
subroutine externalfileread3drealsp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag, option)
Definition: scale_external_io.F90:644
scale_external_io::externalfilereadoffset4drealdp
subroutine externalfilereadoffset4drealdp(var, basename, varname, ts, te, myrank, mdlid, single, xstag, ystag, zstag, landgrid)
Definition: scale_external_io.F90:1413
scale_external_io::externalfilegetglobalattvrealdp
subroutine externalfilegetglobalattvrealdp(var, mdlid, basename, attname, myrank, single)
Definition: scale_external_io.F90:311
scale_external_io::externalfilegetglobalattvinteger
subroutine externalfilegetglobalattvinteger(var, mdlid, basename, attname, myrank, single)
Definition: scale_external_io.F90:187
Generated by   doxygen 1.8.13