40 PUBLIC ::
OPERATOR(==)
112 INTERFACE OPERATOR(==)
116 END INTERFACE OPERATOR(==)
123 '$Id: FitCoeff_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $' 130 REAL(fp),
PARAMETER ::
zero = 0.0_fp
131 REAL(fp),
PARAMETER ::
one = 1.0_fp
133 INTEGER,
PARAMETER ::
ml = 256
134 INTEGER,
PARAMETER ::
sl = 80
145 LOGICAL :: is_allocated = .false.
150 INTEGER(Long) :: dimensions(1) = 0
152 REAL(Double),
ALLOCATABLE :: c(:)
159 LOGICAL :: is_allocated = .false.
164 INTEGER(Long) :: dimensions(2) = 0
166 REAL(Double),
ALLOCATABLE :: c(:,:)
173 LOGICAL :: is_allocated = .false.
178 INTEGER(Long) :: dimensions(3) = 0
180 REAL(Double),
ALLOCATABLE :: c(:,:,:)
234 status = self%Is_Allocated
240 status = self%Is_Allocated
246 status = self%Is_Allocated
274 include
'FitCoeff_Destroy.inc' 279 include
'FitCoeff_Destroy.inc' 284 include
'FitCoeff_Destroy.inc' 327 INTEGER ,
INTENT(IN) :: dimensions(1)
329 INTEGER :: alloc_stat
332 IF ( any(dimensions < 1) )
RETURN 335 ALLOCATE( self%C(dimensions(1)), stat = alloc_stat )
336 IF ( alloc_stat /= 0 )
RETURN 340 self%Dimensions = dimensions
345 self%Is_Allocated = .true.
355 INTEGER ,
INTENT(IN) :: dimensions(2)
357 INTEGER :: alloc_stat
360 IF ( any(dimensions < 1) )
RETURN 363 ALLOCATE( self%C(dimensions(1), dimensions(2)), stat = alloc_stat )
364 IF ( alloc_stat /= 0 )
RETURN 368 self%Dimensions = dimensions
373 self%Is_Allocated = .true.
383 INTEGER ,
INTENT(IN) :: dimensions(3)
385 INTEGER :: alloc_stat
388 IF ( any(dimensions < 1) )
RETURN 391 ALLOCATE( self%C(dimensions(1), dimensions(2), dimensions(3)), stat = alloc_stat )
392 IF ( alloc_stat /= 0 )
RETURN 396 self%Dimensions = dimensions
401 self%Is_Allocated = .true.
453 TYPE(FitCoeff_1D_type),
INTENT(IN OUT) :: self
454 REAL(fp) ,
INTENT(IN) :: C(:)
455 INTEGER,
OPTIONAL,
INTENT(IN) :: Version
456 include
'FitCoeff_SetValue.inc' 465 TYPE(FitCoeff_2D_type),
INTENT(IN OUT) :: self
466 REAL(fp) ,
INTENT(IN) :: C(:,:)
467 INTEGER,
OPTIONAL,
INTENT(IN) :: Version
468 include
'FitCoeff_SetValue.inc' 477 TYPE(FitCoeff_3D_type),
INTENT(IN OUT) :: self
478 REAL(fp) ,
INTENT(IN) :: C(:,:,:)
479 INTEGER,
OPTIONAL,
INTENT(IN) :: Version
480 include
'FitCoeff_SetValue.inc' 507 TYPE(FitCoeff_1D_type),
INTENT(IN) :: self
508 WRITE(*,
'(1x,"FitCoeff 1D OBJECT")')
510 WRITE(*,
'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version
512 WRITE(*,
'(3x,"Dimensions : ",10(i5,:))') self%Dimensions
515 WRITE(*,
'(3x,"Coefficients:")')
516 WRITE(*,
'(5(1x,es13.6,:))') self%C
521 TYPE(FitCoeff_2D_type),
INTENT(IN) :: self
523 WRITE(*,
'(1x,"FitCoeff 2D OBJECT")')
525 WRITE(*,
'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version
527 WRITE(*,
'(3x,"Dimensions : ",10(i5,:))') self%Dimensions
530 WRITE(*,
'(3x,"Coefficients:")')
531 DO i = 1, self%Dimensions(2)
532 WRITE(*,
'(5x,"Outer dimension = ",i0," of ",i0)') i, self%Dimensions(2)
533 WRITE(*,
'(5(1x,es13.6,:))') self%C(:,i)
539 TYPE(FitCoeff_3D_type),
INTENT(IN) :: self
541 WRITE(*,
'(1x,"FitCoeff 3D OBJECT")')
543 WRITE(*,
'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version
545 WRITE(*,
'(3x,"Dimensions : ",10(i5,:))') self%Dimensions
548 WRITE(*,
'(3x,"Coefficients:")')
549 DO j = 1, self%Dimensions(3)
550 WRITE(*,
'(5x,"Outer dimension = ",i0," of ",i0)') j, self%Dimensions(3)
551 DO i = 1, self%Dimensions(2)
552 WRITE(*,
'(7x,"Middle dimension = ",i0," of ",i0)') i, self%Dimensions(2)
553 WRITE(*,
'(5(1x,es13.6,:))') self%C(:,i,j)
590 INTEGER,
INTENT(IN) :: release
594 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_ValidRelease' 604 WRITE( msg,
'("A FitCoeff data update is needed. ", & 605 &"FitCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
613 WRITE( msg,
'("A FitCoeff software update is needed. ", & 614 &"FitCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
675 TYPE(FitCoeff_1D_type),
INTENT(IN) :: self
676 include
'FitCoeff_Info.inc' 682 TYPE(FitCoeff_2D_type),
INTENT(IN) :: self
683 include
'FitCoeff_Info.inc' 689 TYPE(FitCoeff_3D_type),
INTENT(IN) :: self
690 include
'FitCoeff_Info.inc' 718 CHARACTER(*),
INTENT(OUT) :: id
815 n_Dimensions, & ! Optional output
816 Dimensions , & ! Optional output
817 Release , & ! Optional output
818 Version , & ! Optional output
819 Title , & ! Optional output
820 History , & ! Optional output
824 CHARACTER(*),
INTENT(IN) :: filename
825 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_dimensions
826 INTEGER ,
ALLOCATABLE,
OPTIONAL,
INTENT(OUT) :: dimensions(:)
827 INTEGER ,
OPTIONAL,
INTENT(OUT) :: release
828 INTEGER ,
OPTIONAL,
INTENT(OUT) :: version
829 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: title
830 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: history
831 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: comment
835 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_InquireFile' 838 CHARACTER(ML) :: io_msg
840 INTEGER :: alloc_stat
851 msg =
'File '//trim(filename)//
' not found.' 858 IF ( err_stat /=
success )
THEN 859 msg =
'Error opening '//trim(filename)
865 READ( fid, iostat=io_stat, iomsg=io_msg ) &
868 IF ( io_stat /= 0 )
THEN 869 msg =
'Error reading Release/Version - '//trim(io_msg)
873 msg =
'FitCoeff Release check failed.' 880 READ( fid, iostat=io_stat, iomsg=io_msg ) &
882 IF ( io_stat /= 0 )
THEN 883 msg =
'Error reading number of dimensions from '//trim(filename)//
' - '//trim(io_msg)
888 WRITE( msg,
'("Number of dimensions (",i0,") in ",a," is greater than maximum allowed (",i0,")")' ) &
893 READ( fid, iostat=io_stat, iomsg=io_msg ) &
895 IF ( io_stat /= 0 )
THEN 896 msg =
'Error reading dimension values from '//trim(filename)//
' - '//trim(io_msg)
907 IF ( err_stat /=
success )
THEN 908 msg =
'Error reading global attributes' 914 CLOSE( fid, iostat=io_stat, iomsg=io_msg )
915 IF ( io_stat /= 0 )
THEN 916 msg =
'Error closing '//trim(filename)//
' - '//trim(io_msg)
922 IF (
PRESENT(release ) ) release = rel
923 IF (
PRESENT(version ) ) version = ver
924 IF (
PRESENT(n_dimensions) ) n_dimensions = n_dims
925 IF (
PRESENT(dimensions ) )
THEN 926 ALLOCATE(dimensions(n_dims), stat=alloc_stat)
927 IF ( alloc_stat /= 0 )
THEN 928 WRITE( msg,
'("Error allocating output DIMENSIONS argument. STAT=",i0)') alloc_stat
931 dimensions = dims(1:n_dims)
939 CLOSE( fid, iostat=io_stat, iomsg=io_msg )
940 IF ( io_stat /= 0 ) &
941 msg = trim(msg)//
'; Error closing input file during error cleanup - '//trim(io_msg)
1045 FitCoeff, & ! Output
1047 No_Close, & ! Optional input
1048 Quiet , & ! Optional input
1049 Title , & ! Optional output
1050 History , & ! Optional output
1051 Comment , & ! Optional output
1056 CHARACTER(*),
INTENT(IN) :: filename
1057 LOGICAL ,
OPTIONAL,
INTENT(IN) :: no_close
1058 LOGICAL ,
OPTIONAL,
INTENT(IN) :: quiet
1059 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: title
1060 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: history
1061 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: comment
1062 LOGICAL ,
OPTIONAL,
INTENT(IN) :: debug
1066 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_ReadFile' 1070 include
'FitCoeff_ReadFile.inc' 1075 FitCoeff, & ! Output
1077 No_Close, & ! Optional input
1078 Quiet , & ! Optional input
1079 Title , & ! Optional output
1080 History , & ! Optional output
1081 Comment , & ! Optional output
1086 CHARACTER(*),
INTENT(IN) :: filename
1087 LOGICAL ,
OPTIONAL,
INTENT(IN) :: no_close
1088 LOGICAL ,
OPTIONAL,
INTENT(IN) :: quiet
1089 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: title
1090 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: history
1091 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: comment
1092 LOGICAL ,
OPTIONAL,
INTENT(IN) :: debug
1096 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_ReadFile' 1100 include
'FitCoeff_ReadFile.inc' 1105 FitCoeff, & ! Output
1107 No_Close, & ! Optional input
1108 Quiet , & ! Optional input
1109 Title , & ! Optional output
1110 History , & ! Optional output
1111 Comment , & ! Optional output
1116 CHARACTER(*),
INTENT(IN) :: filename
1117 LOGICAL ,
OPTIONAL,
INTENT(IN) :: no_close
1118 LOGICAL ,
OPTIONAL,
INTENT(IN) :: quiet
1119 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: title
1120 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: history
1121 CHARACTER(*),
OPTIONAL,
INTENT(OUT) :: comment
1122 LOGICAL ,
OPTIONAL,
INTENT(IN) :: debug
1126 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_ReadFile' 1130 include
'FitCoeff_ReadFile.inc' 1226 No_Close, & ! Optional input
1227 Quiet , & ! Optional input
1228 Title , & ! Optional input
1229 History , & ! Optional input
1230 Comment , & ! Optional input
1235 CHARACTER(*),
INTENT(IN) :: filename
1236 LOGICAL ,
OPTIONAL,
INTENT(IN) :: no_close
1237 LOGICAL ,
OPTIONAL,
INTENT(IN) :: quiet
1238 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: title
1239 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: history
1240 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: comment
1241 LOGICAL ,
OPTIONAL,
INTENT(IN) :: debug
1245 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_WriteFile' 1247 include
'FitCoeff_WriteFile.inc' 1254 No_Close, & ! Optional input
1255 Quiet , & ! Optional input
1256 Title , & ! Optional input
1257 History , & ! Optional input
1258 Comment , & ! Optional input
1263 CHARACTER(*),
INTENT(IN) :: filename
1264 LOGICAL ,
OPTIONAL,
INTENT(IN) :: no_close
1265 LOGICAL ,
OPTIONAL,
INTENT(IN) :: quiet
1266 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: title
1267 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: history
1268 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: comment
1269 LOGICAL ,
OPTIONAL,
INTENT(IN) :: debug
1273 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_WriteFile' 1275 include
'FitCoeff_WriteFile.inc' 1282 No_Close, & ! Optional input
1283 Quiet , & ! Optional input
1284 Title , & ! Optional input
1285 History , & ! Optional input
1286 Comment , & ! Optional input
1291 CHARACTER(*),
INTENT(IN) :: filename
1292 LOGICAL ,
OPTIONAL,
INTENT(IN) :: no_close
1293 LOGICAL ,
OPTIONAL,
INTENT(IN) :: quiet
1294 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: title
1295 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: history
1296 CHARACTER(*),
OPTIONAL,
INTENT(IN) :: comment
1297 LOGICAL ,
OPTIONAL,
INTENT(IN) :: debug
1301 CHARACTER(*),
PARAMETER :: routine_name =
'FitCoeff_WriteFile' 1303 include
'FitCoeff_WriteFile.inc' 1350 include
'FitCoeff_Equal.inc' 1356 include
'FitCoeff_Equal.inc' 1362 include
'FitCoeff_Equal.inc' pure subroutine fitcoeff_3d_destroy(self)
subroutine fitcoeff_2d_setvalue(self, C, Version)
subroutine fitcoeff_3d_inspect(self)
logical function validrelease(Release)
integer, parameter, public failure
logical function fitcoeff_3d_validrelease(self)
integer, parameter fitcoeff_release
integer function fitcoeff_3d_readfile(FitCoeff, Filename, No_Close, Quiet, Title, History, Comment, Debug)
real(fp), parameter, public zero
integer, parameter, public long
integer, parameter, public fp
pure function fitcoeff_1d_equal(x, y)
integer function, public readgatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
integer function fitcoeff_2d_readfile(FitCoeff, Filename, No_Close, Quiet, Title, History, Comment, Debug)
subroutine fitcoeff_3d_setvalue(self, C, Version)
logical function fitcoeff_1d_validrelease(self)
subroutine fitcoeff_1d_inspect(self)
integer, parameter, public double
subroutine fitcoeff_2d_info(self, Info)
integer function, public fitcoeff_inquirefile(Filename, n_Dimensions, Dimensions, Release, Version, Title, History, Comment)
character(*), parameter write_error_status
subroutine inquire_cleanup()
pure subroutine fitcoeff_2d_create(self, dimensions)
pure logical function fitcoeff_3d_associated(self)
logical function fitcoeff_2d_validrelease(self)
subroutine fitcoeff_1d_setvalue(self, C, Version)
subroutine fitcoeff_3d_info(self, Info)
subroutine fitcoeff_1d_info(self, Info)
integer function fitcoeff_2d_writefile(FitCoeff, Filename, No_Close, Quiet, Title, History, Comment, Debug)
integer function, public open_binary_file(Filename, FileID, For_Output, No_Check)
pure logical function fitcoeff_1d_associated(self)
real(fp), parameter, public one
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
pure subroutine fitcoeff_3d_create(self, dimensions)
integer, parameter, public fitcoeff_max_n_dimensions
integer function fitcoeff_1d_writefile(FitCoeff, Filename, No_Close, Quiet, Title, History, Comment, Debug)
pure function fitcoeff_2d_equal(x, y)
subroutine fitcoeff_2d_inspect(self)
integer function fitcoeff_1d_readfile(FitCoeff, Filename, No_Close, Quiet, Title, History, Comment, Debug)
integer function, public writegatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
pure subroutine fitcoeff_1d_destroy(self)
pure subroutine fitcoeff_1d_create(self, dimensions)
subroutine, public fitcoeff_defineversion(Id)
pure logical function fitcoeff_2d_associated(self)
character(*), parameter module_version_id
pure subroutine fitcoeff_2d_destroy(self)
integer, parameter, public success
integer function fitcoeff_3d_writefile(FitCoeff, Filename, No_Close, Quiet, Title, History, Comment, Debug)
pure function fitcoeff_3d_equal(x, y)
integer, parameter fitcoeff_version
integer, parameter, public information