ROMS
Loading...
Searching...
No Matches
mod_netcdf::netcdf_get_svar Interface Reference

Public Member Functions

subroutine netcdf_get_svar_0d (ng, model, ncname, myvarname, a, ncid, start, total)
 
subroutine netcdf_get_svar_1d (ng, model, ncname, myvarname, a, ncid, start, total)
 
subroutine netcdf_get_svar_2d (ng, model, ncname, myvarname, a, ncid, start, total)
 
subroutine netcdf_get_svar_3d (ng, model, ncname, myvarname, a, ncid, start, total)
 

Detailed Description

Definition at line 70 of file mod_netcdf.F.

Member Function/Subroutine Documentation

◆ netcdf_get_svar_0d()

subroutine mod_netcdf::netcdf_get_svar::netcdf_get_svar_0d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
character (len=*), intent(out) a,
integer, intent(in), optional ncid,
integer, dimension(:), intent(in), optional start,
integer, dimension(:), intent(in), optional total )

Definition at line 5306 of file mod_netcdf.F.

5308!
5309!=======================================================================
5310! !
5311! This routine reads requested string scalar variable from specified !
5312! NetCDF file. The CDL of the scalar variable has one-dimension in !
5313! the NetCDF file for the number of characters: !
5314! !
5315! char string(Nchars) CDL !
5316! !
5317! character (len=Nchars) :: string F90 !
5318! !
5319! to read a scalar string use: !
5320! !
5321! start = (/1/) !
5322! total = (/Nchars/) !
5323! !
5324! On Input: !
5325! !
5326! ng Nested grid number (integer) !
5327! model Calling model identifier (integer) !
5328! ncname NetCDF file name (string) !
5329! myVarName Variable name (string) !
5330! ncid NetCDF file ID (integer, OPTIONAL) !
5331! start Starting index where the first of the data values !
5332! will be read along each dimension (integer, !
5333! OPTIONAL) !
5334! total Number of data values to be read along each !
5335! dimension (integer, OPTIONAL) !
5336! !
5337! On Ouput: !
5338! !
5339! A Read scalar variable (string) !
5340! !
5341! Examples: !
5342! !
5343! CALL netcdf_get_svar (ng, iNLM, 'file.nc', 'VarName', ivar) !
5344! CALL netcdf_get_svar (ng, iNLM, 'file.nc', 'VarName', ivar(1)) !
5345! !
5346!=======================================================================
5347!
5348! Imported variable declarations.
5349!
5350 integer, intent(in) :: ng, model
5351
5352 integer, intent(in), optional :: ncid
5353 integer, intent(in), optional :: start(:)
5354 integer, intent(in), optional :: total(:)
5355!
5356 character (len=*), intent(in) :: ncname
5357 character (len=*), intent(in) :: myVarName
5358
5359 character (len=*), intent(out) :: A
5360!
5361! Local variable declarations.
5362!
5363 integer :: my_ncid, status, varid
5364
5365#if !defined PARALLEL_IO && defined DISTRIBUTE
5366 integer, dimension(2) :: ibuffer
5367#endif
5368!
5369 character (len=LEN(A)), dimension(1) :: my_A
5370
5371 character (len=*), parameter :: MyFile = &
5372 & __FILE__//", netcdf_get_svar_0d"
5373!
5374!-----------------------------------------------------------------------
5375! Read in a string scalar variable.
5376!-----------------------------------------------------------------------
5377!
5378! If NetCDF file ID is not provided, open NetCDF for reading.
5379!
5380 IF (.not.PRESENT(ncid)) THEN
5381 CALL netcdf_open (ng, model, trim(ncname), 0, my_ncid)
5382 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5383 ELSE
5384 my_ncid=ncid
5385 END IF
5386!
5387! Read in variable.
5388!
5389 IF (inpthread) THEN
5390 status=nf90_inq_varid(my_ncid, trim(myvarname), varid)
5391 IF (status.eq.nf90_noerr) THEN
5392 IF (PRESENT(start).and.PRESENT(total)) THEN
5393 status=nf90_get_var(my_ncid, varid, my_a, start, total)
5394 a=my_a(1)
5395 ELSE
5396 status=nf90_get_var(my_ncid, varid, a)
5397 END IF
5398 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5399 WRITE (stdout,10) trim(myvarname), trim(ncname), &
5400 & trim(sourcefile), nf90_strerror(status)
5401 exit_flag=2
5402 ioerror=status
5403 END IF
5404 ELSE
5405 WRITE (stdout,20) trim(myvarname), trim(ncname), &
5406 & trim(sourcefile), nf90_strerror(status)
5407 exit_flag=2
5408 ioerror=status
5409 END IF
5410 END IF
5411
5412#if !defined PARALLEL_IO && defined DISTRIBUTE
5413!
5414! Broadcast read variable to all processors in the group.
5415!
5416 ibuffer(1)=exit_flag
5417 ibuffer(2)=ioerror
5418 CALL mp_bcasti (ng, model, ibuffer)
5419 exit_flag=ibuffer(1)
5420 ioerror=ibuffer(2)
5421 IF (exit_flag.eq.noerror) THEN
5422 CALL mp_bcasts (ng, model, a)
5423 END IF
5424#endif
5425!
5426! If NetCDF file ID is not provided, close input NetCDF file.
5427!
5428 IF (.not.PRESENT(ncid)) THEN
5429 CALL netcdf_close (ng, model, my_ncid, ncname, .false.)
5430 END IF
5431!
5432 10 FORMAT (/,' NETCDF_GET_SVAR_0D - error while reading variable:', &
5433 & 2x,a,/,22x,'in input file:',2x,a,/,22x,'call from:',2x,a, &
5434 & /,22x,a)
5435 20 FORMAT (/,' NETCDF_GET_SVAR_0D - error while inquiring ID for ', &
5436 & 'variable:',2x,a,/,22x,'in input file:',2x,a,/,22x, &
5437 & 'call from:',2x,a,/,22x,a)
5438!
5439 RETURN

References mod_scalars::exit_flag, mod_parallel::inpthread, mod_iounits::ioerror, mod_netcdf::netcdf_close(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ netcdf_get_svar_1d()

subroutine mod_netcdf::netcdf_get_svar::netcdf_get_svar_1d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
character (len=*), dimension(:), intent(out) a,
integer, intent(in), optional ncid,
integer, dimension(:), intent(in), optional start,
integer, dimension(:), intent(in), optional total )

Definition at line 5442 of file mod_netcdf.F.

5444!
5445!=======================================================================
5446! !
5447! This routine reads requested string 1D-array variable or array !
5448! element from specified NetCDF file. The CDL of the 1D-array !
5449! variable has two-dimensions in the NetCDF file, and the first !
5450! dimension is the number of characters: !
5451! !
5452! char string(dim1, Nchars) CDL !
5453! !
5454! character (len=Nchars) :: string(dim1) F90 !
5455! !
5456! to read a single array element at location (i) use: !
5457! !
5458! start = (/1, i/) !
5459! total = (/Nchars, 1/) !
5460! !
5461! On Input: !
5462! !
5463! ng Nested grid number (integer) !
5464! model Calling model identifier (integer) !
5465! ncname NetCDF file name (string) !
5466! myVarName Variable name (string) !
5467! ncid NetCDF file ID (integer, OPTIONAL) !
5468! start Starting index where the first of the data values !
5469! will be read along each dimension (integer, !
5470! OPTIONAL) !
5471! total Number of data values to be read along each !
5472! dimension (integer, OPTIONAL) !
5473! !
5474! On Ouput: !
5475! !
5476! A Read 1D-array variable or array element (string) !
5477! !
5478!=======================================================================
5479!
5480! Imported variable declarations.
5481!
5482 integer, intent(in) :: ng, model
5483
5484 integer, intent(in), optional :: ncid
5485 integer, intent(in), optional :: start(:)
5486 integer, intent(in), optional :: total(:)
5487!
5488 character (len=*), intent(in) :: ncname
5489 character (len=*), intent(in) :: myVarName
5490
5491 character (len=*), intent(out) :: A(:)
5492!
5493! Local variable declarations.
5494!
5495 integer :: my_ncid, status, varid
5496
5497#if !defined PARALLEL_IO && defined DISTRIBUTE
5498 integer, dimension(2) :: ibuffer
5499#endif
5500!
5501 character (len=*), parameter :: MyFile = &
5502 & __FILE__//", netcdf_get_svar_1d"
5503!
5504!-----------------------------------------------------------------------
5505! Read in a string 1D-array or array element.
5506!-----------------------------------------------------------------------
5507!
5508! If NetCDF file ID is not provided, open NetCDF for reading.
5509!
5510 IF (.not.PRESENT(ncid)) THEN
5511 CALL netcdf_open (ng, model, trim(ncname), 0, my_ncid)
5512 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5513 ELSE
5514 my_ncid=ncid
5515 END IF
5516!
5517! Read in variable.
5518!
5519 IF (inpthread) THEN
5520 status=nf90_inq_varid(my_ncid, trim(myvarname), varid)
5521 IF (status.eq.nf90_noerr) THEN
5522 IF (PRESENT(start).and.PRESENT(total)) THEN
5523 status=nf90_get_var(my_ncid, varid, a, start, total)
5524 ELSE
5525 status=nf90_get_var(my_ncid, varid, a)
5526 END IF
5527 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5528 WRITE (stdout,10) trim(myvarname), trim(ncname), &
5529 & trim(sourcefile), nf90_strerror(status)
5530 exit_flag=2
5531 ioerror=status
5532 END IF
5533 ELSE
5534 WRITE (stdout,20) trim(myvarname), trim(ncname), &
5535 & trim(sourcefile), nf90_strerror(status)
5536 exit_flag=2
5537 ioerror=status
5538 END IF
5539 END IF
5540
5541#if !defined PARALLEL_IO && defined DISTRIBUTE
5542!
5543! Broadcast read variable to all processors in the group.
5544!
5545 ibuffer(1)=exit_flag
5546 ibuffer(2)=ioerror
5547 CALL mp_bcasti (ng, model, ibuffer)
5548 exit_flag=ibuffer(1)
5549 ioerror=ibuffer(2)
5550 IF (exit_flag.eq.noerror) THEN
5551 CALL mp_bcasts (ng, model, a)
5552 END IF
5553#endif
5554!
5555! If NetCDF file ID is not provided, close input NetCDF file.
5556!
5557 IF (.not.PRESENT(ncid)) THEN
5558 CALL netcdf_close (ng, model, my_ncid, ncname, .false.)
5559 END IF
5560!
5561 10 FORMAT (/,' NETCDF_GET_SVAR_1D - error while reading variable:', &
5562 & 2x,a,/,22x,'in input file:',2x,a,/,22x,'call from:',2x,a, &
5563 & /,22x,a)
5564 20 FORMAT (/,' NETCDF_GET_SVAR_1D - error while inquiring ID for ', &
5565 & 'variable:',2x,a,/,22x,'in input file:',2x,a,/,22x, &
5566 & 'call from:',2x,a,/,22x,a)
5567!
5568 RETURN

References mod_scalars::exit_flag, mod_parallel::inpthread, mod_iounits::ioerror, mod_netcdf::netcdf_close(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ netcdf_get_svar_2d()

subroutine mod_netcdf::netcdf_get_svar::netcdf_get_svar_2d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
character (len=*), dimension(:,:), intent(out) a,
integer, intent(in), optional ncid,
integer, dimension(:), intent(in), optional start,
integer, dimension(:), intent(in), optional total )

Definition at line 5571 of file mod_netcdf.F.

5573!
5574!=======================================================================
5575! !
5576! This routine reads requested string 2D-array variable or array !
5577! element from specified NetCDF file. The CDL of the 2D-array !
5578! variable has three-dimensions in the NetCDF file, and the first !
5579! dimension is the number of characters: !
5580! !
5581! char string(dim2, dim1, Nchars) CDL !
5582! !
5583! character (len=Nchars) :: string(dim1, dim2) F90 !
5584! !
5585! to read a single array element at location (i,j) use: !
5586! !
5587! start = (/1, i, j/) !
5588! total = (/Nchars, 1, 1/) !
5589! !
5590! On Input: !
5591! !
5592! ng Nested grid number (integer) !
5593! model Calling model identifier (integer) !
5594! ncname NetCDF file name (string) !
5595! myVarName Variable name (string) !
5596! ncid NetCDF file ID (3D vector integer, OPTIONAL) !
5597! start Starting index where the first of the data values !
5598! will be read along each dimension (integer, !
5599! OPTIONAL) !
5600! total Number of data values to be read along each !
5601! dimension (3D vector integer, OPTIONAL) !
5602! !
5603! On Ouput: !
5604! !
5605! A Read 2D-array variable or array element (string) !
5606! !
5607!=======================================================================
5608!
5609! Imported variable declarations.
5610!
5611 integer, intent(in) :: ng, model
5612
5613 integer, intent(in), optional :: ncid
5614 integer, intent(in), optional :: start(:)
5615 integer, intent(in), optional :: total(:)
5616!
5617 character (len=*), intent(in) :: ncname
5618 character (len=*), intent(in) :: myVarName
5619
5620 character (len=*), intent(out) :: A(:,:)
5621!
5622! Local variable declarations.
5623!
5624 integer :: my_ncid, status, varid
5625
5626#if !defined PARALLEL_IO && defined DISTRIBUTE
5627 integer, dimension(2) :: ibuffer
5628#endif
5629!
5630 character (len=*), parameter :: MyFile = &
5631 & __FILE__//", netcdf_get_svar_2d"
5632!
5633!-----------------------------------------------------------------------
5634! Read in a string 2D-array or array element.
5635!-----------------------------------------------------------------------
5636!
5637! If NetCDF file ID is not provided, open NetCDF for reading.
5638!
5639 IF (.not.PRESENT(ncid)) THEN
5640 CALL netcdf_open (ng, model, trim(ncname), 0, my_ncid)
5641 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5642 ELSE
5643 my_ncid=ncid
5644 END IF
5645!
5646! Read in variable.
5647!
5648 IF (inpthread) THEN
5649 status=nf90_inq_varid(my_ncid, trim(myvarname), varid)
5650 IF (status.eq.nf90_noerr) THEN
5651 IF (PRESENT(start).and.PRESENT(total)) THEN
5652 status=nf90_get_var(my_ncid, varid, a, start, total)
5653 ELSE
5654 status=nf90_get_var(my_ncid, varid, a)
5655 END IF
5656 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5657 WRITE (stdout,10) trim(myvarname), trim(ncname), &
5658 & trim(sourcefile), nf90_strerror(status)
5659 exit_flag=2
5660 ioerror=status
5661 END IF
5662 ELSE
5663 WRITE (stdout,20) trim(myvarname), trim(ncname), &
5664 & trim(sourcefile), nf90_strerror(status)
5665 exit_flag=2
5666 ioerror=status
5667 END IF
5668 END IF
5669
5670#if !defined PARALLEL_IO && defined DISTRIBUTE
5671!
5672! Broadcast read variable to all processors in the group.
5673!
5674 ibuffer(1)=exit_flag
5675 ibuffer(2)=ioerror
5676 CALL mp_bcasti (ng, model, ibuffer)
5677 exit_flag=ibuffer(1)
5678 ioerror=ibuffer(2)
5679 IF (exit_flag.eq.noerror) THEN
5680 CALL mp_bcasts (ng, model, a)
5681 END IF
5682#endif
5683!
5684! If NetCDF file ID is not provided, close input NetCDF file.
5685!
5686 IF (.not.PRESENT(ncid)) THEN
5687 CALL netcdf_close (ng, model, my_ncid, ncname, .false.)
5688 END IF
5689!
5690 10 FORMAT (/,' NETCDF_GET_SVAR_2D - error while reading variable:', &
5691 & 2x,a,/,22x,'in input file:',2x,a,/,22x,'call from:',2x,a, &
5692 & /,22x,a)
5693 20 FORMAT (/,' NETCDF_GET_SVAR_2D - error while inquiring ID for ', &
5694 & 'variable:',2x,a,/,22x,'in input file:',2x,a,/,22x, &
5695 & 'call from:',2x,a,/,22x,a)
5696!
5697 RETURN

References mod_scalars::exit_flag, mod_parallel::inpthread, mod_iounits::ioerror, mod_netcdf::netcdf_close(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ netcdf_get_svar_3d()

subroutine mod_netcdf::netcdf_get_svar::netcdf_get_svar_3d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
character (len=*), dimension(:,:,:), intent(out) a,
integer, intent(in), optional ncid,
integer, dimension(:), intent(in), optional start,
integer, dimension(:), intent(in), optional total )

Definition at line 5700 of file mod_netcdf.F.

5702!
5703!=======================================================================
5704! !
5705! This routine reads requested string 3D-array variable or array !
5706! element from specified NetCDF file. The CDL of the 3D-array !
5707! variable has four-dimensions in the NetCDF file, and the first !
5708! dimension is the number of characters: !
5709! !
5710! char string(dim3, dim2, dim1, Nchars) CDL !
5711! !
5712! character (len=Nchars) :: string(dim1, dim2, dim3) F90 !
5713! !
5714! to write a single array element at location (i,j,k) use: !
5715! !
5716! start = (/1, i, j, k/) !
5717! total = (/Nchars, 1, 1, 1/) !
5718! !
5719! On Input: !
5720! !
5721! ng Nested grid number (integer) !
5722! model Calling model identifier (integer) !
5723! ncname NetCDF file name (string) !
5724! myVarName Variable name (string) !
5725! ncid NetCDF file ID (integer, OPTIONAL) !
5726! start Starting index where the first of the data values !
5727! will be read along each dimension (4D vector !
5728! integer, OPTIONAL) !
5729! total Number of data values to be read along each !
5730! dimension (3D vector integer, OPTIONAL) !
5731! !
5732! On Ouput: !
5733! !
5734! A Read 3D-array variable or element (string) !
5735! !
5736!=======================================================================
5737!
5738! Imported variable declarations.
5739!
5740 integer, intent(in) :: ng, model
5741
5742 integer, intent(in), optional :: ncid
5743 integer, intent(in), optional :: start(:)
5744 integer, intent(in), optional :: total(:)
5745!
5746 character (len=*), intent(in) :: ncname
5747 character (len=*), intent(in) :: myVarName
5748
5749 character (len=*), intent(out) :: A(:,:,:)
5750!
5751! Local variable declarations.
5752!
5753 integer :: my_ncid, status, varid
5754
5755#if !defined PARALLEL_IO && defined DISTRIBUTE
5756 integer, dimension(2) :: ibuffer
5757#endif
5758!
5759 character (len=*), parameter :: MyFile = &
5760 & __FILE__//", netcdf_get_svar_3d"
5761!
5762!-----------------------------------------------------------------------
5763! Read in a string 3D-array or array element.
5764!-----------------------------------------------------------------------
5765!
5766! If NetCDF file ID is not provided, open NetCDF for reading.
5767!
5768 IF (.not.PRESENT(ncid)) THEN
5769 CALL netcdf_open (ng, model, trim(ncname), 0, my_ncid)
5770 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5771 ELSE
5772 my_ncid=ncid
5773 END IF
5774!
5775! Read in variable.
5776!
5777 IF (inpthread) THEN
5778 status=nf90_inq_varid(my_ncid, trim(myvarname), varid)
5779 IF (status.eq.nf90_noerr) THEN
5780 IF (PRESENT(start).and.PRESENT(total)) THEN
5781 status=nf90_get_var(my_ncid, varid, a, start, total)
5782 ELSE
5783 status=nf90_get_var(my_ncid, varid, a)
5784 END IF
5785 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
5786 WRITE (stdout,10) trim(myvarname), trim(ncname), &
5787 & trim(sourcefile), nf90_strerror(status)
5788 exit_flag=2
5789 ioerror=status
5790 END IF
5791 ELSE
5792 WRITE (stdout,20) trim(myvarname), trim(ncname), &
5793 & trim(sourcefile), nf90_strerror(status)
5794 exit_flag=2
5795 ioerror=status
5796 END IF
5797 END IF
5798
5799#if !defined PARALLEL_IO && defined DISTRIBUTE
5800!
5801! Broadcast read variable to all processors in the group.
5802!
5803 ibuffer(1)=exit_flag
5804 ibuffer(2)=ioerror
5805 CALL mp_bcasti (ng, model, ibuffer)
5806 exit_flag=ibuffer(1)
5807 ioerror=ibuffer(2)
5808 IF (exit_flag.eq.noerror) THEN
5809 CALL mp_bcasts (ng, model, a)
5810 END IF
5811#endif
5812!
5813! If NetCDF file ID is not provided, close input NetCDF file.
5814!
5815 IF (.not.PRESENT(ncid)) THEN
5816 CALL netcdf_close (ng, model, my_ncid, ncname, .false.)
5817 END IF
5818!
5819 10 FORMAT (/,' NETCDF_GET_SVAR_3D - error while reading variable:', &
5820 & 2x,a,/,22x,'in input file:',2x,a,/,22x,'call from:',2x,a, &
5821 & /,22x,a)
5822 20 FORMAT (/,' NETCDF_GET_SVAR_3D - error while inquiring ID for ', &
5823 & 'variable:',2x,a,/,22x,'in input file:',2x,a,/,22x, &
5824 & 'call from:',2x,a,/,22x,a)
5825!
5826 RETURN

References mod_scalars::exit_flag, mod_parallel::inpthread, mod_iounits::ioerror, mod_netcdf::netcdf_close(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

The documentation for this interface was generated from the following file: