ROMS
Loading...
Searching...
No Matches
mod_pio_netcdf::pio_netcdf_put_fvar Interface Reference

Public Member Functions

subroutine pio_netcdf_put_fvar_0dp (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_1dp (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_2dp (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_3dp (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_0d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_1d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_2d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_3d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_fvar_4d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 

Detailed Description

Definition at line 94 of file mod_pio_netcdf.F.

Member Function/Subroutine Documentation

◆ pio_netcdf_put_fvar_0d()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_0d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(r8), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 7007 of file mod_pio_netcdf.F.

7010!
7011!=======================================================================
7012! !
7013! This routine writes a floating-point scalar variable into a NetCDF !
7014! file. If the file descritor is not provided, it opens the file, !
7015! writes data, and then closes the file. !
7016! !
7017! On Input: !
7018! !
7019! ng Nested grid number (integer) !
7020! model Calling model identifier (integer) !
7021! ncname NetCDF file name (string) !
7022! myVarName Variable name (string) !
7023! A Data value(s) to be written (real) !
7024! start Starting index where the first of the data values !
7025! will be written along each dimension (integer) !
7026! total Number of data values to be written along each !
7027! dimension (integer) !
7028! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7029! pioFile%fh file handler !
7030! pioFile%iosystem IO system descriptor (struct) !
7031! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7032! pioVar%varID Variable ID !
7033! pioVar%ncid File ID !
7034! !
7035! On Ouput: !
7036! !
7037! exit_flag Error flag (integer) stored in MOD_SCALARS !
7038! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7039! !
7040! Notice: This routine must be used to write only nontiled variables. !
7041! !
7042!=======================================================================
7043!
7044! Imported variable declarations.
7045!
7046 integer, intent(in) :: ng, model
7047 integer, intent(in) :: start(:), total(:)
7048!
7049 real(r8), intent(in) :: A
7050!
7051 character (len=*), intent(in) :: ncname
7052 character (len=*), intent(in) :: myVarName
7053!
7054 TYPE (File_desc_t), intent(in), optional :: pioFile
7055 TYPE (Var_desc_t), intent(in), optional :: pioVar
7056!
7057! Local variable declarations.
7058!
7059 integer :: status
7060!
7061 real(r8), dimension(1) :: my_A
7062!
7063 character (len=*), parameter :: MyFile = &
7064 & __FILE__//", pio_netcdf_put_fvar_0d"
7065!
7066 TYPE (File_desc_t) :: my_pioFile
7067 TYPE (Var_desc_t) :: my_pioVar
7068!
7069!-----------------------------------------------------------------------
7070! Read in a floating-point scalar variable.
7071!-----------------------------------------------------------------------
7072!
7073! If file descriptor is not provided, open file for writing.
7074!
7075 IF (.not.PRESENT(piofile)) THEN
7076 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7077 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7078 ELSE
7079 my_piofile=piofile
7080 END IF
7081!
7082! If variable descriptor is not provided, inquire its value.
7083!
7084 IF (.not.PRESENT(piovar)) THEN
7085 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7086 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7087 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7088 & trim(sourcefile)
7089 exit_flag=3
7090 ioerror=status
7091 END IF
7092 ELSE
7093 my_piovar=piovar
7094 END IF
7095!
7096! Write out data.
7097!
7098 IF (exit_flag.eq.noerror) THEN
7099 IF ((start(1).eq.0).and.(total(1).eq.0)) THEN
7100 status=pio_put_var(my_piofile, my_piovar, a)
7101 ELSE
7102 my_a(1)=a
7103 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
7104 END IF
7105 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7106 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7107 & trim(sourcefile)
7108 exit_flag=3
7109 ioerror=status
7110 END IF
7111 END IF
7112!
7113! Close input file.
7114!
7115 IF (.not.PRESENT(piofile)) THEN
7116 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7117 END IF
7118!
7119 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0D - error while inquiring ', &
7120 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7121 & 2x,a,/,26x,'call from:',2x,a)
7122 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0D - error while writing ', &
7123 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7124 & /,26x,'call from:',2x,a)
7125!
7126 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_0dp()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_0dp ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(dp), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 6539 of file mod_pio_netcdf.F.

6542!
6543!=======================================================================
6544! !
6545! This routine writes a floating-point scalar variable into a NetCDF !
6546! file. If the file descritor is not provided, it opens the file, !
6547! writes data, and then closes the file. !
6548! !
6549! On Input: !
6550! !
6551! ng Nested grid number (integer) !
6552! model Calling model identifier (integer) !
6553! ncname NetCDF file name (string) !
6554! myVarName Variable name (string) !
6555! A Data value(s) to be written (double precision) !
6556! start Starting index where the first of the data values !
6557! will be written along each dimension (integer) !
6558! total Number of data values to be written along each !
6559! dimension (integer) !
6560! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6561! pioFile%fh file handler !
6562! pioFile%iosystem IO system descriptor (struct) !
6563! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6564! pioVar%varID Variable ID !
6565! pioVar%ncid File ID !
6566! !
6567! On Ouput: !
6568! !
6569! exit_flag Error flag (integer) stored in MOD_SCALARS !
6570! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6571! !
6572! Notice: This routine must be used to write only nontiled variables. !
6573! !
6574!=======================================================================
6575!
6576! Imported variable declarations.
6577!
6578 integer, intent(in) :: ng, model
6579 integer, intent(in) :: start(:), total(:)
6580!
6581 real(dp), intent(in) :: A
6582!
6583 character (len=*), intent(in) :: ncname
6584 character (len=*), intent(in) :: myVarName
6585!
6586 TYPE (File_desc_t), intent(in), optional :: pioFile
6587 TYPE (Var_desc_t), intent(in), optional :: pioVar
6588!
6589! Local variable declarations.
6590!
6591 integer :: status
6592!
6593 real(dp), dimension(1) :: my_A
6594!
6595 character (len=*), parameter :: MyFile = &
6596 & __FILE__//", pio_netcdf_put_fvar_0dp"
6597!
6598 TYPE (File_desc_t) :: my_pioFile
6599 TYPE (Var_desc_t) :: my_pioVar
6600!
6601!-----------------------------------------------------------------------
6602! Read in a floating-point scalar variable.
6603!-----------------------------------------------------------------------
6604!
6605! If file descriptor is not provided, open file for writing.
6606!
6607 IF (.not.PRESENT(piofile)) THEN
6608 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6609 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6610 ELSE
6611 my_piofile=piofile
6612 END IF
6613!
6614! If variable descriptor is not provided, inquire its value.
6615!
6616 IF (.not.PRESENT(piovar)) THEN
6617 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6618 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6619 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6620 & trim(sourcefile)
6621 exit_flag=3
6622 ioerror=status
6623 END IF
6624 ELSE
6625 my_piovar=piovar
6626 END IF
6627!
6628! Write out data.
6629!
6630 IF (exit_flag.eq.noerror) THEN
6631 IF ((start(1).eq.0).and.(total(1).eq.0)) THEN
6632 status=pio_put_var(my_piofile, my_piovar, a)
6633 ELSE
6634 my_a(1)=a
6635 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
6636 END IF
6637 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6638 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6639 & trim(sourcefile)
6640 exit_flag=3
6641 ioerror=status
6642 END IF
6643 END IF
6644!
6645! Close input file.
6646!
6647 IF (.not.PRESENT(piofile)) THEN
6648 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6649 END IF
6650!
6651 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0DP - error while inquiring ', &
6652 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6653 & 2x,a,/,27x,'call from:',2x,a)
6654 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0DP - error while writing ', &
6655 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
6656 & /,27x,'call from:',2x,a)
6657!
6658 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_1d()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_1d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(r8), dimension(:), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 7129 of file mod_pio_netcdf.F.

7132!
7133!=======================================================================
7134! !
7135! It writes a floating-point 1D-array variable into a NetCDF file. !
7136! If the file descritor is not provided, it opens the file, writes !
7137! data, and then closes the file. !
7138! !
7139! On Input: !
7140! !
7141! ng Nested grid number (integer) !
7142! model Calling model identifier (integer) !
7143! ncname NetCDF file name (string) !
7144! myVarName Variable name (string) !
7145! A Data value(s) to be written (real) !
7146! start Starting index where the first of the data values !
7147! will be written along each dimension (integer) !
7148! total Number of data values to be written along each !
7149! dimension (integer) !
7150! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7151! pioFile%fh file handler !
7152! pioFile%iosystem IO system descriptor (struct) !
7153! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7154! pioVar%varID Variable ID !
7155! pioVar%ncid File ID !
7156! !
7157! On Ouput: !
7158! !
7159! exit_flag Error flag (integer) stored in MOD_SCALARS !
7160! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7161! !
7162! Notice: This routine must be used to write only nontiled variables. !
7163! !
7164!=======================================================================
7165!
7166! Imported variable declarations.
7167!
7168 integer, intent(in) :: ng, model
7169 integer, intent(in) :: start(:), total(:)
7170!
7171 real(r8), intent(in) :: A(:)
7172!
7173 character (len=*), intent(in) :: ncname
7174 character (len=*), intent(in) :: myVarName
7175!
7176 TYPE (File_desc_t), intent(in), optional :: pioFile
7177 TYPE (Var_desc_t), intent(in), optional :: pioVar
7178!
7179! Local variable declarations.
7180!
7181 integer :: status
7182!
7183 character (len=*), parameter :: MyFile = &
7184 & __FILE__//", pio_netcdf_put_fvar_1d"
7185!
7186 TYPE (File_desc_t) :: my_pioFile
7187 TYPE (Var_desc_t) :: my_pioVar
7188!
7189!-----------------------------------------------------------------------
7190! Read in a floating-point 1D-array variable.
7191!-----------------------------------------------------------------------
7192!
7193! If file descriptor is not provided, open file for writing.
7194!
7195 IF (.not.PRESENT(piofile)) THEN
7196 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7198 ELSE
7199 my_piofile=piofile
7200 END IF
7201!
7202! If variable descriptor is not provided, inquire its value.
7203!
7204 IF (.not.PRESENT(piovar)) THEN
7205 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7206 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7207 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7208 & trim(sourcefile)
7209 exit_flag=3
7210 ioerror=status
7211 END IF
7212 ELSE
7213 my_piovar=piovar
7214 END IF
7215!
7216! Write out data.
7217!
7218 IF (exit_flag.eq.noerror) THEN
7219 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7220 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7221 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7222 & trim(sourcefile)
7223 exit_flag=3
7224 ioerror=status
7225 END IF
7226 END IF
7227!
7228! Close input file.
7229!
7230 IF (.not.PRESENT(piofile)) THEN
7231 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7232 END IF
7233!
7234 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1D - error while inquiring ', &
7235 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7236 & 2x,a,/,26x,'call from:',2x,a)
7237 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1D - error while writing ', &
7238 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7239 & /,26x,'call from:',2x,a)
7240!
7241 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_1dp()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_1dp ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(dp), dimension(:), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 6661 of file mod_pio_netcdf.F.

6664!
6665!=======================================================================
6666! !
6667! It writes a floating-point 1D-array variable into a NetCDF file. !
6668! If the file descritor is not provided, it opens the file, writes !
6669! data, and then closes the file. !
6670! !
6671! On Input: !
6672! !
6673! ng Nested grid number (integer) !
6674! model Calling model identifier (integer) !
6675! ncname NetCDF file name (string) !
6676! myVarName Variable name (string) !
6677! A Data value(s) to be written (double precision) !
6678! start Starting index where the first of the data values !
6679! will be written along each dimension (integer) !
6680! total Number of data values to be written along each !
6681! dimension (integer) !
6682! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6683! pioFile%fh file handler !
6684! pioFile%iosystem IO system descriptor (struct) !
6685! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6686! pioVar%varID Variable ID !
6687! pioVar%ncid File ID !
6688! !
6689! On Ouput: !
6690! !
6691! exit_flag Error flag (integer) stored in MOD_SCALARS !
6692! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6693! !
6694! Notice: This routine must be used to write only nontiled variables. !
6695! !
6696!=======================================================================
6697!
6698! Imported variable declarations.
6699!
6700 integer, intent(in) :: ng, model
6701 integer, intent(in) :: start(:), total(:)
6702!
6703 real(dp), intent(in) :: A(:)
6704!
6705 character (len=*), intent(in) :: ncname
6706 character (len=*), intent(in) :: myVarName
6707!
6708 TYPE (File_desc_t), intent(in), optional :: pioFile
6709 TYPE (Var_desc_t), intent(in), optional :: pioVar
6710!
6711! Local variable declarations.
6712!
6713 integer :: status
6714!
6715 character (len=*), parameter :: MyFile = &
6716 & __FILE__//", pio_netcdf_put_fvar_1dp"
6717!
6718 TYPE (File_desc_t) :: my_pioFile
6719 TYPE (Var_desc_t) :: my_pioVar
6720!
6721!-----------------------------------------------------------------------
6722! Read in a double-precision 1D-array variable.
6723!-----------------------------------------------------------------------
6724!
6725! If file descriptor is not provided, open file for writing.
6726!
6727 IF (.not.PRESENT(piofile)) THEN
6728 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6729 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6730 ELSE
6731 my_piofile=piofile
6732 END IF
6733!
6734! If variable descriptor is not provided, inquire its value.
6735!
6736 IF (.not.PRESENT(piovar)) THEN
6737 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6738 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6739 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6740 & trim(sourcefile)
6741 exit_flag=3
6742 ioerror=status
6743 END IF
6744 ELSE
6745 my_piovar=piovar
6746 END IF
6747!
6748! Write out data.
6749!
6750 IF (exit_flag.eq.noerror) THEN
6751 status=pio_put_var(my_piofile, my_piovar, start, total, a)
6752 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6753 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6754 & trim(sourcefile)
6755 exit_flag=3
6756 ioerror=status
6757 END IF
6758 END IF
6759!
6760! Close input file.
6761!
6762 IF (.not.PRESENT(piofile)) THEN
6763 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6764 END IF
6765!
6766 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1DP - error while inquiring ', &
6767 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6768 & 2x,a,/,27x,'call from:',2x,a)
6769 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1DP - error while writing ', &
6770 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
6771 & /,27x,'call from:',2x,a)
6772!
6773 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_2d()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_2d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(r8), dimension(:,:), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 7244 of file mod_pio_netcdf.F.

7247!
7248!=======================================================================
7249! !
7250! It writes a floating-point 2D-array variable into a NetCDF file. !
7251! If the file descritor is not provided, it opens the file, writes !
7252! data, and then closes the file. !
7253! !
7254! On Input: !
7255! !
7256! ng Nested grid number (integer) !
7257! model Calling model identifier (integer) !
7258! ncname NetCDF file name (string) !
7259! myVarName Variable name (string) !
7260! A Data value(s) to be written (real) !
7261! start Starting index where the first of the data values !
7262! will be written along each dimension (integer) !
7263! total Number of data values to be written along each !
7264! dimension (integer) !
7265! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7266! pioFile%fh file handler !
7267! pioFile%iosystem IO system descriptor (struct) !
7268! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7269! pioVar%varID Variable ID !
7270! pioVar%ncid File ID !
7271! !
7272! On Ouput: !
7273! !
7274! exit_flag Error flag (integer) stored in MOD_SCALARS !
7275! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7276! !
7277! Notice: This routine must be used to write only nontiled variables. !
7278! !
7279!=======================================================================
7280!
7281! Imported variable declarations.
7282!
7283 integer, intent(in) :: ng, model
7284 integer, intent(in) :: start(:), total(:)
7285!
7286 real(r8), intent(in) :: A(:,:)
7287!
7288 character (len=*), intent(in) :: ncname
7289 character (len=*), intent(in) :: myVarName
7290!
7291 TYPE (File_desc_t), intent(in), optional :: pioFile
7292 TYPE (Var_desc_t), intent(in), optional :: pioVar
7293!
7294! Local variable declarations.
7295!
7296 integer :: status
7297!
7298 character (len=*), parameter :: MyFile = &
7299 & __FILE__//", pio_netcdf_put_fvar_2d"
7300!
7301 TYPE (File_desc_t) :: my_pioFile
7302 TYPE (Var_desc_t) :: my_pioVar
7303!
7304!-----------------------------------------------------------------------
7305! Read in a floating-point 2D-array variable.
7306!-----------------------------------------------------------------------
7307!
7308! If file descriptor is not provided, open file for writing.
7309!
7310 IF (.not.PRESENT(piofile)) THEN
7311 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7312 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7313 ELSE
7314 my_piofile=piofile
7315 END IF
7316!
7317! If variable descriptor is not provided, inquire its value.
7318!
7319 IF (.not.PRESENT(piovar)) THEN
7320 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7321 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7322 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7323 & trim(sourcefile)
7324 exit_flag=3
7325 ioerror=status
7326 END IF
7327 ELSE
7328 my_piovar=piovar
7329 END IF
7330!
7331! Write out data.
7332!
7333 IF (exit_flag.eq.noerror) THEN
7334 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7335 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7336 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7337 & trim(sourcefile)
7338 exit_flag=3
7339 ioerror=status
7340 END IF
7341 END IF
7342!
7343! Close input file.
7344!
7345 IF (.not.PRESENT(piofile)) THEN
7346 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7347 END IF
7348!
7349 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2D - error while inquiring ', &
7350 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7351 & 2x,a,/,26x,'call from:',2x,a)
7352 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2D - error while writing ', &
7353 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7354 & /,26x,'call from:',2x,a)
7355!
7356 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_2dp()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_2dp ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(dp), dimension(:,:), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 6776 of file mod_pio_netcdf.F.

6779!
6780!=======================================================================
6781! !
6782! It writes a floating-point 2D-array variable into a NetCDF file. !
6783! If the file descritor is not provided, it opens the file, writes !
6784! data, and then closes the file. !
6785! !
6786! On Input: !
6787! !
6788! ng Nested grid number (integer) !
6789! model Calling model identifier (integer) !
6790! ncname NetCDF file name (string) !
6791! myVarName Variable name (string) !
6792! A Data value(s) to be written (double precision) !
6793! start Starting index where the first of the data values !
6794! will be written along each dimension (integer) !
6795! total Number of data values to be written along each !
6796! dimension (integer) !
6797! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6798! pioFile%fh file handler !
6799! pioFile%iosystem IO system descriptor (struct) !
6800! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6801! pioVar%varID Variable ID !
6802! pioVar%ncid File ID !
6803! !
6804! On Ouput: !
6805! !
6806! exit_flag Error flag (integer) stored in MOD_SCALARS !
6807! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6808! !
6809! Notice: This routine must be used to write only nontiled variables. !
6810! !
6811!=======================================================================
6812!
6813! Imported variable declarations.
6814!
6815 integer, intent(in) :: ng, model
6816 integer, intent(in) :: start(:), total(:)
6817!
6818 real(dp), intent(in) :: A(:,:)
6819!
6820 character (len=*), intent(in) :: ncname
6821 character (len=*), intent(in) :: myVarName
6822!
6823 TYPE (File_desc_t), intent(in), optional :: pioFile
6824 TYPE (Var_desc_t), intent(in), optional :: pioVar
6825!
6826! Local variable declarations.
6827!
6828 integer :: status
6829!
6830 character (len=*), parameter :: MyFile = &
6831 & __FILE__//", pio_netcdf_put_fvar_2dp"
6832!
6833 TYPE (File_desc_t) :: my_pioFile
6834 TYPE (Var_desc_t) :: my_pioVar
6835!
6836!-----------------------------------------------------------------------
6837! Read in a double-precision 2D-array variable.
6838!-----------------------------------------------------------------------
6839!
6840! If file descriptor is not provided, open file for writing.
6841!
6842 IF (.not.PRESENT(piofile)) THEN
6843 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6844 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6845 ELSE
6846 my_piofile=piofile
6847 END IF
6848!
6849! If variable descriptor is not provided, inquire its value.
6850!
6851 IF (.not.PRESENT(piovar)) THEN
6852 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6853 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6854 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6855 & trim(sourcefile)
6856 exit_flag=3
6857 ioerror=status
6858 END IF
6859 ELSE
6860 my_piovar=piovar
6861 END IF
6862!
6863! Write out data.
6864!
6865 IF (exit_flag.eq.noerror) THEN
6866 status=pio_put_var(my_piofile, my_piovar, start, total, a)
6867 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6868 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6869 & trim(sourcefile)
6870 exit_flag=3
6871 ioerror=status
6872 END IF
6873 END IF
6874!
6875! Close input file.
6876!
6877 IF (.not.PRESENT(piofile)) THEN
6878 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6879 END IF
6880!
6881 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2DP - error while inquiring ', &
6882 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6883 & 2x,a,/,27x,'call from:',2x,a)
6884 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2DP - error while writing ', &
6885 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
6886 & /,27x,'call from:',2x,a)
6887!
6888 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_3d()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_3d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(r8), dimension(:,:,:), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 7359 of file mod_pio_netcdf.F.

7362!
7363!=======================================================================
7364! !
7365! It writes a floating-point 3D-array variable into a NetCDF file. !
7366! If the file descritor is not provided, it opens the file, writes !
7367! data, and then closes the file. !
7368! !
7369! On Input: !
7370! !
7371! ng Nested grid number (integer) !
7372! model Calling model identifier (integer) !
7373! ncname NetCDF file name (string) !
7374! myVarName Variable name (string) !
7375! A Data value(s) to be written (real) !
7376! start Starting index where the first of the data values !
7377! will be written along each dimension (integer) !
7378! total Number of data values to be written along each !
7379! dimension (integer) !
7380! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7381! pioFile%fh file handler !
7382! pioFile%iosystem IO system descriptor (struct) !
7383! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7384! pioVar%varID Variable ID !
7385! pioVar%ncid File ID !
7386! !
7387! On Ouput: !
7388! !
7389! exit_flag Error flag (integer) stored in MOD_SCALARS !
7390! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7391! !
7392! Notice: This routine must be used to write only nontiled variables. !
7393! !
7394!=======================================================================
7395!
7396! Imported variable declarations.
7397!
7398 integer, intent(in) :: ng, model
7399 integer, intent(in) :: start(:), total(:)
7400!
7401 real(r8), intent(in) :: A(:,:,:)
7402!
7403 character (len=*), intent(in) :: ncname
7404 character (len=*), intent(in) :: myVarName
7405!
7406 TYPE (File_desc_t), intent(in), optional :: pioFile
7407 TYPE (Var_desc_t), intent(in), optional :: pioVar
7408!
7409! Local variable declarations.
7410!
7411 integer :: status
7412!
7413 character (len=*), parameter :: MyFile = &
7414 & __FILE__//", pio_netcdf_put_fvar_3d"
7415!
7416 TYPE (File_desc_t) :: my_pioFile
7417 TYPE (Var_desc_t) :: my_pioVar
7418!
7419!-----------------------------------------------------------------------
7420! Read in a floating-point 3D-array variable.
7421!-----------------------------------------------------------------------
7422!
7423! If file descriptor is not provided, open file for writing.
7424!
7425 IF (.not.PRESENT(piofile)) THEN
7426 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7427 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7428 ELSE
7429 my_piofile=piofile
7430 END IF
7431!
7432! If variable descriptor is not provided, inquire its value.
7433!
7434 IF (.not.PRESENT(piovar)) THEN
7435 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7436 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7437 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7438 & trim(sourcefile)
7439 exit_flag=3
7440 ioerror=status
7441 END IF
7442 ELSE
7443 my_piovar=piovar
7444 END IF
7445!
7446! Write out data.
7447!
7448 IF (exit_flag.eq.noerror) THEN
7449 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7450 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7451 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7452 & trim(sourcefile)
7453 exit_flag=3
7454 ioerror=status
7455 END IF
7456 END IF
7457!
7458! Close input file.
7459!
7460 IF (.not.PRESENT(piofile)) THEN
7461 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7462 END IF
7463!
7464 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3D - error while inquiring ', &
7465 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7466 & 2x,a,/,26x,'call from:',2x,a,/,26x,a)
7467 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3D - error while writing ', &
7468 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7469 & /,26x,'call from:',2x,a,/,26x,a)
7470!
7471 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_3dp()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_3dp ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(dp), dimension(:,:,:), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 6891 of file mod_pio_netcdf.F.

6894!
6895!=======================================================================
6896! !
6897! It writes a double-precision 3D-array variable into a NetCDF file. !
6898! If the file descritor is not provided, it opens the file, writes !
6899! data, and then closes the file. !
6900! !
6901! On Input: !
6902! !
6903! ng Nested grid number (integer) !
6904! model Calling model identifier (integer) !
6905! ncname NetCDF file name (string) !
6906! myVarName Variable name (string) !
6907! A Data value(s) to be written (real) !
6908! start Starting index where the first of the data values !
6909! will be written along each dimension (integer) !
6910! total Number of data values to be written along each !
6911! dimension (integer) !
6912! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6913! pioFile%fh file handler !
6914! pioFile%iosystem IO system descriptor (struct) !
6915! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6916! pioVar%varID Variable ID !
6917! pioVar%ncid File ID !
6918! !
6919! On Ouput: !
6920! !
6921! exit_flag Error flag (integer) stored in MOD_SCALARS !
6922! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6923! !
6924! Notice: This routine must be used to write only nontiled variables. !
6925! !
6926!=======================================================================
6927!
6928! Imported variable declarations.
6929!
6930 integer, intent(in) :: ng, model
6931 integer, intent(in) :: start(:), total(:)
6932!
6933 real(dp), intent(in) :: A(:,:,:)
6934!
6935 character (len=*), intent(in) :: ncname
6936 character (len=*), intent(in) :: myVarName
6937!
6938 TYPE (File_desc_t), intent(in), optional :: pioFile
6939 TYPE (Var_desc_t), intent(in), optional :: pioVar
6940!
6941! Local variable declarations.
6942!
6943 integer :: status
6944!
6945 character (len=*), parameter :: MyFile = &
6946 & __FILE__//", pio_netcdf_put_fvar_3dp"
6947!
6948 TYPE (File_desc_t) :: my_pioFile
6949 TYPE (Var_desc_t) :: my_pioVar
6950!
6951!-----------------------------------------------------------------------
6952! Read in a double-repcision 3D-array variable.
6953!-----------------------------------------------------------------------
6954!
6955! If file descriptor is not provided, open file for writing.
6956!
6957 IF (.not.PRESENT(piofile)) THEN
6958 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6959 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6960 ELSE
6961 my_piofile=piofile
6962 END IF
6963!
6964! If variable descriptor is not provided, inquire its value.
6965!
6966 IF (.not.PRESENT(piovar)) THEN
6967 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6968 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6969 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6970 & trim(sourcefile)
6971 exit_flag=3
6972 ioerror=status
6973 END IF
6974 ELSE
6975 my_piovar=piovar
6976 END IF
6977!
6978! Write out data.
6979!
6980 IF (exit_flag.eq.noerror) THEN
6981 status=pio_put_var(my_piofile, my_piovar, start, total, a)
6982 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6983 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6984 & trim(sourcefile)
6985 exit_flag=3
6986 ioerror=status
6987 END IF
6988 END IF
6989!
6990! Close input file.
6991!
6992 IF (.not.PRESENT(piofile)) THEN
6993 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6994 END IF
6995!
6996 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3DP - error while inquiring ', &
6997 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6998 & 2x,a,/,27x,'call from:',2x,a,/,27x,a)
6999 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3DP - error while writing ', &
7000 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
7001 & /,27x,'call from:',2x,a,/,27x,a)
7002!
7003 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ pio_netcdf_put_fvar_4d()

subroutine mod_pio_netcdf::pio_netcdf_put_fvar::pio_netcdf_put_fvar_4d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
real(r8), dimension(:,:,:,:), intent(in) a,
integer, dimension(:), intent(in) start,
integer, dimension(:), intent(in) total,
type (file_desc_t), intent(in), optional piofile,
type (var_desc_t), intent(in), optional piovar )

Definition at line 7474 of file mod_pio_netcdf.F.

7477!
7478!=======================================================================
7479! !
7480! It writes a floating-point 4D-array variable into a NetCDF file. !
7481! If the file descritor is not provided, it opens the file, writes !
7482! data, and then closes the file. !
7483! !
7484! On Input: !
7485! !
7486! ng Nested grid number (integer) !
7487! model Calling model identifier (integer) !
7488! ncname NetCDF file name (string) !
7489! myVarName Variable name (string) !
7490! A Data value(s) to be written (real) !
7491! start Starting index where the first of the data values !
7492! will be written along each dimension (integer) !
7493! total Number of data values to be written along each !
7494! dimension (integer) !
7495! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7496! pioFile%fh file handler !
7497! pioFile%iosystem IO system descriptor (struct) !
7498! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7499! pioVar%varID Variable ID !
7500! pioVar%ncid File ID !
7501! !
7502! On Ouput: !
7503! !
7504! exit_flag Error flag (integer) stored in MOD_SCALARS !
7505! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7506! !
7507! Notice: This routine must be used to write only nontiled variables. !
7508! !
7509!=======================================================================
7510!
7511! Imported variable declarations.
7512!
7513 integer, intent(in) :: ng, model
7514 integer, intent(in) :: start(:), total(:)
7515!
7516 real(r8), intent(in) :: A(:,:,:,:)
7517!
7518 character (len=*), intent(in) :: ncname
7519 character (len=*), intent(in) :: myVarName
7520!
7521 TYPE (File_desc_t), intent(in), optional :: pioFile
7522 TYPE (Var_desc_t), intent(in), optional :: pioVar
7523!
7524! Local variable declarations.
7525!
7526 integer :: status
7527!
7528 character (len=*), parameter :: MyFile = &
7529 & __FILE__//", pio_netcdf_put_fvar_4d"
7530!
7531 TYPE (File_desc_t) :: my_pioFile
7532 TYPE (Var_desc_t) :: my_pioVar
7533!
7534!-----------------------------------------------------------------------
7535! Read in a floating-point 4D-array variable.
7536!-----------------------------------------------------------------------
7537!
7538! If file descriptor is not provided, open file for writing.
7539!
7540 IF (.not.PRESENT(piofile)) THEN
7541 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7542 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7543 ELSE
7544 my_piofile=piofile
7545 END IF
7546!
7547! If variable descriptor is not provided, inquire its value.
7548!
7549 IF (.not.PRESENT(piovar)) THEN
7550 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7551 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7552 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7553 & trim(sourcefile)
7554 exit_flag=3
7555 ioerror=status
7556 END IF
7557 ELSE
7558 my_piovar=piovar
7559 END IF
7560!
7561! Write out data.
7562!
7563 IF (exit_flag.eq.noerror) THEN
7564 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7565 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7566 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7567 & trim(sourcefile)
7568 exit_flag=3
7569 ioerror=status
7570 END IF
7571 END IF
7572!
7573! Close input file.
7574!
7575 IF (.not.PRESENT(piofile)) THEN
7576 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7577 END IF
7578!
7579 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_4D - error while inquiring ', &
7580 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7581 & 2x,a,/,26x,'call from:',2x,a,/,26x,a)
7582 20 FORMAT (/,'PIO_NETCDF_PUT_FVAR_4D_PIO - error while writing ', &
7583 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7584 & /,26x,'call from:',2x,a,/,26x,a)
7585!
7586 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ioerror, mod_parallel::master, mod_scalars::noerror, mod_pio_netcdf::pio_netcdf_close(), mod_pio_netcdf::pio_netcdf_open(), 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: