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

Public Member Functions

subroutine pio_netcdf_put_svar_0d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_svar_1d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_svar_2d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 
subroutine pio_netcdf_put_svar_3d (ng, model, ncname, myvarname, a, start, total, piofile, piovar)
 

Detailed Description

Definition at line 120 of file mod_pio_netcdf.F.

Member Function/Subroutine Documentation

◆ pio_netcdf_put_svar_0d()

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

8343!
8344!=======================================================================
8345! !
8346! This routine writes a string scalar variable into a file. If !
8347! the NetCDF ID is not provided, it opens the file, writes data, !
8348! and then closes the file. The CDL of the scalar variable has !
8349! one-dimension in the NetCDF file for the number of characters: !
8350! !
8351! char string(Nchars) CDL !
8352! !
8353! character (len=Nchars) :: string F90 !
8354! !
8355! to write a scalar string use: !
8356! !
8357! start = (/1/) !
8358! total = (/Nchars/) !
8359! !
8360! On Input: !
8361! !
8362! ng Nested grid number (integer) !
8363! model Calling model identifier (integer) !
8364! ncname NetCDF file name (string) !
8365! myVarName Variable name (string) !
8366! A Data value(s) to be written (string) !
8367! start Starting index where the first of the data values !
8368! will be written along each dimension (1D vector !
8369! integer) !
8370! total Number of data values to be written along each !
8371! dimension (1D vector integer) !
8372! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8373! pioFile%fh file handler !
8374! pioFile%iosystem IO system descriptor (struct) !
8375! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8376! pioVar%varID Variable ID !
8377! pioVar%ncid File ID !
8378! !
8379! On Ouput: !
8380! !
8381! exit_flag Error flag (integer) stored in MOD_SCALARS !
8382! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8383! !
8384! Notice: This routine must be used to write only nontiled variables. !
8385! !
8386!=======================================================================
8387!
8388! Imported variable declarations.
8389!
8390 integer, intent(in) :: ng, model
8391
8392 integer, intent(in) :: start(:), total(:)
8393!
8394 character (len=*), intent(in) :: A
8395 character (len=*), intent(in) :: ncname
8396 character (len=*), intent(in) :: myVarName
8397!
8398 TYPE (File_desc_t), intent(in), optional :: pioFile
8399 TYPE (Var_desc_t), intent(in), optional :: pioVar
8400!
8401! Local variable declarations.
8402!
8403 integer :: status
8404!
8405 character (len=LEN(A)), dimension(1) :: my_A
8406
8407 character (len=*), parameter :: MyFile = &
8408 & __FILE__//", pio_netcdf_put_svar_0d"
8409!
8410 TYPE (File_desc_t) :: my_pioFile
8411 TYPE (Var_desc_t) :: my_pioVar
8412!
8413!-----------------------------------------------------------------------
8414! Write out a scalar string.
8415!-----------------------------------------------------------------------
8416!
8417! If file ID is not provided, open file for writing.
8418!
8419 IF (.not.PRESENT(piofile)) THEN
8420 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8421 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8422 ELSE
8423 my_piofile=piofile
8424 END IF
8425!
8426! If variable descriptor is not provided, inquire its value.
8427!
8428 IF (.not.PRESENT(piovar)) THEN
8429 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8430 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8431 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8432 & trim(sourcefile)
8433 exit_flag=3
8434 ioerror=status
8435 END IF
8436 ELSE
8437 my_piovar=piovar
8438 END IF
8439!
8440! Write out data.
8441!
8442 IF (exit_flag.eq.noerror) THEN
8443 IF ((start(1).eq.1).and.(total(1).eq.1)) THEN
8444 status=pio_put_var(my_piofile, my_piovar, a)
8445 ELSE
8446 my_a(1)=a
8447 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
8448 END IF
8449 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8450 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8451 & trim(sourcefile)
8452 exit_flag=3
8453 ioerror=status
8454 END IF
8455 END IF
8456!
8457! Close input NetCDF file.
8458!
8459 IF (.not.PRESENT(piofile)) THEN
8460 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8461 END IF
8462!
8463 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_0D - error while inquiring ', &
8464 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8465 & 2x,a,/,26x,'call from:',2x,a)
8466 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_0D - error while writing ', &
8467 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8468 & /,26x,'call from:',2x,a)
8469!
8470 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_svar_1d()

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

8476!
8477!=======================================================================
8478! !
8479! This routine writes a string 1D-array variable into a file. If !
8480! the NetCDF ID is not provided, it opens the file, writes data, !
8481! and then closes the file. The CDL of the 1D-array variable has !
8482! two-dimensions in the NetCDF file, and the first dimension is !
8483! the number of characters: !
8484! !
8485! char string(dim1, Nchars) CDL !
8486! !
8487! character (len=Nchars) :: string(dim1) F90 !
8488! !
8489! to write a single array element at location (i) use: !
8490! !
8491! start = (/1, i/) !
8492! total = (/Nchars, 1/) !
8493! !
8494! On Input: !
8495! !
8496! ng Nested grid number (integer) !
8497! model Calling model identifier (integer) !
8498! ncname NetCDF file name (string) !
8499! myVarName Variable name (string) !
8500! A Data value(s) to be written (1D string array) !
8501! start Starting index where the first of the data values !
8502! will be written along each dimension (2D vector !
8503! integer) !
8504! total Number of data values to be written along each !
8505! dimension (2D vector integer) !
8506! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8507! pioFile%fh file handler !
8508! pioFile%iosystem IO system descriptor (struct) !
8509! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8510! pioVar%varID Variable ID !
8511! pioVar%ncid File ID !
8512! !
8513! On Ouput: !
8514! !
8515! exit_flag Error flag (integer) stored in MOD_SCALARS !
8516! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8517! !
8518! Notice: This routine must be used to write only nontiled variables. !
8519! !
8520!=======================================================================
8521!
8522! Imported variable declarations.
8523!
8524 integer, intent(in) :: ng, model
8525
8526 integer, intent(in) :: start(:), total(:)
8527!
8528 character (len=*), intent(in) :: A(:)
8529
8530 character (len=*), intent(in) :: ncname
8531 character (len=*), intent(in) :: myVarName
8532!
8533 TYPE (File_desc_t), intent(in), optional :: pioFile
8534 TYPE (Var_desc_t), intent(in), optional :: pioVar
8535!
8536! Local variable declarations.
8537!
8538 integer :: status
8539!
8540 character (len=*), parameter :: MyFile = &
8541 & __FILE__//", pio_netcdf_put_svar_1d"
8542!
8543 TYPE (File_desc_t) :: my_pioFile
8544 TYPE (Var_desc_t) :: my_pioVar
8545!
8546!-----------------------------------------------------------------------
8547! Write out a string 1D array or array element.
8548!-----------------------------------------------------------------------
8549!
8550! If NetCDF file ID is not provided, open NetCDF for writing.
8551!
8552 IF (.not.PRESENT(piofile)) THEN
8553 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8555 ELSE
8556 my_piofile=piofile
8557 END IF
8558!
8559! If variable descriptor is not provided, inquire its value.
8560!
8561 IF (.not.PRESENT(piovar)) THEN
8562 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8563 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8564 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8565 & trim(sourcefile)
8566 exit_flag=3
8567 ioerror=status
8568 END IF
8569 ELSE
8570 my_piovar=piovar
8571 END IF
8572!
8573! Write out data.
8574!
8575 IF (exit_flag.eq.noerror) THEN
8576 status=pio_put_var(my_piofile, my_piovar, start, total, a)
8577 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8578 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8579 & trim(sourcefile)
8580 exit_flag=3
8581 ioerror=status
8582 END IF
8583 END IF
8584!
8585! Close input NetCDF file.
8586!
8587 IF (.not.PRESENT(piofile)) THEN
8588 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8589 END IF
8590!
8591 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_1D - error while inquiring ', &
8592 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8593 & 2x,a,/,26x,'call from:',2x,a)
8594 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_1D - error while writing ', &
8595 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8596 & /,26x,'call from:',2x,a)
8597!
8598 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_svar_2d()

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

8604!
8605!=======================================================================
8606! !
8607! This routine writes a string 2D-array variable into a file. If !
8608! the NetCDF ID is not provided, it opens the file, writes data, !
8609! and then closes the file. The CDL of the 1D-array variable has !
8610! three-dimensions in the NetCDF file, and the first dimension is !
8611! the number of characters: !
8612! !
8613! char string(dim2, dim1, Nchars) CDL !
8614! !
8615! character (len=Nchars) :: string(dim1,dim2) F90 !
8616! !
8617! to write a single array element at location (i,j) use: !
8618! !
8619! start = (/1, i, j/) !
8620! total = (/Nchars, 1, 1/) !
8621! !
8622! On Input: !
8623! !
8624! ng Nested grid number (integer) !
8625! model Calling model identifier (integer) !
8626! ncname NetCDF file name (string) !
8627! myVarName Variable name (string) !
8628! A Data value(s) to be written (2D string array) !
8629! start Starting index where the first of the data values !
8630! will be written along each dimension (2D vector !
8631! integer) !
8632! total Number of data values to be written along each !
8633! dimension (2D vector integer) !
8634! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8635! pioFile%fh file handler !
8636! pioFile%iosystem IO system descriptor (struct) !
8637! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8638! pioVar%varID Variable ID !
8639! pioVar%ncid File ID !
8640! !
8641! On Ouput: !
8642! !
8643! exit_flag Error flag (integer) stored in MOD_SCALARS !
8644! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8645! !
8646! Notice: This routine must be used to write only nontiled variables. !
8647! !
8648!=======================================================================
8649!
8650! Imported variable declarations.
8651!
8652 integer, intent(in) :: ng, model
8653
8654 integer, intent(in) :: start(:), total(:)
8655!
8656 character (len=*), intent(in) :: A(:,:)
8657
8658 character (len=*), intent(in) :: ncname
8659 character (len=*), intent(in) :: myVarName
8660!
8661 TYPE (File_desc_t), intent(in), optional :: pioFile
8662 TYPE (Var_desc_t), intent(in), optional :: pioVar
8663!
8664! Local variable declarations.
8665!
8666 integer :: status
8667!
8668 character (len=*), parameter :: MyFile = &
8669 & __FILE__//", pio_netcdf_put_svar_2d"
8670!
8671 TYPE (File_desc_t) :: my_pioFile
8672 TYPE (Var_desc_t) :: my_pioVar
8673!
8674!-----------------------------------------------------------------------
8675! Write out a string 2D array or array element.
8676!-----------------------------------------------------------------------
8677!
8678! If NetCDF file ID is not provided, open NetCDF for writing.
8679!
8680 IF (.not.PRESENT(piofile)) THEN
8681 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8682 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8683 ELSE
8684 my_piofile=piofile
8685 END IF
8686!
8687! If variable descriptor is not provided, inquire its value.
8688!
8689 IF (.not.PRESENT(piovar)) THEN
8690 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8691 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8692 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8693 & trim(sourcefile)
8694 exit_flag=3
8695 ioerror=status
8696 END IF
8697 ELSE
8698 my_piovar=piovar
8699 END IF
8700!
8701! Write out data.
8702!
8703 IF (exit_flag.eq.noerror) THEN
8704 status=pio_put_var(my_piofile, my_piovar, start, total, a)
8705 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8706 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8707 & trim(sourcefile)
8708 exit_flag=3
8709 ioerror=status
8710 END IF
8711 END IF
8712!
8713! Close input NetCDF file.
8714!
8715 IF (.not.PRESENT(piofile)) THEN
8716 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8717 END IF
8718!
8719 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_2D - error while inquiring ', &
8720 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8721 & 2x,a,/,26x,'call from:',2x,a)
8722 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_2D - error while writing ', &
8723 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8724 & /,26x,'call from:',2x,a)
8725!
8726 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_svar_3d()

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

8732!
8733!=======================================================================
8734! !
8735! This routine writes a string 3D-array variable into a file. If !
8736! the NetCDF ID is not provided, it opens the file, writes data, !
8737! and then closes the file. The CDL of the 3D-array variable has !
8738! four-dimensions in the NetCDF file, and the first dimension is !
8739! the number of characters: !
8740! !
8741! char string(dim3, dim2, dim1, Nchars) CDL !
8742! !
8743! character (len=Nchars) :: string(dim1,dim2,dim3) F90 !
8744! !
8745! to write a single array element at location (i,j,k) use: !
8746! !
8747! start = (/1, i, j, k/) !
8748! total = (/Nchars, 1, 1, 1/) !
8749! !
8750! On Input: !
8751! !
8752! ng Nested grid number (integer) !
8753! model Calling model identifier (integer) !
8754! ncname NetCDF file name (string) !
8755! myVarName Variable name (string) !
8756! A Data value(s) to be written (3D string array) !
8757! start Starting index where the first of the data values !
8758! will be written along each dimension (2D vector !
8759! integer) !
8760! total Number of data values to be written along each !
8761! dimension (2D vector integer) !
8762! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8763! pioFile%fh file handler !
8764! pioFile%iosystem IO system descriptor (struct) !
8765! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8766! pioVar%varID Variable ID !
8767! pioVar%ncid File ID !
8768! !
8769! On Ouput: !
8770! !
8771! exit_flag Error flag (integer) stored in MOD_SCALARS !
8772! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8773! !
8774! Notice: This routine must be used to write only nontiled variables. !
8775! !
8776!=======================================================================
8777!
8778! Imported variable declarations.
8779!
8780 integer, intent(in) :: ng, model
8781
8782 integer, intent(in) :: start(:), total(:)
8783!
8784 character (len=*), intent(in) :: A(:,:,:)
8785
8786 character (len=*), intent(in) :: ncname
8787 character (len=*), intent(in) :: myVarName
8788!
8789 TYPE (File_desc_t), intent(in), optional :: pioFile
8790 TYPE (Var_desc_t), intent(in), optional :: pioVar
8791!
8792! Local variable declarations.
8793!
8794 integer :: status
8795!
8796 character (len=*), parameter :: MyFile = &
8797 & __FILE__//", pio_netcdf_put_svar_3d"
8798!
8799 TYPE (File_desc_t) :: my_pioFile
8800 TYPE (Var_desc_t) :: my_pioVar
8801!
8802!-----------------------------------------------------------------------
8803! Write out a string 3D array or array element.
8804!-----------------------------------------------------------------------
8805!
8806! If NetCDF file ID is not provided, open NetCDF for writing.
8807!
8808 IF (.not.PRESENT(piofile)) THEN
8809 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8810 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8811 ELSE
8812 my_piofile=piofile
8813 END IF
8814!
8815! If variable descriptor is not provided, inquire its value.
8816!
8817 IF (.not.PRESENT(piovar)) THEN
8818 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8819 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8820 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8821 & trim(sourcefile)
8822 exit_flag=3
8823 ioerror=status
8824 END IF
8825 ELSE
8826 my_piovar=piovar
8827 END IF
8828!
8829! Write out data.
8830!
8831 IF (exit_flag.eq.noerror) THEN
8832 status=pio_put_var(my_piofile, my_piovar, start, total, a)
8833 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8834 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8835 & trim(sourcefile)
8836 exit_flag=3
8837 ioerror=status
8838 END IF
8839 END IF
8840!
8841! Close input NetCDF file.
8842!
8843 IF (.not.PRESENT(piofile)) THEN
8844 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8845 END IF
8846!
8847 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_3D - error while inquiring ', &
8848 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8849 & 2x,a,/,26x,'call from:',2x,a)
8850 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_3D - error while writing ', &
8851 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8852 & /,26x,'call from:',2x,a)
8853!
8854 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: