FV3 Bundle
FitCoeff_Define.f90
Go to the documentation of this file.
1 !
2 ! FitCoeff_Define
3 !
4 ! Module defining the FitCoeff objects.
5 !
6 !
7 ! CREATION HISTORY:
8 ! Written by: Paul van Delst, 17-Nov-2011
9 ! paul.vandelst@noaa.gov
10 
12 
13  ! -----------------
14  ! Environment setup
15  ! -----------------
16  ! Module use
17  USE type_kinds , ONLY: fp, long, double
19  USE compare_float_numbers, ONLY: OPERATOR(.equalto.)
24  ! Disable implicit typing
25  IMPLICIT NONE
26 
27 
28  ! ------------
29  ! Visibilities
30  ! ------------
31  ! Everything private by default
32  PRIVATE
33  ! Parameters
35  ! Datatypes
36  PUBLIC :: fitcoeff_1d_type
37  PUBLIC :: fitcoeff_2d_type
38  PUBLIC :: fitcoeff_3d_type
39  ! Operators
40  PUBLIC :: OPERATOR(==)
41  ! Procedures
42  PUBLIC :: fitcoeff_associated
43  PUBLIC :: fitcoeff_destroy
44  PUBLIC :: fitcoeff_create
45  PUBLIC :: fitcoeff_setvalue
46  PUBLIC :: fitcoeff_inspect
47  PUBLIC :: fitcoeff_validrelease
48  PUBLIC :: fitcoeff_info
49  PUBLIC :: fitcoeff_defineversion
50  PUBLIC :: fitcoeff_inquirefile
51  PUBLIC :: fitcoeff_readfile
52  PUBLIC :: fitcoeff_writefile
53 
54 
55  ! ---------------------
56  ! Procedure overloading
57  ! ---------------------
59  MODULE PROCEDURE fitcoeff_1d_associated
60  MODULE PROCEDURE fitcoeff_2d_associated
61  MODULE PROCEDURE fitcoeff_3d_associated
62  END INTERFACE fitcoeff_associated
63 
64  INTERFACE fitcoeff_destroy
65  MODULE PROCEDURE fitcoeff_1d_destroy
66  MODULE PROCEDURE fitcoeff_2d_destroy
67  MODULE PROCEDURE fitcoeff_3d_destroy
68  END INTERFACE fitcoeff_destroy
69 
70  INTERFACE fitcoeff_create
71  MODULE PROCEDURE fitcoeff_1d_create
72  MODULE PROCEDURE fitcoeff_2d_create
73  MODULE PROCEDURE fitcoeff_3d_create
74  END INTERFACE fitcoeff_create
75 
77  MODULE PROCEDURE fitcoeff_1d_setvalue
78  MODULE PROCEDURE fitcoeff_2d_setvalue
79  MODULE PROCEDURE fitcoeff_3d_setvalue
80  END INTERFACE fitcoeff_setvalue
81 
82  INTERFACE fitcoeff_inspect
83  MODULE PROCEDURE fitcoeff_1d_inspect
84  MODULE PROCEDURE fitcoeff_2d_inspect
85  MODULE PROCEDURE fitcoeff_3d_inspect
86  END INTERFACE fitcoeff_inspect
87 
89  MODULE PROCEDURE fitcoeff_1d_validrelease
90  MODULE PROCEDURE fitcoeff_2d_validrelease
91  MODULE PROCEDURE fitcoeff_3d_validrelease
92  END INTERFACE fitcoeff_validrelease
93 
94  INTERFACE fitcoeff_info
95  MODULE PROCEDURE fitcoeff_1d_info
96  MODULE PROCEDURE fitcoeff_2d_info
97  MODULE PROCEDURE fitcoeff_3d_info
98  END INTERFACE fitcoeff_info
99 
101  MODULE PROCEDURE fitcoeff_1d_readfile
102  MODULE PROCEDURE fitcoeff_2d_readfile
103  MODULE PROCEDURE fitcoeff_3d_readfile
104  END INTERFACE fitcoeff_readfile
105 
107  MODULE PROCEDURE fitcoeff_1d_writefile
108  MODULE PROCEDURE fitcoeff_2d_writefile
109  MODULE PROCEDURE fitcoeff_3d_writefile
110  END INTERFACE fitcoeff_writefile
111 
112  INTERFACE OPERATOR(==)
113  MODULE PROCEDURE fitcoeff_1d_equal
114  MODULE PROCEDURE fitcoeff_2d_equal
115  MODULE PROCEDURE fitcoeff_3d_equal
116  END INTERFACE OPERATOR(==)
117 
118 
119  ! -----------------
120  ! Module parameters
121  ! -----------------
122  CHARACTER(*), PARAMETER :: module_version_id = &
123  '$Id: FitCoeff_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
124  ! Release and version
125  INTEGER, PARAMETER :: fitcoeff_release = 1 ! This determines structure and file formats.
126  INTEGER, PARAMETER :: fitcoeff_version = 1 ! This is just the default data version.
127  ! Close status for write errors
128  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
129  ! Literal constants
130  REAL(fp), PARAMETER :: zero = 0.0_fp
131  REAL(fp), PARAMETER :: one = 1.0_fp
132  ! String lengths
133  INTEGER, PARAMETER :: ml = 256 ! Message length
134  INTEGER, PARAMETER :: sl = 80 ! String length
135  ! Maximum number of dimensions
136  INTEGER, PARAMETER :: fitcoeff_max_n_dimensions = 3 ! Only implemented up to 3-D arrays so far
137 
138 
139  ! ----------------------------------
140  ! FitCoeff data type definitions
141  ! ----------------------------------
142  !:tdoc+:
144  ! Allocation indicator
145  LOGICAL :: is_allocated = .false.
146  ! Release and version information
147  INTEGER(Long) :: release = fitcoeff_release
148  INTEGER(Long) :: version = fitcoeff_version
149  ! Dimensions
150  INTEGER(Long) :: dimensions(1) = 0
151  ! Data
152  REAL(Double), ALLOCATABLE :: c(:)
153  END TYPE fitcoeff_1d_type
154  !:tdoc-:
155 
156  !:tdoc+:
158  ! Allocation indicator
159  LOGICAL :: is_allocated = .false.
160  ! Release and version information
161  INTEGER(Long) :: release = fitcoeff_release
162  INTEGER(Long) :: version = fitcoeff_version
163  ! Dimensions
164  INTEGER(Long) :: dimensions(2) = 0
165  ! Data
166  REAL(Double), ALLOCATABLE :: c(:,:)
167  END TYPE fitcoeff_2d_type
168  !:tdoc-:
169 
170  !:tdoc+:
172  ! Allocation indicator
173  LOGICAL :: is_allocated = .false.
174  ! Release and version information
175  INTEGER(Long) :: release = fitcoeff_release
176  INTEGER(Long) :: version = fitcoeff_version
177  ! Dimensions
178  INTEGER(Long) :: dimensions(3) = 0
179  ! Data
180  REAL(Double), ALLOCATABLE :: c(:,:,:)
181  END TYPE fitcoeff_3d_type
182  !:tdoc-:
183 
184 
185 CONTAINS
186 
187 
188 !################################################################################
189 !################################################################################
190 !## ##
191 !## ## PUBLIC PROCEDURES ## ##
192 !## ##
193 !################################################################################
194 !################################################################################
195 
196 !--------------------------------------------------------------------------------
197 !:sdoc+:
198 !
199 ! NAME:
200 ! FitCoeff_Associated
201 !
202 ! PURPOSE:
203 ! Pure function to test the status of the allocatable components
204 ! of the FitCoeff structure.
205 !
206 ! CALLING SEQUENCE:
207 ! Status = FitCoeff_Associated( FitCoeff )
208 !
209 ! OBJECTS:
210 ! FitCoeff: Structure which is to have its member's
211 ! status tested.
212 ! UNITS: N/A
213 ! TYPE: Any FitCoeff type
214 ! DIMENSION: Scalar
215 ! ATTRIBUTES: INTENT(IN)
216 !
217 ! FUNCTION RESULT:
218 ! Status: The return value is a logical value indicating the
219 ! status of the components.
220 ! .TRUE. - if ANY of the FitCoeff allocatable members
221 ! are in use.
222 ! .FALSE. - if ALL of the FitCoeff allocatable members
223 ! are not in use.
224 ! UNITS: N/A
225 ! TYPE: LOGICAL
226 ! DIMENSION: Same as input
227 !
228 !:sdoc-:
229 !--------------------------------------------------------------------------------
230 
231  PURE FUNCTION fitcoeff_1d_associated( self ) RESULT( Status )
232  TYPE(fitcoeff_1d_type), INTENT(IN) :: self
233  LOGICAL :: status
234  status = self%Is_Allocated
235  END FUNCTION fitcoeff_1d_associated
236 
237  PURE FUNCTION fitcoeff_2d_associated( self ) RESULT( Status )
238  TYPE(fitcoeff_2d_type), INTENT(IN) :: self
239  LOGICAL :: status
240  status = self%Is_Allocated
241  END FUNCTION fitcoeff_2d_associated
242 
243  PURE FUNCTION fitcoeff_3d_associated( self ) RESULT( Status )
244  TYPE(fitcoeff_3d_type), INTENT(IN) :: self
245  LOGICAL :: status
246  status = self%Is_Allocated
247  END FUNCTION fitcoeff_3d_associated
248 
249 
250 !--------------------------------------------------------------------------------
251 !:sdoc+:
252 !
253 ! NAME:
254 ! FitCoeff_Destroy
255 !
256 ! PURPOSE:
257 ! Pure subroutine to re-initialize FitCoeff objects.
258 !
259 ! CALLING SEQUENCE:
260 ! CALL FitCoeff_Destroy( FitCoeff )
261 !
262 ! OBJECTS:
263 ! FitCoeff: Re-initialized FitCoeff structure.
264 ! UNITS: N/A
265 ! TYPE: Any FitCoeff type
266 ! DIMENSION: Scalar
267 ! ATTRIBUTES: INTENT(OUT)
268 !
269 !:sdoc-:
270 !--------------------------------------------------------------------------------
271 
272  PURE SUBROUTINE fitcoeff_1d_destroy( self )
273  TYPE(fitcoeff_1d_type), INTENT(OUT) :: self
274  include 'FitCoeff_Destroy.inc'
275  END SUBROUTINE fitcoeff_1d_destroy
276 
277  PURE SUBROUTINE fitcoeff_2d_destroy( self )
278  TYPE(fitcoeff_2d_type), INTENT(OUT) :: self
279  include 'FitCoeff_Destroy.inc'
280  END SUBROUTINE fitcoeff_2d_destroy
281 
282  PURE SUBROUTINE fitcoeff_3d_destroy( self )
283  TYPE(fitcoeff_3d_type), INTENT(OUT) :: self
284  include 'FitCoeff_Destroy.inc'
285  END SUBROUTINE fitcoeff_3d_destroy
286 
287 
288 
289 !--------------------------------------------------------------------------------
290 !:sdoc+:
291 !
292 ! NAME:
293 ! FitCoeff_Create
294 !
295 ! PURPOSE:
296 ! Pure subroutine to create an instance of a FitCoeff object.
297 !
298 ! CALLING SEQUENCE:
299 ! CALL FitCoeff_Create( FitCoeff, Dimensions )
300 !
301 ! OBJECTS:
302 ! FitCoeff: FitCoeff object structure.
303 ! UNITS: N/A
304 ! TYPE: Any FitCoeff type
305 ! DIMENSION: Scalar
306 ! ATTRIBUTES: INTENT(OUT)
307 !
308 ! INPUTS:
309 ! Dimensions: Dimension vector for the fitting coefficient array.
310 ! The number of elements of this array must agree with
311 ! the rank of the FitCoeff datatype specified, e.g. 2D
312 ! type requires 2 dimensions specified.
313 ! Values must be > 0.
314 ! UNITS: N/A
315 ! TYPE: INTEGER
316 ! DIMENSION: Rank
317 ! ATTRIBUTES: INTENT(IN)
318 !
319 !:sdoc-:
320 !--------------------------------------------------------------------------------
321 
322  PURE SUBROUTINE fitcoeff_1d_create( &
323  self , & ! Output
324  dimensions ) ! Input
325  ! Arguments
326  TYPE(fitcoeff_1d_type), INTENT(OUT) :: self
327  INTEGER , INTENT(IN) :: dimensions(1)
328  ! Local variables
329  INTEGER :: alloc_stat
330 
331  ! Check input
332  IF ( any(dimensions < 1) ) RETURN
333 
334  ! Perform the allocation
335  ALLOCATE( self%C(dimensions(1)), stat = alloc_stat )
336  IF ( alloc_stat /= 0 ) RETURN
337 
338  ! Initialise
339  ! ...Dimensions
340  self%Dimensions = dimensions
341  ! ...Arrays
342  self%C = zero
343 
344  ! Set allocation indicator
345  self%Is_Allocated = .true.
346 
347  END SUBROUTINE fitcoeff_1d_create
348 
349 
350  PURE SUBROUTINE fitcoeff_2d_create( &
351  self , & ! Output
352  dimensions ) ! Input
353  ! Arguments
354  TYPE(fitcoeff_2d_type), INTENT(OUT) :: self
355  INTEGER , INTENT(IN) :: dimensions(2)
356  ! Local variables
357  INTEGER :: alloc_stat
358 
359  ! Check input
360  IF ( any(dimensions < 1) ) RETURN
361 
362  ! Perform the allocation
363  ALLOCATE( self%C(dimensions(1), dimensions(2)), stat = alloc_stat )
364  IF ( alloc_stat /= 0 ) RETURN
365 
366  ! Initialise
367  ! ...Dimensions
368  self%Dimensions = dimensions
369  ! ...Arrays
370  self%C = zero
371 
372  ! Set allocation indicator
373  self%Is_Allocated = .true.
374 
375  END SUBROUTINE fitcoeff_2d_create
376 
377 
378  PURE SUBROUTINE fitcoeff_3d_create( &
379  self , & ! Output
380  dimensions ) ! Input
381  ! Arguments
382  TYPE(fitcoeff_3d_type), INTENT(OUT) :: self
383  INTEGER , INTENT(IN) :: dimensions(3)
384  ! Local variables
385  INTEGER :: alloc_stat
386 
387  ! Check input
388  IF ( any(dimensions < 1) ) RETURN
389 
390  ! Perform the allocation
391  ALLOCATE( self%C(dimensions(1), dimensions(2), dimensions(3)), stat = alloc_stat )
392  IF ( alloc_stat /= 0 ) RETURN
393 
394  ! Initialise
395  ! ...Dimensions
396  self%Dimensions = dimensions
397  ! ...Arrays
398  self%C = zero
399 
400  ! Set allocation indicator
401  self%Is_Allocated = .true.
402 
403  END SUBROUTINE fitcoeff_3d_create
404 
405 
406 
407 !--------------------------------------------------------------------------------
408 !:sdoc+:
409 !
410 ! NAME:
411 ! FitCoeff_SetValue
412 !
413 ! PURPOSE:
414 ! Subroutine to set the value of coefficients in a FitCoeff object.
415 !
416 ! CALLING SEQUENCE:
417 ! CALL FitCoeff_SetValue( FitCoeff, Carray )
418 !
419 ! OBJECTS:
420 ! FitCoeff: FitCoeff object structure which is to have its coefficient
421 ! data set.
422 ! Note #1: If unallocated, the object is allocated based
423 ! on the SHAPE of the Carray input.
424 ! Note #2: If already allocated, the dimensions of the
425 ! coefficient component must be the same as that
426 ! of the Carray input.
427 ! UNITS: N/A
428 ! TYPE: Any FitCoeff type
429 ! DIMENSION: Scalar
430 ! ATTRIBUTES: INTENT(IN OUT)
431 !
432 ! INPUTS:
433 ! Carray: Coefficient array to be assigned to FitCoeff object.
434 ! The rank of this array must agree with the rank of
435 ! the FitCoeff datatype specified, e.g. 2D FitCoeff
436 ! type requires a rank-2 coefficient array.
437 ! UNITS: N/A
438 ! TYPE: REAL(fp)
439 ! DIMENSION: Rank conforming with FitCoeff type.
440 ! ATTRIBUTES: INTENT(IN)
441 !
442 ! COMMENTS:
443 ! If an error occurs, the FitCoeff object is deallocated.
444 !
445 !:sdoc-:
446 !--------------------------------------------------------------------------------
447 
448  SUBROUTINE fitcoeff_1d_setvalue( &
449  self , & ! In/output
450  C , & ! Input
451  Version ) ! optional input
452  ! Arguments
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'
457  END SUBROUTINE fitcoeff_1d_setvalue
458 
459 
460  SUBROUTINE fitcoeff_2d_setvalue( &
461  self , & ! In/output
462  C , & ! Input
463  Version ) ! optional input
464  ! Arguments
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'
469  END SUBROUTINE fitcoeff_2d_setvalue
470 
471 
472  SUBROUTINE fitcoeff_3d_setvalue( &
473  self , & ! In/output
474  C , & ! Input
475  Version ) ! optional input
476  ! Arguments
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'
481  END SUBROUTINE fitcoeff_3d_setvalue
482 
483 
484 !--------------------------------------------------------------------------------
485 !:sdoc+:
486 !
487 ! NAME:
488 ! FitCoeff_Inspect
489 !
490 ! PURPOSE:
491 ! Subroutine to print the contents of a FitCoeff object to stdout.
492 !
493 ! CALLING SEQUENCE:
494 ! CALL FitCoeff_Inspect( FitCoeff )
495 !
496 ! OBJECTS:
497 ! FitCoeff: FitCoeff object to display.
498 ! UNITS: N/A
499 ! TYPE: Any FitCoeff type
500 ! DIMENSION: Scalar
501 ! ATTRIBUTES: INTENT(IN)
502 !
503 !:sdoc-:
504 !--------------------------------------------------------------------------------
505 
506  SUBROUTINE fitcoeff_1d_inspect( self )
507  TYPE(FitCoeff_1D_type), INTENT(IN) :: self
508  WRITE(*,'(1x,"FitCoeff 1D OBJECT")')
509  ! Release/version info
510  WRITE(*,'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version
511  ! Dimensions
512  WRITE(*,'(3x,"Dimensions : ",10(i5,:))') self%Dimensions
513  IF ( .NOT. fitcoeff_1d_associated(self) ) RETURN
514  ! Coefficient data
515  WRITE(*,'(3x,"Coefficients:")')
516  WRITE(*,'(5(1x,es13.6,:))') self%C
517  END SUBROUTINE fitcoeff_1d_inspect
518 
519 
520  SUBROUTINE fitcoeff_2d_inspect( self )
521  TYPE(FitCoeff_2D_type), INTENT(IN) :: self
522  INTEGER :: i
523  WRITE(*,'(1x,"FitCoeff 2D OBJECT")')
524  ! Release/version info
525  WRITE(*,'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version
526  ! Dimensions
527  WRITE(*,'(3x,"Dimensions : ",10(i5,:))') self%Dimensions
528  IF ( .NOT. fitcoeff_2d_associated(self) ) RETURN
529  ! Coefficient data
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)
534  END DO
535  END SUBROUTINE fitcoeff_2d_inspect
536 
537 
538  SUBROUTINE fitcoeff_3d_inspect( self )
539  TYPE(FitCoeff_3D_type), INTENT(IN) :: self
540  INTEGER :: i, j
541  WRITE(*,'(1x,"FitCoeff 3D OBJECT")')
542  ! Release/version info
543  WRITE(*,'(3x,"Release.Version : ",i0,".",i0)') self%Release, self%Version
544  ! Dimensions
545  WRITE(*,'(3x,"Dimensions : ",10(i5,:))') self%Dimensions
546  IF ( .NOT. fitcoeff_3d_associated(self) ) RETURN
547  ! Coefficient data
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)
554  END DO
555  END DO
556  END SUBROUTINE fitcoeff_3d_inspect
557 
558 
559 !----------------------------------------------------------------------------------
560 !:sdoc+:
561 !
562 ! NAME:
563 ! FitCoeff_ValidRelease
564 !
565 ! PURPOSE:
566 ! Function to check the FitCoeff Release value.
567 !
568 ! CALLING SEQUENCE:
569 ! IsValid = FitCoeff_ValidRelease( FitCoeff )
570 !
571 ! INPUTS:
572 ! FitCoeff: FitCoeff object for which the Release component
573 ! is to be checked.
574 ! UNITS: N/A
575 ! TYPE: Any FitCoeff type
576 ! DIMENSION: Scalar
577 ! ATTRIBUTES: INTENT(IN)
578 !
579 ! FUNCTION RESULT:
580 ! IsValid: Logical value defining the release validity.
581 ! UNITS: N/A
582 ! TYPE: LOGICAL
583 ! DIMENSION: Scalar
584 !
585 !:sdoc-:
586 !----------------------------------------------------------------------------------
587 
588  FUNCTION validrelease( Release ) RESULT( IsValid )
589  ! Arguments
590  INTEGER, INTENT(IN) :: release
591  ! Function result
592  LOGICAL :: isvalid
593  ! Local parameters
594  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_ValidRelease'
595  ! Local variables
596  CHARACTER(ML) :: msg
597 
598  ! Set up
599  isvalid = .true.
600 
601  ! Check release is not too old
602  IF ( release < fitcoeff_release ) THEN
603  isvalid = .false.
604  WRITE( msg,'("A FitCoeff data update is needed. ", &
605  &"FitCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
606  release, fitcoeff_release
607  CALL display_message( routine_name, msg, information ); RETURN
608  END IF
609 
610  ! Check release is not too new
611  IF ( release > fitcoeff_release ) THEN
612  isvalid = .false.
613  WRITE( msg,'("A FitCoeff software update is needed. ", &
614  &"FitCoeff release is ",i0,". Valid release is ",i0,"." )' ) &
615  release, fitcoeff_release
616  CALL display_message( routine_name, msg, information ); RETURN
617  END IF
618  END FUNCTION validrelease
619 
620 
621  FUNCTION fitcoeff_1d_validrelease( self ) RESULT( IsValid )
622  TYPE(fitcoeff_1d_type), INTENT(IN) :: self
623  LOGICAL :: isvalid
624  isvalid = validrelease( self%Release )
625  END FUNCTION fitcoeff_1d_validrelease
626 
627 
628  FUNCTION fitcoeff_2d_validrelease( self ) RESULT( IsValid )
629  TYPE(fitcoeff_2d_type), INTENT(IN) :: self
630  LOGICAL :: isvalid
631  isvalid = validrelease( self%Release )
632  END FUNCTION fitcoeff_2d_validrelease
633 
634 
635  FUNCTION fitcoeff_3d_validrelease( self ) RESULT( IsValid )
636  TYPE(fitcoeff_3d_type), INTENT(IN) :: self
637  LOGICAL :: isvalid
638  isvalid = validrelease( self%Release )
639  END FUNCTION fitcoeff_3d_validrelease
640 
641 
642 !--------------------------------------------------------------------------------
643 !:sdoc+:
644 !
645 ! NAME:
646 ! FitCoeff_Info
647 !
648 ! PURPOSE:
649 ! Subroutine to return a string containing version and dimension
650 ! information about a FitCoeff object.
651 !
652 ! CALLING SEQUENCE:
653 ! CALL FitCoeff_Info( FitCoeff, Info )
654 !
655 ! OBJECTS:
656 ! FitCoeff: FitCoeff object about which info is required.
657 ! UNITS: N/A
658 ! TYPE: Any FitCoeff type
659 ! DIMENSION: Scalar
660 ! ATTRIBUTES: INTENT(IN)
661 !
662 ! OUTPUTS:
663 ! Info: String containing version and dimension information
664 ! about the FitCoeff object.
665 ! UNITS: N/A
666 ! TYPE: CHARACTER(*)
667 ! DIMENSION: Scalar
668 ! ATTRIBUTES: INTENT(OUT)
669 !
670 !:sdoc-:
671 !--------------------------------------------------------------------------------
672 
673  SUBROUTINE fitcoeff_1d_info( self, Info )
674  ! Arguments
675  TYPE(FitCoeff_1D_type), INTENT(IN) :: self
676  include 'FitCoeff_Info.inc'
677  END SUBROUTINE fitcoeff_1d_info
678 
679 
680  SUBROUTINE fitcoeff_2d_info( self, Info )
681  ! Arguments
682  TYPE(FitCoeff_2D_type), INTENT(IN) :: self
683  include 'FitCoeff_Info.inc'
684  END SUBROUTINE fitcoeff_2d_info
685 
686 
687  SUBROUTINE fitcoeff_3d_info( self, Info )
688  ! Arguments
689  TYPE(FitCoeff_3D_type), INTENT(IN) :: self
690  include 'FitCoeff_Info.inc'
691  END SUBROUTINE fitcoeff_3d_info
692 
693 
694 !--------------------------------------------------------------------------------
695 !:sdoc+:
696 !
697 ! NAME:
698 ! FitCoeff_DefineVersion
699 !
700 ! PURPOSE:
701 ! Subroutine to return the module version information.
702 !
703 ! CALLING SEQUENCE:
704 ! CALL FitCoeff_DefineVersion( Id )
705 !
706 ! OUTPUTS:
707 ! Id: Character string containing the version Id information
708 ! for the module.
709 ! UNITS: N/A
710 ! TYPE: CHARACTER(*)
711 ! DIMENSION: Scalar
712 ! ATTRIBUTES: INTENT(OUT)
713 !
714 !:sdoc-:
715 !--------------------------------------------------------------------------------
716 
717  SUBROUTINE fitcoeff_defineversion( Id )
718  CHARACTER(*), INTENT(OUT) :: id
719  id = module_version_id
720  END SUBROUTINE fitcoeff_defineversion
721 
722 
723 !------------------------------------------------------------------------------
724 !:sdoc+:
725 !
726 ! NAME:
727 ! FitCoeff_InquireFile
728 !
729 ! PURPOSE:
730 ! Function to inquire FitCoeff object files.
731 !
732 ! CALLING SEQUENCE:
733 ! Error_Status = FitCoeff_InquireFile( &
734 ! Filename , &
735 ! n_Dimensions = n_Dimensions, &
736 ! Dimensions = Dimensions , &
737 ! Release = Release , &
738 ! Version = Version , &
739 ! Title = Title , &
740 ! History = History , &
741 ! Comment = Comment )
742 !
743 ! INPUTS:
744 ! Filename: Character string specifying the name of the
745 ! data file to inquire.
746 ! UNITS: N/A
747 ! TYPE: CHARACTER(*)
748 ! DIMENSION: Scalar
749 ! ATTRIBUTES: INTENT(IN)
750 !
751 ! OPTIONAL OUTPUTS:
752 ! n_Dimensions: The rank of the coefficient data array.
753 ! UNITS: N/A
754 ! TYPE: INTEGER
755 ! DIMENSION: Scalar
756 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
757 !
758 ! Dimensions: The dimension values of the coefficient data array.
759 ! UNITS: N/A
760 ! TYPE: INTEGER
761 ! DIMENSION: Rank-1
762 ! ATTRIBUTES: INTENT(OUT), OPTIONAL, ALLOCATABLE
763 !
764 ! Release: The data/file release number. Used to check
765 ! for data/software mismatch.
766 ! UNITS: N/A
767 ! TYPE: INTEGER
768 ! DIMENSION: Scalar
769 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
770 !
771 ! Version: The data/file version number. Used for
772 ! purposes only in identifying the dataset for
773 ! a particular release.
774 ! UNITS: N/A
775 ! TYPE: INTEGER
776 ! DIMENSION: Scalar
777 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
778 !
779 ! Title: Character string containing a succinct description
780 ! of what is in the dataset.
781 ! UNITS: N/A
782 ! TYPE: CHARACTER(*)
783 ! DIMENSION: Scalar
784 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
785 !
786 ! History: Character string containing dataset creation
787 ! history.
788 ! UNITS: N/A
789 ! TYPE: CHARACTER(*)
790 ! DIMENSION: Scalar
791 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
792 !
793 ! Comment: Character string containing any comments about
794 ! the dataset.
795 ! UNITS: N/A
796 ! TYPE: CHARACTER(*)
797 ! DIMENSION: Scalar
798 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
799 !
800 ! FUNCTION RESULT:
801 ! Error_Status: The return value is an integer defining the error
802 ! status. The error codes are defined in the
803 ! Message_Handler module.
804 ! If == SUCCESS the file inquire was successful
805 ! == FAILURE an unrecoverable error occurred.
806 ! UNITS: N/A
807 ! TYPE: INTEGER
808 ! DIMENSION: Scalar
809 !
810 !:sdoc-:
811 !------------------------------------------------------------------------------
812 
813  FUNCTION fitcoeff_inquirefile( &
814  Filename , & ! Input
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
821  Comment ) & ! Optional output
822  result( err_stat )
823  ! Arguments
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
832  ! Function result
833  INTEGER :: err_stat
834  ! Function parameters
835  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_InquireFile'
836  ! Function variables
837  CHARACTER(ML) :: msg
838  CHARACTER(ML) :: io_msg
839  INTEGER :: io_stat
840  INTEGER :: alloc_stat
841  INTEGER :: fid
842  INTEGER :: rel
843  INTEGER :: ver
844  INTEGER :: n_dims
845  INTEGER :: dims(fitcoeff_max_n_dimensions)
846 
847  ! Setup
848  err_stat = success
849  ! ...Check that the file exists
850  IF ( .NOT. file_exists( filename ) ) THEN
851  msg = 'File '//trim(filename)//' not found.'
852  CALL inquire_cleanup(); RETURN
853  END IF
854 
855 
856  ! Open the file
857  err_stat = open_binary_file( filename, fid )
858  IF ( err_stat /= success ) THEN
859  msg = 'Error opening '//trim(filename)
860  CALL inquire_cleanup(); RETURN
861  END IF
862 
863 
864  ! Read the release and version
865  READ( fid, iostat=io_stat, iomsg=io_msg ) &
866  rel, &
867  ver
868  IF ( io_stat /= 0 ) THEN
869  msg = 'Error reading Release/Version - '//trim(io_msg)
870  CALL inquire_cleanup(); RETURN
871  END IF
872  IF ( .NOT. validrelease( rel ) ) THEN
873  msg = 'FitCoeff Release check failed.'
874  CALL inquire_cleanup(); RETURN
875  END IF
876 
877 
878  ! Read the dimension data
879  ! ...The number of dimensions
880  READ( fid, iostat=io_stat, iomsg=io_msg ) &
881  n_dims
882  IF ( io_stat /= 0 ) THEN
883  msg = 'Error reading number of dimensions from '//trim(filename)//' - '//trim(io_msg)
884  CALL inquire_cleanup(); RETURN
885  END IF
886  ! ...Check the value
887  IF ( n_dims > fitcoeff_max_n_dimensions ) THEN
888  WRITE( msg,'("Number of dimensions (",i0,") in ",a," is greater than maximum allowed (",i0,")")' ) &
889  n_dims, trim(filename), fitcoeff_max_n_dimensions
890  CALL inquire_cleanup(); RETURN
891  END IF
892  ! ...The dimension values
893  READ( fid, iostat=io_stat, iomsg=io_msg ) &
894  dims(1:n_dims)
895  IF ( io_stat /= 0 ) THEN
896  msg = 'Error reading dimension values from '//trim(filename)//' - '//trim(io_msg)
897  CALL inquire_cleanup(); RETURN
898  END IF
899 
900 
901  ! Read the global attributes
902  err_stat = readgatts_binary_file( &
903  fid, &
904  title = title , &
905  history = history, &
906  comment = comment )
907  IF ( err_stat /= success ) THEN
908  msg = 'Error reading global attributes'
909  CALL inquire_cleanup(); RETURN
910  END IF
911 
912 
913  ! Close the file
914  CLOSE( fid, iostat=io_stat, iomsg=io_msg )
915  IF ( io_stat /= 0 ) THEN
916  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
917  CALL inquire_cleanup(); RETURN
918  END IF
919 
920 
921  ! Assign the return arguments
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
929  CALL inquire_cleanup(); RETURN
930  END IF
931  dimensions = dims(1:n_dims)
932  END IF
933 
934  CONTAINS
935 
936  SUBROUTINE inquire_cleanup()
937  ! Close file if necessary
938  IF ( file_open(fid) ) THEN
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)
942  END IF
943  ! Set error status and print error message
944  err_stat = failure
945  CALL display_message( routine_name, msg, err_stat )
946  END SUBROUTINE inquire_cleanup
947 
948  END FUNCTION fitcoeff_inquirefile
949 
950 
951 !--------------------------------------------------------------------------------
952 !:sdoc+:
953 !
954 ! NAME:
955 ! FitCoeff_ReadFile
956 !
957 ! PURPOSE:
958 ! Function to read FitCoeff object files.
959 !
960 ! CALLING SEQUENCE:
961 ! Error_Status = FitCoeff_ReadFile( &
962 ! FitCoeff , &
963 ! Filename , &
964 ! No_Close = No_Close, &
965 ! Quiet = Quiet , &
966 ! Title = Title , &
967 ! History = History , &
968 ! Comment = Comment )
969 !
970 ! OBJECTS:
971 ! FitCoeff: FitCoeff object containing the data read from file.
972 ! While any FitCoeff data type can be used, the rank
973 ! of the data in the file must correspond to the
974 ! datatype.
975 ! UNITS: N/A
976 ! TYPE: Any FitCoeff type
977 ! DIMENSION: Scalar
978 ! ATTRIBUTES: INTENT(OUT)
979 !
980 ! INPUTS:
981 ! Filename: Character string specifying the name of a
982 ! FitCoeff data file to read.
983 ! UNITS: N/A
984 ! TYPE: CHARACTER(*)
985 ! DIMENSION: Scalar
986 ! ATTRIBUTES: INTENT(IN)
987 !
988 ! OPTIONAL INPUTS:
989 ! No_Close: Set this logical argument to *NOT* close the datafile
990 ! upon exiting this routine. This option is required if
991 ! the FitCoeff data is embedded within another file.
992 ! If == .FALSE., File is closed upon function exit [DEFAULT].
993 ! == .TRUE., File is NOT closed upon function exit
994 ! If not specified, default is .FALSE.
995 ! UNITS: N/A
996 ! TYPE: LOGICAL
997 ! DIMENSION: Scalar
998 ! ATTRIBUTES: INTENT(IN), OPTIONAL
999 !
1000 ! Quiet: Set this logical argument to suppress INFORMATION
1001 ! messages being printed to stdout
1002 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
1003 ! == .TRUE., INFORMATION messages are SUPPRESSED.
1004 ! If not specified, default is .FALSE.
1005 ! UNITS: N/A
1006 ! TYPE: LOGICAL
1007 ! DIMENSION: Scalar
1008 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1009 !
1010 ! OPTIONAL OUTPUTS:
1011 ! Title: Character string containing a succinct description
1012 ! of what is in the dataset.
1013 ! UNITS: N/A
1014 ! TYPE: CHARACTER(*)
1015 ! DIMENSION: Scalar
1016 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
1017 !
1018 ! History: Character string containing dataset creation
1019 ! history.
1020 ! UNITS: N/A
1021 ! TYPE: CHARACTER(*)
1022 ! DIMENSION: Scalar
1023 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
1024 !
1025 ! Comment: Character string containing any comments about
1026 ! the dataset.
1027 ! UNITS: N/A
1028 ! TYPE: CHARACTER(*)
1029 ! DIMENSION: Scalar
1030 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
1031 !
1032 ! FUNCTION RESULT:
1033 ! Error_Status: The return value is an integer defining the error status.
1034 ! The error codes are defined in the Message_Handler module.
1035 ! If == SUCCESS, the file read was successful
1036 ! == FAILURE, an unrecoverable error occurred.
1037 ! UNITS: N/A
1038 ! TYPE: INTEGER
1039 ! DIMENSION: Scalar
1040 !
1041 !:sdoc-:
1042 !------------------------------------------------------------------------------
1043 
1044  FUNCTION fitcoeff_1d_readfile( &
1045  FitCoeff, & ! Output
1046  Filename, & ! Input
1047  No_Close, & ! Optional input
1048  Quiet , & ! Optional input
1049  Title , & ! Optional output
1050  History , & ! Optional output
1051  Comment , & ! Optional output
1052  Debug ) & ! Optional input (Debug output control)
1053  result( err_stat )
1054  ! Arguments
1055  TYPE(fitcoeff_1d_type), INTENT(OUT) :: fitcoeff
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
1063  ! Function result
1064  INTEGER :: err_stat
1065  ! Function parameters
1066  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_ReadFile'
1067  ! Function variables
1068  TYPE(fitcoeff_1d_type) :: dummy
1069  ! Insert common code
1070  include 'FitCoeff_ReadFile.inc'
1071  END FUNCTION fitcoeff_1d_readfile
1072 
1073 
1074  FUNCTION fitcoeff_2d_readfile( &
1075  FitCoeff, & ! Output
1076  Filename, & ! Input
1077  No_Close, & ! Optional input
1078  Quiet , & ! Optional input
1079  Title , & ! Optional output
1080  History , & ! Optional output
1081  Comment , & ! Optional output
1082  Debug ) & ! Optional input (Debug output control)
1083  result( err_stat )
1084  ! Arguments
1085  TYPE(fitcoeff_2d_type), INTENT(OUT) :: fitcoeff
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
1093  ! Function result
1094  INTEGER :: err_stat
1095  ! Function parameters
1096  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_ReadFile'
1097  ! Function variables
1098  TYPE(fitcoeff_2d_type) :: dummy
1099  ! Insert common code
1100  include 'FitCoeff_ReadFile.inc'
1101  END FUNCTION fitcoeff_2d_readfile
1102 
1103 
1104  FUNCTION fitcoeff_3d_readfile( &
1105  FitCoeff, & ! Output
1106  Filename, & ! Input
1107  No_Close, & ! Optional input
1108  Quiet , & ! Optional input
1109  Title , & ! Optional output
1110  History , & ! Optional output
1111  Comment , & ! Optional output
1112  Debug ) & ! Optional input (Debug output control)
1113  result( err_stat )
1114  ! Arguments
1115  TYPE(fitcoeff_3d_type), INTENT(OUT) :: fitcoeff
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
1123  ! Function result
1124  INTEGER :: err_stat
1125  ! Function parameters
1126  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_ReadFile'
1127  ! Function variables
1128  TYPE(fitcoeff_3d_type) :: dummy
1129  ! Insert common code
1130  include 'FitCoeff_ReadFile.inc'
1131  END FUNCTION fitcoeff_3d_readfile
1132 
1133 
1134 !--------------------------------------------------------------------------------
1135 !:sdoc+:
1136 !
1137 ! NAME:
1138 ! FitCoeff_WriteFile
1139 !
1140 ! PURPOSE:
1141 ! Function to write FitCoeff object files.
1142 !
1143 ! CALLING SEQUENCE:
1144 ! Error_Status = FitCoeff_WriteFile( &
1145 ! FitCoeff , &
1146 ! Filename , &
1147 ! No_Close = No_Close, &
1148 ! Quiet = Quiet , &
1149 ! Title = Title , &
1150 ! History = History , &
1151 ! Comment = Comment )
1152 !
1153 ! OBJECTS:
1154 ! FitCoeff: FitCoeff object containing the data to write to file.
1155 ! UNITS: N/A
1156 ! TYPE: FitCoeff_type
1157 ! DIMENSION: Scalar
1158 ! ATTRIBUTES: INTENT(IN)
1159 !
1160 ! INPUTS:
1161 ! Filename: Character string specifying the name of a
1162 ! FitCoeff format data file to write.
1163 ! UNITS: N/A
1164 ! TYPE: CHARACTER(*)
1165 ! DIMENSION: Scalar
1166 ! ATTRIBUTES: INTENT(IN)
1167 !
1168 ! OPTIONAL INPUTS:
1169 ! No_Close: Set this logical argument to *NOT* close the datafile
1170 ! upon exiting this routine. This option is required if
1171 ! the FitCoeff data is to be embedded within another file.
1172 ! If == .FALSE., File is closed upon function exit [DEFAULT].
1173 ! == .TRUE., File is NOT closed upon function exit
1174 ! If not specified, default is .FALSE.
1175 ! UNITS: N/A
1176 ! TYPE: LOGICAL
1177 ! DIMENSION: Scalar
1178 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1179 !
1180 ! Quiet: Set this logical argument to suppress INFORMATION
1181 ! messages being printed to stdout
1182 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
1183 ! == .TRUE., INFORMATION messages are SUPPRESSED.
1184 ! If not specified, default is .FALSE.
1185 ! UNITS: N/A
1186 ! TYPE: LOGICAL
1187 ! DIMENSION: Scalar
1188 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1189 !
1190 ! Title: Character string containing a succinct description
1191 ! of what is in the dataset.
1192 ! UNITS: N/A
1193 ! TYPE: CHARACTER(*)
1194 ! DIMENSION: Scalar
1195 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1196 !
1197 ! History: Character string containing dataset creation
1198 ! history.
1199 ! UNITS: N/A
1200 ! TYPE: CHARACTER(*)
1201 ! DIMENSION: Scalar
1202 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1203 !
1204 ! Comment: Character string containing any comments about
1205 ! the dataset.
1206 ! UNITS: N/A
1207 ! TYPE: CHARACTER(*)
1208 ! DIMENSION: Scalar
1209 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1210 !
1211 ! FUNCTION RESULT:
1212 ! Error_Status: The return value is an integer defining the error status.
1213 ! The error codes are defined in the Message_Handler module.
1214 ! If == SUCCESS, the file write was successful
1215 ! == FAILURE, an unrecoverable error occurred.
1216 ! UNITS: N/A
1217 ! TYPE: INTEGER
1218 ! DIMENSION: Scalar
1219 !
1220 !:sdoc-:
1221 !------------------------------------------------------------------------------
1222 
1223  FUNCTION fitcoeff_1d_writefile( &
1224  FitCoeff, & ! Input
1225  Filename, & ! Input
1226  No_Close, & ! Optional input
1227  Quiet , & ! Optional input
1228  Title , & ! Optional input
1229  History , & ! Optional input
1230  Comment , & ! Optional input
1231  Debug ) & ! Optional input (Debug output control)
1232  result( err_stat )
1233  ! Arguments
1234  TYPE(fitcoeff_1d_type), INTENT(IN) :: fitcoeff
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
1242  ! Function result
1243  INTEGER :: err_stat
1244  ! Function parameters
1245  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_WriteFile'
1246  ! Insert common code
1247  include 'FitCoeff_WriteFile.inc'
1248  END FUNCTION fitcoeff_1d_writefile
1249 
1250 
1251  FUNCTION fitcoeff_2d_writefile( &
1252  FitCoeff, & ! Input
1253  Filename, & ! Input
1254  No_Close, & ! Optional input
1255  Quiet , & ! Optional input
1256  Title , & ! Optional input
1257  History , & ! Optional input
1258  Comment , & ! Optional input
1259  Debug ) & ! Optional input (Debug output control)
1260  result( err_stat )
1261  ! Arguments
1262  TYPE(fitcoeff_2d_type), INTENT(IN) :: fitcoeff
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
1270  ! Function result
1271  INTEGER :: err_stat
1272  ! Function parameters
1273  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_WriteFile'
1274  ! Insert common code
1275  include 'FitCoeff_WriteFile.inc'
1276  END FUNCTION fitcoeff_2d_writefile
1277 
1278 
1279  FUNCTION fitcoeff_3d_writefile( &
1280  FitCoeff, & ! Input
1281  Filename, & ! Input
1282  No_Close, & ! Optional input
1283  Quiet , & ! Optional input
1284  Title , & ! Optional input
1285  History , & ! Optional input
1286  Comment , & ! Optional input
1287  Debug ) & ! Optional input (Debug output control)
1288  result( err_stat )
1289  ! Arguments
1290  TYPE(fitcoeff_3d_type), INTENT(IN) :: fitcoeff
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
1298  ! Function result
1299  INTEGER :: err_stat
1300  ! Function parameters
1301  CHARACTER(*), PARAMETER :: routine_name = 'FitCoeff_WriteFile'
1302  ! Insert common code
1303  include 'FitCoeff_WriteFile.inc'
1304  END FUNCTION fitcoeff_3d_writefile
1305 
1306 
1307 !################################################################################
1308 !################################################################################
1309 !## ##
1310 !## ## PRIVATE PROCEDURES ## ##
1311 !## ##
1312 !################################################################################
1313 !################################################################################
1314 
1315 !--------------------------------------------------------------------------------
1316 !
1317 ! NAME:
1318 ! FitCoeff_Equal
1319 !
1320 ! PURPOSE:
1321 ! Pure function to test the equality of two FitCoeff objects.
1322 ! Used in OPERATOR(==) interface block.
1323 !
1324 ! CALLING SEQUENCE:
1325 ! is_equal = FitCoeff_Equal( x, y )
1326 !
1327 ! or
1328 !
1329 ! IF ( x == y ) THEN
1330 ! ...
1331 ! END IF
1332 !
1333 ! OBJECTS:
1334 ! x, y: Two FitCoeff objects to be compared.
1335 ! UNITS: N/A
1336 ! TYPE: Any FitCoeff type
1337 ! DIMENSION: Scalar or any rank
1338 ! ATTRIBUTES: INTENT(IN)
1339 !
1340 ! FUNCTION RESULT:
1341 ! is_equal: Logical value indicating whether the inputs are equal.
1342 ! UNITS: N/A
1343 ! TYPE: LOGICAL
1344 ! DIMENSION: Same as inputs.
1345 !
1346 !--------------------------------------------------------------------------------
1347 
1348  PURE FUNCTION fitcoeff_1d_equal( x, y ) RESULT( is_equal )
1349  TYPE(fitcoeff_1d_type), INTENT(IN) :: x, y
1350  include 'FitCoeff_Equal.inc'
1351  END FUNCTION fitcoeff_1d_equal
1352 
1353 
1354  PURE FUNCTION fitcoeff_2d_equal( x, y ) RESULT( is_equal )
1355  TYPE(fitcoeff_2d_type), INTENT(IN) :: x, y
1356  include 'FitCoeff_Equal.inc'
1357  END FUNCTION fitcoeff_2d_equal
1358 
1359 
1360  PURE FUNCTION fitcoeff_3d_equal( x, y ) RESULT( is_equal )
1361  TYPE(fitcoeff_3d_type), INTENT(IN) :: x, y
1362  include 'FitCoeff_Equal.inc'
1363  END FUNCTION fitcoeff_3d_equal
1364 
1365 END MODULE fitcoeff_define
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, parameter sl
integer function fitcoeff_3d_readfile(FitCoeff, Filename, No_Close, Quiet, Title, History, Comment, Debug)
real(fp), parameter, public zero
integer, parameter, public long
Definition: Type_Kinds.f90:76
integer, parameter, public fp
Definition: Type_Kinds.f90:124
pure function fitcoeff_1d_equal(x, y)
integer, parameter ml
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
Definition: Type_Kinds.f90:106
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