! ! FitCoeff_Define ! ! Module defining the FitCoeff objects. ! ! ! CREATION HISTORY: ! Written by: Paul van Delst, 17-Nov-2011 ! paul.vandelst@noaa.gov MODULE FitCoeff_Define ! ----------------- ! Environment setup ! ----------------- ! Module use USE Type_Kinds , ONLY: fp, Long, Double USE Message_Handler , ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message USE Compare_Float_Numbers, ONLY: OPERATOR(.EqualTo.) USE File_Utility , ONLY: File_Open, File_Exists USE Binary_File_Utility , ONLY: Open_Binary_File , & WriteGAtts_Binary_File, & ReadGAtts_Binary_File ! Disable implicit typing IMPLICIT NONE ! ------------ ! Visibilities ! ------------ ! Everything private by default PRIVATE ! Parameters PUBLIC :: FITCOEFF_MAX_N_DIMENSIONS ! Datatypes PUBLIC :: FitCoeff_1D_type PUBLIC :: FitCoeff_2D_type PUBLIC :: FitCoeff_3D_type ! Operators PUBLIC :: OPERATOR(==) ! Procedures PUBLIC :: FitCoeff_Associated PUBLIC :: FitCoeff_Destroy PUBLIC :: FitCoeff_Create PUBLIC :: FitCoeff_SetValue PUBLIC :: FitCoeff_Inspect PUBLIC :: FitCoeff_ValidRelease PUBLIC :: FitCoeff_Info PUBLIC :: FitCoeff_DefineVersion PUBLIC :: FitCoeff_InquireFile PUBLIC :: FitCoeff_ReadFile PUBLIC :: FitCoeff_WriteFile ! --------------------- ! Procedure overloading ! --------------------- INTERFACE FitCoeff_Associated MODULE PROCEDURE FitCoeff_1D_Associated MODULE PROCEDURE FitCoeff_2D_Associated MODULE PROCEDURE FitCoeff_3D_Associated END INTERFACE FitCoeff_Associated INTERFACE FitCoeff_Destroy MODULE PROCEDURE FitCoeff_1D_Destroy MODULE PROCEDURE FitCoeff_2D_Destroy MODULE PROCEDURE FitCoeff_3D_Destroy END INTERFACE FitCoeff_Destroy INTERFACE FitCoeff_Create MODULE PROCEDURE FitCoeff_1D_Create MODULE PROCEDURE FitCoeff_2D_Create MODULE PROCEDURE FitCoeff_3D_Create END INTERFACE FitCoeff_Create INTERFACE FitCoeff_SetValue MODULE PROCEDURE FitCoeff_1D_SetValue MODULE PROCEDURE FitCoeff_2D_SetValue MODULE PROCEDURE FitCoeff_3D_SetValue END INTERFACE FitCoeff_SetValue INTERFACE FitCoeff_Inspect MODULE PROCEDURE FitCoeff_1D_Inspect MODULE PROCEDURE FitCoeff_2D_Inspect MODULE PROCEDURE FitCoeff_3D_Inspect END INTERFACE FitCoeff_Inspect INTERFACE FitCoeff_ValidRelease MODULE PROCEDURE FitCoeff_1D_ValidRelease MODULE PROCEDURE FitCoeff_2D_ValidRelease MODULE PROCEDURE FitCoeff_3D_ValidRelease END INTERFACE FitCoeff_ValidRelease INTERFACE FitCoeff_Info MODULE PROCEDURE FitCoeff_1D_Info MODULE PROCEDURE FitCoeff_2D_Info MODULE PROCEDURE FitCoeff_3D_Info END INTERFACE FitCoeff_Info INTERFACE FitCoeff_ReadFile MODULE PROCEDURE FitCoeff_1D_ReadFile MODULE PROCEDURE FitCoeff_2D_ReadFile MODULE PROCEDURE FitCoeff_3D_ReadFile END INTERFACE FitCoeff_ReadFile INTERFACE FitCoeff_WriteFile MODULE PROCEDURE FitCoeff_1D_WriteFile MODULE PROCEDURE FitCoeff_2D_WriteFile MODULE PROCEDURE FitCoeff_3D_WriteFile END INTERFACE FitCoeff_WriteFile INTERFACE OPERATOR(==) MODULE PROCEDURE FitCoeff_1D_Equal MODULE PROCEDURE FitCoeff_2D_Equal MODULE PROCEDURE FitCoeff_3D_Equal END INTERFACE OPERATOR(==) ! ----------------- ! Module parameters ! ----------------- CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = & '$Id: FitCoeff_Define.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $' ! Release and version INTEGER, PARAMETER :: FITCOEFF_RELEASE = 1 ! This determines structure and file formats. INTEGER, PARAMETER :: FITCOEFF_VERSION = 1 ! This is just the default data version. ! Close status for write errors CHARACTER(*), PARAMETER :: WRITE_ERROR_STATUS = 'DELETE' ! Literal constants REAL(fp), PARAMETER :: ZERO = 0.0_fp REAL(fp), PARAMETER :: ONE = 1.0_fp ! String lengths INTEGER, PARAMETER :: ML = 256 ! Message length INTEGER, PARAMETER :: SL = 80 ! String length ! Maximum number of dimensions INTEGER, PARAMETER :: FITCOEFF_MAX_N_DIMENSIONS = 3 ! Only implemented up to 3-D arrays so far ! ---------------------------------- ! FitCoeff data type definitions ! ---------------------------------- !:tdoc+: TYPE :: FitCoeff_1D_type ! Allocation indicator LOGICAL :: Is_Allocated = .FALSE. ! Release and version information INTEGER(Long) :: Release = FITCOEFF_RELEASE INTEGER(Long) :: Version = FITCOEFF_VERSION ! Dimensions INTEGER(Long) :: Dimensions(1) = 0 ! Data REAL(Double), ALLOCATABLE :: C(:) END TYPE FitCoeff_1D_type !:tdoc-: !:tdoc+: TYPE :: FitCoeff_2D_type ! Allocation indicator LOGICAL :: Is_Allocated = .FALSE. ! Release and version information INTEGER(Long) :: Release = FITCOEFF_RELEASE INTEGER(Long) :: Version = FITCOEFF_VERSION ! Dimensions INTEGER(Long) :: Dimensions(2) = 0 ! Data REAL(Double), ALLOCATABLE :: C(:,:) END TYPE FitCoeff_2D_type !:tdoc-: !:tdoc+: TYPE :: FitCoeff_3D_type ! Allocation indicator LOGICAL :: Is_Allocated = .FALSE. ! Release and version information INTEGER(Long) :: Release = FITCOEFF_RELEASE INTEGER(Long) :: Version = FITCOEFF_VERSION ! Dimensions INTEGER(Long) :: Dimensions(3) = 0 ! Data REAL(Double), ALLOCATABLE :: C(:,:,:) END TYPE FitCoeff_3D_type !:tdoc-: CONTAINS !################################################################################ !################################################################################ !## ## !## ## PUBLIC PROCEDURES ## ## !## ## !################################################################################ !################################################################################ !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_Associated ! ! PURPOSE: ! Pure function to test the status of the allocatable components ! of the FitCoeff structure. ! ! CALLING SEQUENCE: ! Status = FitCoeff_Associated( FitCoeff ) ! ! OBJECTS: ! FitCoeff: Structure which is to have its member's ! status tested. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! Status: The return value is a logical value indicating the ! status of the components. ! .TRUE. - if ANY of the FitCoeff allocatable members ! are in use. ! .FALSE. - if ALL of the FitCoeff allocatable members ! are not in use. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Same as input ! !:sdoc-: !-------------------------------------------------------------------------------- PURE FUNCTION FitCoeff_1D_Associated( self ) RESULT( Status ) TYPE(FitCoeff_1D_type), INTENT(IN) :: self LOGICAL :: Status Status = self%Is_Allocated END FUNCTION FitCoeff_1D_Associated PURE FUNCTION FitCoeff_2D_Associated( self ) RESULT( Status ) TYPE(FitCoeff_2D_type), INTENT(IN) :: self LOGICAL :: Status Status = self%Is_Allocated END FUNCTION FitCoeff_2D_Associated PURE FUNCTION FitCoeff_3D_Associated( self ) RESULT( Status ) TYPE(FitCoeff_3D_type), INTENT(IN) :: self LOGICAL :: Status Status = self%Is_Allocated END FUNCTION FitCoeff_3D_Associated !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_Destroy ! ! PURPOSE: ! Pure subroutine to re-initialize FitCoeff objects. ! ! CALLING SEQUENCE: ! CALL FitCoeff_Destroy( FitCoeff ) ! ! OBJECTS: ! FitCoeff: Re-initialized FitCoeff structure. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- PURE SUBROUTINE FitCoeff_1D_Destroy( self ) TYPE(FitCoeff_1D_type), INTENT(OUT) :: self INCLUDE 'FitCoeff_Destroy.inc' END SUBROUTINE FitCoeff_1D_Destroy PURE SUBROUTINE FitCoeff_2D_Destroy( self ) TYPE(FitCoeff_2D_type), INTENT(OUT) :: self INCLUDE 'FitCoeff_Destroy.inc' END SUBROUTINE FitCoeff_2D_Destroy PURE SUBROUTINE FitCoeff_3D_Destroy( self ) TYPE(FitCoeff_3D_type), INTENT(OUT) :: self INCLUDE 'FitCoeff_Destroy.inc' END SUBROUTINE FitCoeff_3D_Destroy !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_Create ! ! PURPOSE: ! Pure subroutine to create an instance of a FitCoeff object. ! ! CALLING SEQUENCE: ! CALL FitCoeff_Create( FitCoeff, Dimensions ) ! ! OBJECTS: ! FitCoeff: FitCoeff object structure. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! Dimensions: Dimension vector for the fitting coefficient array. ! The number of elements of this array must agree with ! the rank of the FitCoeff datatype specified, e.g. 2D ! type requires 2 dimensions specified. ! Values must be > 0. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Rank ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !-------------------------------------------------------------------------------- PURE SUBROUTINE FitCoeff_1D_Create( & self , & ! Output dimensions ) ! Input ! Arguments TYPE(FitCoeff_1D_type), INTENT(OUT) :: self INTEGER , INTENT(IN) :: dimensions(1) ! Local variables INTEGER :: alloc_stat ! Check input IF ( ANY(dimensions < 1) ) RETURN ! Perform the allocation ALLOCATE( self%C(dimensions(1)), STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Initialise ! ...Dimensions self%Dimensions = dimensions ! ...Arrays self%C = ZERO ! Set allocation indicator self%Is_Allocated = .TRUE. END SUBROUTINE FitCoeff_1D_Create PURE SUBROUTINE FitCoeff_2D_Create( & self , & ! Output dimensions ) ! Input ! Arguments TYPE(FitCoeff_2D_type), INTENT(OUT) :: self INTEGER , INTENT(IN) :: dimensions(2) ! Local variables INTEGER :: alloc_stat ! Check input IF ( ANY(dimensions < 1) ) RETURN ! Perform the allocation ALLOCATE( self%C(dimensions(1), dimensions(2)), STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Initialise ! ...Dimensions self%Dimensions = dimensions ! ...Arrays self%C = ZERO ! Set allocation indicator self%Is_Allocated = .TRUE. END SUBROUTINE FitCoeff_2D_Create PURE SUBROUTINE FitCoeff_3D_Create( & self , & ! Output dimensions ) ! Input ! Arguments TYPE(FitCoeff_3D_type), INTENT(OUT) :: self INTEGER , INTENT(IN) :: dimensions(3) ! Local variables INTEGER :: alloc_stat ! Check input IF ( ANY(dimensions < 1) ) RETURN ! Perform the allocation ALLOCATE( self%C(dimensions(1), dimensions(2), dimensions(3)), STAT = alloc_stat ) IF ( alloc_stat /= 0 ) RETURN ! Initialise ! ...Dimensions self%Dimensions = dimensions ! ...Arrays self%C = ZERO ! Set allocation indicator self%Is_Allocated = .TRUE. END SUBROUTINE FitCoeff_3D_Create !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_SetValue ! ! PURPOSE: ! Subroutine to set the value of coefficients in a FitCoeff object. ! ! CALLING SEQUENCE: ! CALL FitCoeff_SetValue( FitCoeff, Carray ) ! ! OBJECTS: ! FitCoeff: FitCoeff object structure which is to have its coefficient ! data set. ! Note #1: If unallocated, the object is allocated based ! on the SHAPE of the Carray input. ! Note #2: If already allocated, the dimensions of the ! coefficient component must be the same as that ! of the Carray input. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN OUT) ! ! INPUTS: ! Carray: Coefficient array to be assigned to FitCoeff object. ! The rank of this array must agree with the rank of ! the FitCoeff datatype specified, e.g. 2D FitCoeff ! type requires a rank-2 coefficient array. ! UNITS: N/A ! TYPE: REAL(fp) ! DIMENSION: Rank conforming with FitCoeff type. ! ATTRIBUTES: INTENT(IN) ! ! COMMENTS: ! If an error occurs, the FitCoeff object is deallocated. ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE FitCoeff_1D_SetValue( & self , & ! In/output C , & ! Input Version ) ! optional input ! Arguments TYPE(FitCoeff_1D_type), INTENT(IN OUT) :: self REAL(fp) , INTENT(IN) :: C(:) INTEGER, OPTIONAL, INTENT(IN) :: Version INCLUDE 'FitCoeff_SetValue.inc' END SUBROUTINE FitCoeff_1D_SetValue SUBROUTINE FitCoeff_2D_SetValue( & self , & ! In/output C , & ! Input Version ) ! optional input ! Arguments TYPE(FitCoeff_2D_type), INTENT(IN OUT) :: self REAL(fp) , INTENT(IN) :: C(:,:) INTEGER, OPTIONAL, INTENT(IN) :: Version INCLUDE 'FitCoeff_SetValue.inc' END SUBROUTINE FitCoeff_2D_SetValue SUBROUTINE FitCoeff_3D_SetValue( & self , & ! In/output C , & ! Input Version ) ! optional input ! Arguments TYPE(FitCoeff_3D_type), INTENT(IN OUT) :: self REAL(fp) , INTENT(IN) :: C(:,:,:) INTEGER, OPTIONAL, INTENT(IN) :: Version INCLUDE 'FitCoeff_SetValue.inc' END SUBROUTINE FitCoeff_3D_SetValue !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_Inspect ! ! PURPOSE: ! Subroutine to print the contents of a FitCoeff object to stdout. ! ! CALLING SEQUENCE: ! CALL FitCoeff_Inspect( FitCoeff ) ! ! OBJECTS: ! FitCoeff: FitCoeff object to display. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE FitCoeff_1D_Inspect( self ) TYPE(FitCoeff_1D_type), INTENT(IN) :: self WRITE(*,'(1x,"FitCoeff 1D OBJECT")') ! Release/version info WRITE(*,'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version ! Dimensions WRITE(*,'(3x,"Dimensions : ",10(i5,:))') self%Dimensions IF ( .NOT. FitCoeff_1D_Associated(self) ) RETURN ! Coefficient data WRITE(*,'(3x,"Coefficients:")') WRITE(*,'(5(1x,es13.6,:))') self%C END SUBROUTINE FitCoeff_1D_Inspect SUBROUTINE FitCoeff_2D_Inspect( self ) TYPE(FitCoeff_2D_type), INTENT(IN) :: self INTEGER :: i WRITE(*,'(1x,"FitCoeff 2D OBJECT")') ! Release/version info WRITE(*,'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version ! Dimensions WRITE(*,'(3x,"Dimensions : ",10(i5,:))') self%Dimensions IF ( .NOT. FitCoeff_2D_Associated(self) ) RETURN ! Coefficient data WRITE(*,'(3x,"Coefficients:")') DO i = 1, self%Dimensions(2) WRITE(*,'(5x,"Outer dimension = ",i0," of ",i0)') i, self%Dimensions(2) WRITE(*,'(5(1x,es13.6,:))') self%C(:,i) END DO END SUBROUTINE FitCoeff_2D_Inspect SUBROUTINE FitCoeff_3D_Inspect( self ) TYPE(FitCoeff_3D_type), INTENT(IN) :: self INTEGER :: i, j WRITE(*,'(1x,"FitCoeff 3D OBJECT")') ! Release/version info WRITE(*,'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version ! Dimensions WRITE(*,'(3x,"Dimensions : ",10(i5,:))') self%Dimensions IF ( .NOT. FitCoeff_3D_Associated(self) ) RETURN ! Coefficient data WRITE(*,'(3x,"Coefficients:")') DO j = 1, self%Dimensions(3) WRITE(*,'(5x,"Outer dimension = ",i0," of ",i0)') j, self%Dimensions(3) DO i = 1, self%Dimensions(2) WRITE(*,'(7x,"Middle dimension = ",i0," of ",i0)') i, self%Dimensions(2) WRITE(*,'(5(1x,es13.6,:))') self%C(:,i,j) END DO END DO END SUBROUTINE FitCoeff_3D_Inspect !---------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_ValidRelease ! ! PURPOSE: ! Function to check the FitCoeff Release value. ! ! CALLING SEQUENCE: ! IsValid = FitCoeff_ValidRelease( FitCoeff ) ! ! INPUTS: ! FitCoeff: FitCoeff object for which the Release component ! is to be checked. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! IsValid: Logical value defining the release validity. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! !:sdoc-: !---------------------------------------------------------------------------------- FUNCTION ValidRelease( Release ) RESULT( IsValid ) ! Arguments INTEGER, INTENT(IN) :: Release ! Function result LOGICAL :: IsValid ! Local parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_ValidRelease' ! Local variables CHARACTER(ML) :: msg ! Set up IsValid = .TRUE. ! Check release is not too old IF ( Release < FITCOEFF_RELEASE ) THEN IsValid = .FALSE. WRITE( msg,'("A FitCoeff data update is needed. ", & &"FitCoeff release is ",i0,". Valid release is ",i0,"." )' ) & Release, FITCOEFF_RELEASE CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ); RETURN END IF ! Check release is not too new IF ( Release > FITCOEFF_RELEASE ) THEN IsValid = .FALSE. WRITE( msg,'("A FitCoeff software update is needed. ", & &"FitCoeff release is ",i0,". Valid release is ",i0,"." )' ) & Release, FITCOEFF_RELEASE CALL Display_Message( ROUTINE_NAME, msg, INFORMATION ); RETURN END IF END FUNCTION ValidRelease FUNCTION FitCoeff_1D_ValidRelease( self ) RESULT( IsValid ) TYPE(FitCoeff_1D_type), INTENT(IN) :: self LOGICAL :: IsValid IsValid = ValidRelease( self%Release ) END FUNCTION FitCoeff_1D_ValidRelease FUNCTION FitCoeff_2D_ValidRelease( self ) RESULT( IsValid ) TYPE(FitCoeff_2D_type), INTENT(IN) :: self LOGICAL :: IsValid IsValid = ValidRelease( self%Release ) END FUNCTION FitCoeff_2D_ValidRelease FUNCTION FitCoeff_3D_ValidRelease( self ) RESULT( IsValid ) TYPE(FitCoeff_3D_type), INTENT(IN) :: self LOGICAL :: IsValid IsValid = ValidRelease( self%Release ) END FUNCTION FitCoeff_3D_ValidRelease !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_Info ! ! PURPOSE: ! Subroutine to return a string containing version and dimension ! information about a FitCoeff object. ! ! CALLING SEQUENCE: ! CALL FitCoeff_Info( FitCoeff, Info ) ! ! OBJECTS: ! FitCoeff: FitCoeff object about which info is required. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OUTPUTS: ! Info: String containing version and dimension information ! about the FitCoeff object. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE FitCoeff_1D_Info( self, Info ) ! Arguments TYPE(FitCoeff_1D_type), INTENT(IN) :: self INCLUDE 'FitCoeff_Info.inc' END SUBROUTINE FitCoeff_1D_Info SUBROUTINE FitCoeff_2D_Info( self, Info ) ! Arguments TYPE(FitCoeff_2D_type), INTENT(IN) :: self INCLUDE 'FitCoeff_Info.inc' END SUBROUTINE FitCoeff_2D_Info SUBROUTINE FitCoeff_3D_Info( self, Info ) ! Arguments TYPE(FitCoeff_3D_type), INTENT(IN) :: self INCLUDE 'FitCoeff_Info.inc' END SUBROUTINE FitCoeff_3D_Info !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_DefineVersion ! ! PURPOSE: ! Subroutine to return the module version information. ! ! CALLING SEQUENCE: ! CALL FitCoeff_DefineVersion( Id ) ! ! OUTPUTS: ! Id: Character string containing the version Id information ! for the module. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! !:sdoc-: !-------------------------------------------------------------------------------- SUBROUTINE FitCoeff_DefineVersion( Id ) CHARACTER(*), INTENT(OUT) :: Id Id = MODULE_VERSION_ID END SUBROUTINE FitCoeff_DefineVersion !------------------------------------------------------------------------------ !:sdoc+: ! ! NAME: ! FitCoeff_InquireFile ! ! PURPOSE: ! Function to inquire FitCoeff object files. ! ! CALLING SEQUENCE: ! Error_Status = FitCoeff_InquireFile( & ! Filename , & ! n_Dimensions = n_Dimensions, & ! Dimensions = Dimensions , & ! Release = Release , & ! Version = Version , & ! Title = Title , & ! History = History , & ! Comment = Comment ) ! ! INPUTS: ! Filename: Character string specifying the name of the ! data file to inquire. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL OUTPUTS: ! n_Dimensions: The rank of the coefficient data array. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! Dimensions: The dimension values of the coefficient data array. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Rank-1 ! ATTRIBUTES: INTENT(OUT), OPTIONAL, ALLOCATABLE ! ! Release: The data/file release number. Used to check ! for data/software mismatch. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! Version: The data/file version number. Used for ! purposes only in identifying the dataset for ! a particular release. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! Title: Character string containing a succinct description ! of what is in the dataset. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! History: Character string containing dataset creation ! history. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! Comment: Character string containing any comments about ! the dataset. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! FUNCTION RESULT: ! Error_Status: The return value is an integer defining the error ! status. The error codes are defined in the ! Message_Handler module. ! If == SUCCESS the file inquire was successful ! == FAILURE an unrecoverable error occurred. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !------------------------------------------------------------------------------ FUNCTION FitCoeff_InquireFile( & Filename , & ! Input n_Dimensions, & ! Optional output Dimensions , & ! Optional output Release , & ! Optional output Version , & ! Optional output Title , & ! Optional output History , & ! Optional output Comment ) & ! Optional output RESULT( err_stat ) ! Arguments CHARACTER(*), INTENT(IN) :: Filename INTEGER , OPTIONAL, INTENT(OUT) :: n_Dimensions INTEGER , ALLOCATABLE, OPTIONAL, INTENT(OUT) :: Dimensions(:) INTEGER , OPTIONAL, INTENT(OUT) :: Release INTEGER , OPTIONAL, INTENT(OUT) :: Version CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title CHARACTER(*), OPTIONAL, INTENT(OUT) :: History CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment ! Function result INTEGER :: err_stat ! Function parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_InquireFile' ! Function variables CHARACTER(ML) :: msg CHARACTER(ML) :: io_msg INTEGER :: io_stat INTEGER :: alloc_stat INTEGER :: fid INTEGER :: rel INTEGER :: ver INTEGER :: n_dims INTEGER :: dims(FITCOEFF_MAX_N_DIMENSIONS) ! Setup err_stat = SUCCESS ! ...Check that the file exists IF ( .NOT. File_Exists( Filename ) ) THEN msg = 'File '//TRIM(Filename)//' not found.' CALL Inquire_Cleanup(); RETURN END IF ! Open the file err_stat = Open_Binary_File( Filename, fid ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error opening '//TRIM(Filename) CALL Inquire_Cleanup(); RETURN END IF ! Read the release and version READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & rel, & ver IF ( io_stat /= 0 ) THEN msg = 'Error reading Release/Version - '//TRIM(io_msg) CALL Inquire_Cleanup(); RETURN END IF IF ( .NOT. ValidRelease( rel ) ) THEN msg = 'FitCoeff Release check failed.' CALL Inquire_Cleanup(); RETURN END IF ! Read the dimension data ! ...The number of dimensions READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & n_dims IF ( io_stat /= 0 ) THEN msg = 'Error reading number of dimensions from '//TRIM(Filename)//' - '//TRIM(io_msg) CALL Inquire_Cleanup(); RETURN END IF ! ...Check the value IF ( n_dims > FITCOEFF_MAX_N_DIMENSIONS ) THEN WRITE( msg,'("Number of dimensions (",i0,") in ",a," is greater than maximum allowed (",i0,")")' ) & n_dims, TRIM(Filename), FITCOEFF_MAX_N_DIMENSIONS CALL Inquire_Cleanup(); RETURN END IF ! ...The dimension values READ( fid, IOSTAT=io_stat, IOMSG=io_msg ) & dims(1:n_dims) IF ( io_stat /= 0 ) THEN msg = 'Error reading dimension values from '//TRIM(Filename)//' - '//TRIM(io_msg) CALL Inquire_Cleanup(); RETURN END IF ! Read the global attributes err_stat = ReadGAtts_Binary_File( & fid, & Title = Title , & History = History, & Comment = Comment ) IF ( err_stat /= SUCCESS ) THEN msg = 'Error reading global attributes' CALL Inquire_Cleanup(); RETURN END IF ! Close the file CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) IF ( io_stat /= 0 ) THEN msg = 'Error closing '//TRIM(Filename)//' - '//TRIM(io_msg) CALL Inquire_Cleanup(); RETURN END IF ! Assign the return arguments IF ( PRESENT(Release ) ) Release = rel IF ( PRESENT(Version ) ) Version = ver IF ( PRESENT(n_Dimensions) ) n_Dimensions = n_dims IF ( PRESENT(Dimensions ) ) THEN ALLOCATE(Dimensions(n_dims), STAT=alloc_stat) IF ( alloc_stat /= 0 ) THEN WRITE( msg,'("Error allocating output DIMENSIONS argument. STAT=",i0)') alloc_stat CALL Inquire_Cleanup(); RETURN END IF Dimensions = dims(1:n_dims) END IF CONTAINS SUBROUTINE Inquire_CleanUp() ! Close file if necessary IF ( File_Open(fid) ) THEN CLOSE( fid, IOSTAT=io_stat, IOMSG=io_msg ) IF ( io_stat /= 0 ) & msg = TRIM(msg)//'; Error closing input file during error cleanup - '//TRIM(io_msg) END IF ! Set error status and print error message err_stat = FAILURE CALL Display_Message( ROUTINE_NAME, msg, err_stat ) END SUBROUTINE Inquire_CleanUp END FUNCTION FitCoeff_InquireFile !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_ReadFile ! ! PURPOSE: ! Function to read FitCoeff object files. ! ! CALLING SEQUENCE: ! Error_Status = FitCoeff_ReadFile( & ! FitCoeff , & ! Filename , & ! No_Close = No_Close, & ! Quiet = Quiet , & ! Title = Title , & ! History = History , & ! Comment = Comment ) ! ! OBJECTS: ! FitCoeff: FitCoeff object containing the data read from file. ! While any FitCoeff data type can be used, the rank ! of the data in the file must correspond to the ! datatype. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT) ! ! INPUTS: ! Filename: Character string specifying the name of a ! FitCoeff data file to read. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL INPUTS: ! No_Close: Set this logical argument to *NOT* close the datafile ! upon exiting this routine. This option is required if ! the FitCoeff data is embedded within another file. ! If == .FALSE., File is closed upon function exit [DEFAULT]. ! == .TRUE., File is NOT closed upon function exit ! If not specified, default is .FALSE. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. ! == .TRUE., INFORMATION messages are SUPPRESSED. ! If not specified, default is .FALSE. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! OPTIONAL OUTPUTS: ! Title: Character string containing a succinct description ! of what is in the dataset. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! History: Character string containing dataset creation ! history. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! Comment: Character string containing any comments about ! the dataset. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(OUT), OPTIONAL ! ! FUNCTION RESULT: ! Error_Status: The return value is an integer defining the error status. ! The error codes are defined in the Message_Handler module. ! If == SUCCESS, the file read was successful ! == FAILURE, an unrecoverable error occurred. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !------------------------------------------------------------------------------ FUNCTION FitCoeff_1D_ReadFile( & FitCoeff, & ! Output Filename, & ! Input No_Close, & ! Optional input Quiet , & ! Optional input Title , & ! Optional output History , & ! Optional output Comment , & ! Optional output Debug ) & ! Optional input (Debug output control) RESULT( err_stat ) ! Arguments TYPE(FitCoeff_1D_type), INTENT(OUT) :: FitCoeff CHARACTER(*), INTENT(IN) :: Filename LOGICAL , OPTIONAL, INTENT(IN) :: No_Close LOGICAL , OPTIONAL, INTENT(IN) :: Quiet CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title CHARACTER(*), OPTIONAL, INTENT(OUT) :: History CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment LOGICAL , OPTIONAL, INTENT(IN) :: Debug ! Function result INTEGER :: err_stat ! Function parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_ReadFile' ! Function variables TYPE(FitCoeff_1D_type) :: dummy ! Insert common code INCLUDE 'FitCoeff_ReadFile.inc' END FUNCTION FitCoeff_1D_ReadFile FUNCTION FitCoeff_2D_ReadFile( & FitCoeff, & ! Output Filename, & ! Input No_Close, & ! Optional input Quiet , & ! Optional input Title , & ! Optional output History , & ! Optional output Comment , & ! Optional output Debug ) & ! Optional input (Debug output control) RESULT( err_stat ) ! Arguments TYPE(FitCoeff_2D_type), INTENT(OUT) :: FitCoeff CHARACTER(*), INTENT(IN) :: Filename LOGICAL , OPTIONAL, INTENT(IN) :: No_Close LOGICAL , OPTIONAL, INTENT(IN) :: Quiet CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title CHARACTER(*), OPTIONAL, INTENT(OUT) :: History CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment LOGICAL , OPTIONAL, INTENT(IN) :: Debug ! Function result INTEGER :: err_stat ! Function parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_ReadFile' ! Function variables TYPE(FitCoeff_2D_type) :: dummy ! Insert common code INCLUDE 'FitCoeff_ReadFile.inc' END FUNCTION FitCoeff_2D_ReadFile FUNCTION FitCoeff_3D_ReadFile( & FitCoeff, & ! Output Filename, & ! Input No_Close, & ! Optional input Quiet , & ! Optional input Title , & ! Optional output History , & ! Optional output Comment , & ! Optional output Debug ) & ! Optional input (Debug output control) RESULT( err_stat ) ! Arguments TYPE(FitCoeff_3D_type), INTENT(OUT) :: FitCoeff CHARACTER(*), INTENT(IN) :: Filename LOGICAL , OPTIONAL, INTENT(IN) :: No_Close LOGICAL , OPTIONAL, INTENT(IN) :: Quiet CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title CHARACTER(*), OPTIONAL, INTENT(OUT) :: History CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment LOGICAL , OPTIONAL, INTENT(IN) :: Debug ! Function result INTEGER :: err_stat ! Function parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_ReadFile' ! Function variables TYPE(FitCoeff_3D_type) :: dummy ! Insert common code INCLUDE 'FitCoeff_ReadFile.inc' END FUNCTION FitCoeff_3D_ReadFile !-------------------------------------------------------------------------------- !:sdoc+: ! ! NAME: ! FitCoeff_WriteFile ! ! PURPOSE: ! Function to write FitCoeff object files. ! ! CALLING SEQUENCE: ! Error_Status = FitCoeff_WriteFile( & ! FitCoeff , & ! Filename , & ! No_Close = No_Close, & ! Quiet = Quiet , & ! Title = Title , & ! History = History , & ! Comment = Comment ) ! ! OBJECTS: ! FitCoeff: FitCoeff object containing the data to write to file. ! UNITS: N/A ! TYPE: FitCoeff_type ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! INPUTS: ! Filename: Character string specifying the name of a ! FitCoeff format data file to write. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN) ! ! OPTIONAL INPUTS: ! No_Close: Set this logical argument to *NOT* close the datafile ! upon exiting this routine. This option is required if ! the FitCoeff data is to be embedded within another file. ! If == .FALSE., File is closed upon function exit [DEFAULT]. ! == .TRUE., File is NOT closed upon function exit ! If not specified, default is .FALSE. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! Quiet: Set this logical argument to suppress INFORMATION ! messages being printed to stdout ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT]. ! == .TRUE., INFORMATION messages are SUPPRESSED. ! If not specified, default is .FALSE. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! Title: Character string containing a succinct description ! of what is in the dataset. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! History: Character string containing dataset creation ! history. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! Comment: Character string containing any comments about ! the dataset. ! UNITS: N/A ! TYPE: CHARACTER(*) ! DIMENSION: Scalar ! ATTRIBUTES: INTENT(IN), OPTIONAL ! ! FUNCTION RESULT: ! Error_Status: The return value is an integer defining the error status. ! The error codes are defined in the Message_Handler module. ! If == SUCCESS, the file write was successful ! == FAILURE, an unrecoverable error occurred. ! UNITS: N/A ! TYPE: INTEGER ! DIMENSION: Scalar ! !:sdoc-: !------------------------------------------------------------------------------ FUNCTION FitCoeff_1D_WriteFile( & FitCoeff, & ! Input Filename, & ! Input No_Close, & ! Optional input Quiet , & ! Optional input Title , & ! Optional input History , & ! Optional input Comment , & ! Optional input Debug ) & ! Optional input (Debug output control) RESULT( err_stat ) ! Arguments TYPE(FitCoeff_1D_type), INTENT(IN) :: FitCoeff CHARACTER(*), INTENT(IN) :: Filename LOGICAL , OPTIONAL, INTENT(IN) :: No_Close LOGICAL , OPTIONAL, INTENT(IN) :: Quiet CHARACTER(*), OPTIONAL, INTENT(IN) :: Title CHARACTER(*), OPTIONAL, INTENT(IN) :: History CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment LOGICAL , OPTIONAL, INTENT(IN) :: Debug ! Function result INTEGER :: err_stat ! Function parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_WriteFile' ! Insert common code INCLUDE 'FitCoeff_WriteFile.inc' END FUNCTION FitCoeff_1D_WriteFile FUNCTION FitCoeff_2D_WriteFile( & FitCoeff, & ! Input Filename, & ! Input No_Close, & ! Optional input Quiet , & ! Optional input Title , & ! Optional input History , & ! Optional input Comment , & ! Optional input Debug ) & ! Optional input (Debug output control) RESULT( err_stat ) ! Arguments TYPE(FitCoeff_2D_type), INTENT(IN) :: FitCoeff CHARACTER(*), INTENT(IN) :: Filename LOGICAL , OPTIONAL, INTENT(IN) :: No_Close LOGICAL , OPTIONAL, INTENT(IN) :: Quiet CHARACTER(*), OPTIONAL, INTENT(IN) :: Title CHARACTER(*), OPTIONAL, INTENT(IN) :: History CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment LOGICAL , OPTIONAL, INTENT(IN) :: Debug ! Function result INTEGER :: err_stat ! Function parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_WriteFile' ! Insert common code INCLUDE 'FitCoeff_WriteFile.inc' END FUNCTION FitCoeff_2D_WriteFile FUNCTION FitCoeff_3D_WriteFile( & FitCoeff, & ! Input Filename, & ! Input No_Close, & ! Optional input Quiet , & ! Optional input Title , & ! Optional input History , & ! Optional input Comment , & ! Optional input Debug ) & ! Optional input (Debug output control) RESULT( err_stat ) ! Arguments TYPE(FitCoeff_3D_type), INTENT(IN) :: FitCoeff CHARACTER(*), INTENT(IN) :: Filename LOGICAL , OPTIONAL, INTENT(IN) :: No_Close LOGICAL , OPTIONAL, INTENT(IN) :: Quiet CHARACTER(*), OPTIONAL, INTENT(IN) :: Title CHARACTER(*), OPTIONAL, INTENT(IN) :: History CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment LOGICAL , OPTIONAL, INTENT(IN) :: Debug ! Function result INTEGER :: err_stat ! Function parameters CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'FitCoeff_WriteFile' ! Insert common code INCLUDE 'FitCoeff_WriteFile.inc' END FUNCTION FitCoeff_3D_WriteFile !################################################################################ !################################################################################ !## ## !## ## PRIVATE PROCEDURES ## ## !## ## !################################################################################ !################################################################################ !-------------------------------------------------------------------------------- ! ! NAME: ! FitCoeff_Equal ! ! PURPOSE: ! Pure function to test the equality of two FitCoeff objects. ! Used in OPERATOR(==) interface block. ! ! CALLING SEQUENCE: ! is_equal = FitCoeff_Equal( x, y ) ! ! or ! ! IF ( x == y ) THEN ! ... ! END IF ! ! OBJECTS: ! x, y: Two FitCoeff objects to be compared. ! UNITS: N/A ! TYPE: Any FitCoeff type ! DIMENSION: Scalar or any rank ! ATTRIBUTES: INTENT(IN) ! ! FUNCTION RESULT: ! is_equal: Logical value indicating whether the inputs are equal. ! UNITS: N/A ! TYPE: LOGICAL ! DIMENSION: Same as inputs. ! !-------------------------------------------------------------------------------- PURE FUNCTION FitCoeff_1D_Equal( x, y ) RESULT( is_equal ) TYPE(FitCoeff_1D_type), INTENT(IN) :: x, y INCLUDE 'FitCoeff_Equal.inc' END FUNCTION FitCoeff_1D_Equal PURE FUNCTION FitCoeff_2D_Equal( x, y ) RESULT( is_equal ) TYPE(FitCoeff_2D_type), INTENT(IN) :: x, y INCLUDE 'FitCoeff_Equal.inc' END FUNCTION FitCoeff_2D_Equal PURE FUNCTION FitCoeff_3D_Equal( x, y ) RESULT( is_equal ) TYPE(FitCoeff_3D_type), INTENT(IN) :: x, y INCLUDE 'FitCoeff_Equal.inc' END FUNCTION FitCoeff_3D_Equal END MODULE FitCoeff_Define