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

Public Member Functions

subroutine pio_netcdf_put_ivar_0d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_ivar_1d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_ivar_2d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 

Detailed Description

Definition at line 108 of file mod_pio_netcdf.F.

Member Function/Subroutine Documentation

◆ pio_netcdf_put_ivar_0d()

subroutine mod_pio_netcdf::pio_netcdf_put_ivar::pio_netcdf_put_ivar_0d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
integer, 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 7589 of file mod_pio_netcdf.F.

7592!
7593!=======================================================================
7594! !
7595! It writes an integer scalar variable into a NetCDF file. If the !
7596! file descritor is not provided, it opens the file, writes data, !
7597! and then closes the file. !
7598! !
7599! On Input: !
7600! !
7601! ng Nested grid number (integer) !
7602! model Calling model identifier (integer) !
7603! ncname NetCDF file name (string) !
7604! myVarName Variable name (string) !
7605! A Data value(s) to be written (integer) !
7606! start Starting index where the first of the data values !
7607! will be written along each dimension (integer) !
7608! total Number of data values to be written along each !
7609! dimension (integer) !
7610! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7611! pioFile%fh file handler !
7612! pioFile%iosystem IO system descriptor (struct) !
7613! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7614! pioVar%varID Variable ID !
7615! pioVar%ncid File ID !
7616! !
7617! On Ouput: !
7618! !
7619! exit_flag Error flag (integer) stored in MOD_SCALARS !
7620! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7621! !
7622! Notice: This routine must be used to write only nontiled variables. !
7623! !
7624!=======================================================================
7625!
7626! Imported variable declarations.
7627!
7628 integer, intent(in) :: ng, model
7629 integer, intent(in) :: start(:), total(:)
7630
7631 integer, intent(in) :: A
7632!
7633 character (len=*), intent(in) :: ncname
7634 character (len=*), intent(in) :: myVarName
7635!
7636 TYPE (File_desc_t), intent(in), optional :: pioFile
7637 TYPE (Var_desc_t), intent(in), optional :: pioVar
7638!
7639! Local variable declarations.
7640!
7641 integer :: status
7642
7643 integer, dimension(1) :: my_A
7644!
7645 character (len=*), parameter :: MyFile = &
7646 & __FILE__//", pio_netcdf_put_ivar_0d"
7647!
7648 TYPE (File_desc_t) :: my_pioFile
7649 TYPE (Var_desc_t) :: my_pioVar
7650!
7651!-----------------------------------------------------------------------
7652! Read in a floating-point scalar variable.
7653!-----------------------------------------------------------------------
7654!
7655! If file descriptor is not provided, open file for writing.
7656!
7657 IF (.not.PRESENT(piofile)) THEN
7658 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7659 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7660 ELSE
7661 my_piofile=piofile
7662 END IF
7663!
7664! If variable descriptor is not provided, inquire its value.
7665!
7666 IF (.not.PRESENT(piovar)) THEN
7667 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7668 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7669 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7670 & trim(sourcefile)
7671 exit_flag=3
7672 ioerror=status
7673 END IF
7674 ELSE
7675 my_piovar=piovar
7676 END IF
7677!
7678! Write out data.
7679!
7680 IF (exit_flag.eq.noerror) THEN
7681 IF ((start(1).eq.0).and.(total(1).eq.0)) THEN
7682 status=pio_put_var(my_piofile, my_piovar, a)
7683 ELSE
7684 my_a(1)=a
7685 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
7686 END IF
7687 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7688 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7689 & trim(sourcefile)
7690 exit_flag=3
7691 ioerror=status
7692 END IF
7693 END IF
7694!
7695! Close file.
7696!
7697 IF (.not.PRESENT(piofile)) THEN
7698 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7699 END IF
7700!
7701 10 FORMAT (/,' PIO_NETCDF_PUT_IVAR_0D - error while inquiring ', &
7702 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7703 & 2x,a,/,26x,'call from:',2x,a)
7704 20 FORMAT (/,' PIO_NETCDF_PUT_IVAR_0D - error while writing ', &
7705 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7706 & /,26x,'call from:',2x,a)
7707!
7708 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_ivar_1d()

subroutine mod_pio_netcdf::pio_netcdf_put_ivar::pio_netcdf_put_ivar_1d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
integer, 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 7711 of file mod_pio_netcdf.F.

7714!
7715!=======================================================================
7716! !
7717! It writes an integer 1D-array variable into a NetCDF file. If the !
7718! file descritor is not provided, it opens the file, writes data, !
7719! and then closes the file. !
7720! !
7721! On Input: !
7722! !
7723! ng Nested grid number (integer) !
7724! model Calling model identifier (integer) !
7725! ncname NetCDF file name (string) !
7726! myVarName Variable name (string) !
7727! A Data value(s) to be written (integer) !
7728! start Starting index where the first of the data values !
7729! will be written along each dimension (integer) !
7730! total Number of data values to be written along each !
7731! dimension (integer) !
7732! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7733! pioFile%fh file handler !
7734! pioFile%iosystem IO system descriptor (struct) !
7735! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7736! pioVar%varID Variable ID !
7737! pioVar%ncid File ID !
7738! !
7739! On Ouput: !
7740! !
7741! exit_flag Error flag (integer) stored in MOD_SCALARS !
7742! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7743! !
7744! Notice: This routine must be used to write only nontiled variables. !
7745! !
7746!=======================================================================
7747!
7748! Imported variable declarations.
7749!
7750 integer, intent(in) :: ng, model
7751 integer, intent(in) :: start(:), total(:)
7752
7753 integer, intent(in) :: A(:)
7754!
7755 character (len=*), intent(in) :: ncname
7756 character (len=*), intent(in) :: myVarName
7757!
7758 TYPE (File_desc_t), intent(in), optional :: pioFile
7759 TYPE (Var_desc_t), intent(in), optional :: pioVar
7760!
7761! Local variable declarations.
7762!
7763 integer :: status
7764!
7765 character (len=*), parameter :: MyFile = &
7766 & __FILE__//", pio_netcdf_put_ivar_1d"
7767!
7768 TYPE (File_desc_t) :: my_pioFile
7769 TYPE (Var_desc_t) :: my_pioVar
7770!
7771!-----------------------------------------------------------------------
7772! Read in a floating-point scalar variable.
7773!-----------------------------------------------------------------------
7774!
7775! If file descriptor is not provided, open file for writing.
7776!
7777 IF (.not.PRESENT(piofile)) THEN
7778 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7779 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7780 ELSE
7781 my_piofile=piofile
7782 END IF
7783!
7784! If variable descriptor is not provided, inquire its value.
7785!
7786 IF (.not.PRESENT(piovar)) THEN
7787 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7788 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7789 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7790 & trim(sourcefile)
7791 exit_flag=3
7792 ioerror=status
7793 END IF
7794 ELSE
7795 my_piovar=piovar
7796 END IF
7797!
7798! Write out data.
7799!
7800 IF (exit_flag.eq.noerror) THEN
7801 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7802 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7803 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7804 & trim(sourcefile)
7805 exit_flag=3
7806 ioerror=status
7807 END IF
7808 END IF
7809!
7810! Close file.
7811!
7812 IF (.not.PRESENT(piofile)) THEN
7813 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7814 END IF
7815!
7816 10 FORMAT (/,' PIO_NETCDF_PUT_IVAR_1D - error while inquiring ', &
7817 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7818 & 2x,a,/,26x,'call from:',2x,a)
7819 20 FORMAT (/,' PIO_NETCDF_PUT_IVAR_1D - error while writing ', &
7820 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7821 & /,26x,'call from:',2x,a)
7822!
7823 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_ivar_2d()

subroutine mod_pio_netcdf::pio_netcdf_put_ivar::pio_netcdf_put_ivar_2d ( integer, intent(in) ng,
integer, intent(in) model,
character (len=*), intent(in) ncname,
character (len=*), intent(in) myvarname,
integer, 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 7826 of file mod_pio_netcdf.F.

7829!
7830!=======================================================================
7831! !
7832! It writes an integer 2D-array variable into a NetCDF file. If the !
7833! file descritor is not provided, it opens the file, writes data, !
7834! and then closes the file. !
7835! !
7836! On Input: !
7837! !
7838! ng Nested grid number (integer) !
7839! model Calling model identifier (integer) !
7840! ncname NetCDF file name (string) !
7841! myVarName Variable name (string) !
7842! A Data value(s) to be written (integer) !
7843! start Starting index where the first of the data values !
7844! will be written along each dimension (integer) !
7845! total Number of data values to be written along each !
7846! dimension (integer) !
7847! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7848! pioFile%fh file handler !
7849! pioFile%iosystem IO system descriptor (struct) !
7850! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7851! pioVar%varID Variable ID !
7852! pioVar%ncid File ID !
7853! !
7854! On Ouput: !
7855! !
7856! exit_flag Error flag (integer) stored in MOD_SCALARS !
7857! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7858! !
7859! Notice: This routine must be used to write only nontiled variables. !
7860! !
7861!=======================================================================
7862!
7863! Imported variable declarations.
7864!
7865 integer, intent(in) :: ng, model
7866 integer, intent(in) :: start(:), total(:)
7867
7868 integer, intent(in) :: A(:,:)
7869!
7870 character (len=*), intent(in) :: ncname
7871 character (len=*), intent(in) :: myVarName
7872!
7873 TYPE (File_desc_t), intent(in), optional :: pioFile
7874 TYPE (Var_desc_t), intent(in), optional :: pioVar
7875!
7876! Local variable declarations.
7877!
7878 integer :: status
7879!
7880 character (len=*), parameter :: MyFile = &
7881 & __FILE__//", pi_netcdf_put_ivar_2d"
7882!
7883 TYPE (File_desc_t) :: my_pioFile
7884 TYPE (Var_desc_t) :: my_pioVar
7885!
7886!-----------------------------------------------------------------------
7887! Read in a floating-point scalar variable.
7888!-----------------------------------------------------------------------
7889!
7890! If file descriptor is not provided, open file for writing.
7891!
7892 IF (.not.PRESENT(piofile)) THEN
7893 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7894 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7895 ELSE
7896 my_piofile=piofile
7897 END IF
7898!
7899! If variable descriptor is not provided, inquire its value.
7900!
7901 IF (.not.PRESENT(piovar)) THEN
7902 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7903 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7904 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7905 & trim(sourcefile)
7906 exit_flag=3
7907 ioerror=status
7908 END IF
7909 ELSE
7910 my_piovar=piovar
7911 END IF
7912!
7913! Write out data.
7914!
7915 IF (exit_flag.eq.noerror) THEN
7916 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7917 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7918 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7919 & trim(sourcefile)
7920 exit_flag=3
7921 ioerror=status
7922 END IF
7923 END IF
7924!
7925! Close file.
7926!
7927 IF (.not.PRESENT(piofile)) THEN
7928 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7929 END IF
7930!
7931 10 FORMAT (/,' PIO_NETCDF_PUT_IVAR_2D - error while inquiring ', &
7932 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7933 & 2x,a,/,26x,'call from:',2x,a)
7934 20 FORMAT (/,' PIO_NETCDF_PUT_IVAR_2D - error while writing ', &
7935 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7936 & /,26x,'call from:',2x,a)
7937!
7938 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: