Difference between revisions of "Libclasses"
Line 572: | Line 572: | ||
enddo | enddo | ||
endif | endif | ||
− | + | <pre> | |
+ | finally the result object is defined as valid and all operations have been successful | ||
+ | </pre> | ||
+ | call IXFmark_valid(wres) | ||
end subroutine IXFplus_testclass</pre> | end subroutine IXFplus_testclass</pre> | ||
Latest revision as of 15:10, 16 May 2008
Introduction
IXTtestclass is an object which contains all the types of variables which exist in the framework, it also contains implementations of all the standard subroutines which MUST be included by any new module which is added to the framework. They are:
- IXFoperation_run_yourmodulename
- IXFcreate_yourmodulename
- IXFdestroy_yourmodulename
- IXFcheck_yourmodulename
- IXFset_yourmodulename
- IXFget_yourmodulename
- IXFget_alloc_yourmodulename
- IXFget_ptr_yourmodulename
In each of these routines there are particular ways of treating each different
type of variable, and the code in IXTtestclass can be used as a model for other modules, containing all the
standard code required. This documentation should be read in tandem with the libclasses\IXMtestclass.f90 file and the IXMtestclass doxygen documentation
Module Definition Start
A class should be defined as follows:
- A derived TYPE starting with the IXT prefix should be created in a module with the same name but prefixed IXM
- within this module various standard subroutines must be defined for class operations, as well as any other object methods
- the class object should generally be the first argument of any function
- module subroutines should make no explicit reference to matlab, they should be passed constructed objects
we start by defining the name of the module
module IXMtestclass
include the modules which are relied upon by the module
use IXMbase use IXMspectra use IXMdataset_2d
define the type, all component elements of the module are private and encapsulated as a rule, the type is public.
type IXTtestclass private
every object must contain an IXTbase class, it contains information such as the validity of an object
type(IXTbase) :: base
simple real and integer variables, can be defined as fixed length static arrays and initialised
real(dp) :: val integer(i4b) :: nx real(dp) :: val_static(3)=0.0 integer(i4b)::int_static(4)=0.0
variable length arrays are defined as pointers, they are always declared as NULL by default and can be allocated using the IXFalloc subroutines
real(dp), pointer :: val_array(:) => NULL() integer(i4b),pointer :: int_arr(:,:)=>NULL()
other objects can also be defined in a type
type(IXTspectra):: spectra
simple strings and logicals are straightforward
logical :: xhist=.FALSE. character(len=short_len) :: label='x-label'
variable length arrays of strings and objects cannot be defined as pointers and must be defined as allocatable, they can also be allocated using the appropriate IXFalloc subroutines
character(len=long_len),allocatable :: cell_string(:) type(IXTdataset_2d), allocatable :: d2d(:) end type IXTtestclass
include the interfaces required by routines declared in class_base.f90, this is covered in more detail in Preprocessing class_header.f90
#define IXD_TYPE testclass #include "class_header.f90"
non-standard interfaces are defined, as well as any private functions/subroutines, all subroutines/functions are public unless specified as private
interface IXFplus module procedure IXFplus_testclass end interface IXFplus
contains marks the start of the module subroutines, the first section includes the generic subroutines every class requires, this is covered in more detail in Preprocessing class_base.f90
contains #define IXD_DESCRIPTION "IXTtestclass class" #define IXD_TYPE testclass #define IXD_SQTYPE 'testclass' #include "class_base.f90"
IXFoperation_run_testclass
All classes must provide this operation; it loops through all members of the class doing the supplied operation, eg matlab_write, display etc..
There are three different types of IXFoperation_run call, with a standard argument call
- single value and static array elements and simple nested objects use IXFoperation_run
- pointer array elements IXFoperation_run_ptr
- allocatable type elements IXFoperation_run_alloc
this code should be used as a template with the appropriate IXFoperation_run call made for each member element, substituting appropriately for the name of the class and its member elements
recursive subroutine IXFoperation_run_testclass(op, field, arg, status) implicit none type(IXTtestclass) :: arg type(IXToperation) :: op type(IXTstatus) :: status character(len=*) :: field logical::cont_op call IXFoperationStart(op, 'IXTtestclass', field, status,arg%base,cont_op) if(.not. cont_op)return ! this order must match the declaration order in matlab as it is ! used when parsing argemnts passed in class creation with vargin call IXFoperation_run(op, 'base', arg%base, status) call IXFoperation_run(op, 'val', arg%val, status) call IXFoperation_run(op, 'nx', arg%nx, status) call IXFoperation_run(op, 'val_static', arg%val_static, status) call IXFoperation_run(op, 'int_static', arg%int_static, status) call IXFoperation_run_ptr(op, 'val_array', arg%val_array, status)!this is a pointer array so the ptr suffix is used call IXFoperation_run_ptr(op, 'int_arr', arg%int_arr, status)!this is a pointer array so the ptr suffix is used call IXFoperation_run(op, 'spectra', arg%spectra, status) call IXFoperation_run(op, 'xhist', arg%xhist, status) call IXFoperation_run(op, 'label', arg%label, status) call IXFoperation_run_alloc(op, 'cell_string', arg%cell_string, status) call IXFoperation_run_alloc(op, 'd2d', arg%d2d, status) call IXFoperationFinish(op, field, status) end subroutine IXFoperation_run_testclass
IXFcreate_testclass
- The IXFcreate subroutine STRICTLY takes all the elements required to define a class and creates the resulting object.
- If an element of the object is another class then it MUST be initialised.
- pointer array types are defined as assumed-shape arrays.
- Each element is defined with intent(in), allocatable elements are defined as assumed-shape arrays.
- Any nested objects need to be tested for validity
- The object to be created must be marked as valid before the IXFset subroutine is called
subroutine IXFcreate_testclass(arg, val, nx,val_static,int_static, val_array, int_arr,spectra, xhist,label, cell_string,d2d, status) implicit none type(IXTtestclass),intent(out) :: arg type(IXTstatus),intent(inout) :: status real(dp),intent(in) :: val integer(i4b),intent(in) :: nx real(dp),intent(in) :: val_static(3) integer(i4b),intent(in)::int_static(4) real(dp),intent(in) :: val_array(:) integer(i4b),intent(in) :: int_arr(:,:) type(IXTspectra),intent(in):: spectra logical,intent(in) :: xhist character(len=short_len),intent(in) :: label character(len=long_len),intent(in) :: cell_string(:) type(IXTdataset_2d),intent(in) :: d2d(:)
nested objects such as spectra and d2d must be tested for initialisation, this shows they have been created properly
if( IXFvalid(spectra) .neqv. .true.)then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_outofmem, 'IXTspectra failure, all nested objects MUST be initialised (IXFcreate_testclass)') endif if( IXFvalid(d2d) .neqv. .true.)then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_outofmem, 'IXTdataset_2d failure, all nested objects MUST be initialised (IXFcreate_testclass)') endif if(status == IXCseverity_error)return ! the set routine can ONLY be called on an initialised object ! so in this *special* case it is initialised before it is filled call IXFmark_valid(arg) call IXFset_testclass(arg,status,val, nx,val_static,int_static, val_array, int_arr,spectra, xhist,label, cell_string,d2d) end subroutine IXFcreate_testclass
IXFdestroy_testclass
The IXFdestroy routine deallocates any pointer arrays in the type, and calls the destroy function on any nested objects, it can also be used to set variables back to their default values. If one of the objects is an array of structures, then each structure will be recursively destroyed by the IXFdealloc function. The allocatable array of strings is a fortran type and so the IXFdeallocfortran subroutine must be called to deallocate its memory
subroutine IXFdestroy_testclass(arg, status) implicit none type(IXTtestclass),intent(inout) :: arg type(IXTstatus),intent(inout) :: status call IXFdestroy(arg%base,status) ! destroy pointer arrays call IXFdealloc(arg%val_array,status) call IXFdealloc(arg%int_arr,status) arg%xhist=.FALSE. ! for nested objects check it hasn't been destroyed already if(IXFvalid(arg%spectra))call IXFdestroy(arg%spectra,status) if(allocated(arg%cell_string))call IXFdeallocfortran(arg%cell_string,status) if(IXFvalid(arg%d2d))then if(allocated(arg%d2d))call IXFdealloc(arg%d2d,status) endif ! the initialised status is now revoked for the object ! this statement MUST exist in all destroy routines call IXFclear_valid(arg) end subroutine IXFdestroy_testclass
IXFcheck_testclass
IXFcheck will make internal consistency checks in the object, such as array length checking to make sure the object is properly filled.
subroutine IXFcheck_Testclass(arg, status) implicit none type(IXTtestclass),intent(in) ::arg type(IXTstatus),intent(inout) :: status if (size(arg%val_array) /= size(arg%int_arr,1)) then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_invparam, 'sizes of value and int arrays do not match(IXFcheck_testclass)') endif end subroutine IXFcheck_Testclass
IXFset_testclass
The IXFset operation can only be performed on a properly filled or initialised object.
- It takes an optional number of arguments to modify the object contents.
- A check is made at the end to determine that the edited object is correctly formed.
- Error flags are raised if there is any inconsistency.
- The optional arguments MUST always be specified by keywords, and declared as intent(in).
- The order of arguments should match the order of declaration, except for the IXTbase type which is not declared.
- The 'ref' argument is used to copy the values of a reference object to another. In this case the object being modified does not have to be initialised, but the reference object MUST be initialised.
recursive subroutine IXFset_testclass(arg, status, val, nx,val_static,int_static, val_array, int_arr,spectra, xhist,label, cell_string,d2d,ref) implicit none type(IXTtestclass),intent(inout) :: arg type(IXTstatus),intent(inout) :: status ! all the supplied variables are declared as optional with intent(in) type(IXTtestclass),intent(in),optional :: ref real(dp),optional,intent(in) :: val integer(i4b),optional,intent(in) :: nx real(dp),optional,intent(in) :: val_static(3) integer(i4b),optional,intent(in)::int_static(4) real(dp),optional,intent(in) :: val_array(:) integer(i4b),optional,intent(in) :: int_arr(:,:) type(IXTspectra),optional,intent(in):: spectra logical,optional,intent(in) :: xhist
input strings are treated as an unknown length, if the supplied string is longer than the declared length then it will be truncated. If it is shorter, then the new variable will be padded with spaces.
character(len=*),optional,intent(in) :: label character(len=*),optional,intent(in) :: cell_string(:) type(IXTdataset_2d),optional,intent(in) :: d2d(:)
check that either the reference object is initialised or that object to be modified is initialised
if(present(ref))then if (IXFvalid(ref) .neqv. .true.)then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_invparam, 'Reference object MUST be initialised (IXFset_testclass)') endif if(status == IXCseverity_error)return ! now initialise object to be modified, not necessary to check its value call IXFmark_valid(arg) else if(IXFvalid(arg) .neqv. .true.) then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_invparam, 'Set can only be called on an initialised object (IXFset_testclass)') endif if(status == IXCseverity_error)return endif
This command will copy all of the attributes of the reference object to the object being modified it calls set with all the components of the reference object
if (present(ref))call IXFset_testclass(arg,status,ref%val,ref%nx,ref%val_static,ref%int_static,ref%val_array, & ref%int_arr,ref%spectra,ref%xhist,ref%label,ref%cell_string,ref%d2d)
single variables are simply overwritten by the supplied variables
if (present(val))arg%val=val if (present(nx))arg%nx=nx
static arrays are simply copied, if the length of val_static is not 3, then the program will break at runtime, a check cannot be made for this
if (present(val_static)) arg%val_static=val_static if (present(int_static)) arg%int_static=int_static
IXFset_real_array and IXFset_integer_array are built in functions which reallocate the memory for the member element and fill with the new data as appropriate, they work on all pointer arrays up to 3d
call IXFset_real_array(arg%val_array,status,val_array) call IXFset_integer_array(arg%int_arr,status,int_arr)
nested objects are simply copied
if (present(spectra))call IXFcopy(spectra,arg%spectra,status)
logicals and strings are treated in the same way as single variables
if(present(xhist))arg%xhist=xhist if(present(label))arg%label=label
allocatable types must follow this format, including reallocation and population of the element, either by direct assignment or in the case of an object by an IXFcopy call
if (present(cell_string))then call IXFreallocFortran(arg%cell_string,size(cell_string),.false.,status) arg%cell_string=cell_string endif if(present(d2d))then call IXFrealloc(arg%d2d,size(d2d),.false.,status) call IXFcopy(d2d,arg%d2d,status) endif
the check routine MUST always be called at the end of the set routine
call IXFcheck(arg,status) end subroutine IXFset_testclass
IXFget_testclass
The IXFget subroutine will return elements of an object to an optional supplied arrays/variables.
- The supplied variables should be referrred to by keyword to avoid errors.
- The 'wout' variable is special and can be used to copy the contents of a whole object to a new one.
- all the supplied variables are declared as optional with intent(out)
- static arrays are expected to be the length of the member element
subroutine IXFget_testclass(arg,status, val, nx,val_static,int_static, val_array, int_arr,spectra, xhist,label, cell_string,d2d,wout) implicit none type(IXTtestclass),intent(in) :: arg type(IXTtestclass),optional,intent(out)::wout type(IXTstatus),intent(inout) :: status real(dp),optional,intent(out) :: val integer(i4b),optional,intent(out) :: nx real(dp),optional,intent(out) :: val_static(3) integer(i4b),optional,intent(out)::int_static(4) real(dp),optional,intent(out) :: val_array(:) integer(i4b),optional,intent(out) :: int_arr(:,:) type(IXTspectra),optional,intent(out):: spectra logical,optional,intent(out) :: xhist
input strings are treated as an unknown length, if the supplied string is longer than the declared length then it will be truncated. If it is shorter, then the new variable will be padded with spaces.
character(len=*),optional,intent(out) :: label character(len=*),optional,intent(out) :: cell_string(:) type(IXTdataset_2d),optional,intent(out) :: d2d(:)
a simple copy call is made for the wout argument
if (present(wout))then call IXFcopy(arg,wout,status) endif
single variables are copied into the supplied arrays
if (present(val))val=arg%val if (present(nx))nx=arg%nx
for variable length arrays the supplied array must be the same length as the object array. This test is made and the array filled by the built in subroutines IXFget_real_array and IXFget_integer_array.
call IXFget_real_array(arg%val_array,status,val_array) call IXFget_integer_array(arg%int_arr,status,int_arr)
checks are not made on static arrays, since the routine will break at runtime if a supplied array is not the same length as that declared
if (present(val_static))val_static=arg%val_static if (present(int_static))int_static=arg%int_static
supplied nested objects are filled with an appropriate IXFcopy subroutine
if(present(spectra))call IXFcopy(arg%spectra,spectra,status)
logicals and strings are treated as single variables, with strings being truncated where appropriate
if(present(xhist))xhist=arg%xhist if(present(label))label=arg%label
the arrays which are to contain the allocatable types are assumed to be of an appropriate length, if the length is unknown then the IXFget_alloc subroutine must be called instead
if (present(cell_string))cell_string=arg%cell_string if(present(d2d))call IXFcopy(arg%d2d,d2d,status) end subroutine IXFget_testclass
IXFget_alloc_testclass
IXFget_alloc can be called with all the same arguments as IXFget, but the pointer array elements/string array/object array elements can be allocatable arrays. The arrays are allocated to the appropriate length and IXFget is called underneath to populate them.
subroutine IXFget_alloc_testclass(arg,status, val, nx,val_static,int_static, val_array, int_arr,spectra, xhist,label, cell_string,d2d,wout) implicit none type(IXTtestclass),intent(in) :: arg type(IXTtestclass),intent(out),optional::wout real(dp),optional,intent(out) :: val integer(i4b),optional,intent(out) :: nx real(dp),optional,intent(out) :: val_static(3) integer(i4b),optional,intent(out)::int_static(4) !allocatable arrays cannot be defined as intent(out), this tends to make runtime errors for some reason real(dp),optional,allocatable :: val_array(:) integer(i4b),optional,allocatable :: int_arr(:,:) type(IXTspectra),optional,intent(out):: spectra logical,optional,intent(out) :: xhist
input strings are treated as an unknown length, if the supplied string is longer than the declared length then it will be truncated. If it is shorter, then the new variable will be padded with spaces.
character(len=*),optional,intent(out) :: label
allocatable arrays cannot be defined as intent(out), this tends to make runtime errors for some reason
character(len=*),allocatable,optional :: cell_string(:) type(IXTdataset_2d),allocatable,optional :: d2d(:) type(IXTstatus),intent(inout)::status
The length of the static arrays are straightforward to set, the variable length arrays are inspected using size and shape, and allocated accordingly
if(present(val_static))then call IXFreallocfortran(val_static,3,.false.,status) endif if(present(int_static))then call IXFreallocfortran(int_static,4,.false.,status) endif if (present(val_array))then call IXFreallocdimsFortran(val_array,shape(arg%val_array),.false.,status) endif if (present(int_arr))then call IXFreallocdimsFortran(int_arr,shape(arg%int_arr),.false.,status) endif if (present(cell_string))then call IXFreallocdimsFortran(cell_string,(/ size(arg%cell_string) /),.false.,status) endif if(present(d2d))then call IXFrealloc(d2d,size(arg%d2d),.false.,status) endif
the standard IXFget routine is then called which is expecting arrays of appropriate length to fill
call IXFget_testclass(arg,status, val, nx,val_static,int_static, val_array, int_arr,spectra, xhist,label, cell_string,d2d,wout) end subroutine IXFget_alloc_testclass
IXFget_ptr_testclass
IXFget_ptr will return a pointer to a structure or an array in an object, from an optional argument.
- The keyword arguments are the same name as the object elements to retrieve pointers to
- EXTREME Care must be taken since if the pointers are edited, then the data in the structure will also be edited.
subroutine IXFget_ptr_testclass(arg,val_array,int_arr,spectra) implicit none type(IXTtestclass),intent(in),target :: arg type(IXTspectra),optional,pointer::spectra real(dp),optional,pointer::val_array(:) integer(i4b),optional,pointer:: int_arr(:,:) if (present(spectra))spectra=>arg%spectra if (present(val_array))val_array=>arg%val_array if (present(int_arr))int_arr=>arg%int_arr end subroutine IXFget_ptr_testclass
Example object method
This is an example plus operation for the IXTtestclass object
subroutine IXFplus_testclass(wres, w1, w2,array, status)
result objects are generally declared as intent(out)
type(IXTtestclass),intent(out):: wres type(IXTtestclass),intent(in) :: w1, w2 real(dp),intent(in)::array(:) type(IXTstatus),intent(inout) :: status integer(i4b)::i,len1,len2
static and singular values can be added without any checks or allocation of memory
wres%val = w1%val + w2%val wres%nx = w1%nx + w2%nx wres%val_static=w1%val_static+w2%val_static wres%int_static=w1%int_static+w2%int_static
allocation of the result pointer arrays
call IXFalloc(wres%val_array, size(w1%val_array), status) call IXFallocdims(wres%int_arr, shape(w1%int_arr) , status)
before combining the pointer arrays we need to check if they can be safely combined, ie by checking their shapes are the same. in this example there are no errors to calculate, and a simple addition can be performed. if there are error functions to be determined the standard array operations can be called for standard manipulations (plus/subtract/multiply/divide/power), these are defined in the IXMarraymanips module
if (sum(abs(shape(w1%val_array) - shape(w2%val_array)))/=0 ) then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_invparam, 'val_array elements not commensurate in operation (IXFplus_testclass)') return endif if (sum(abs(shape(w1%int_arr) - shape(w2%int_arr)))/=0 ) then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_invparam, 'int_arr elements not commensurate in operation (IXFplus_testclass)') return endif wres%int_arr= w1%int_arr + w2%int_arr if(size(w1%val_array) /= size(array))then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_invparam, 'array not commensurate with val_array (IXFplus_testclass)') return else wres%val_array = w1%val_array + w2%val_array + array endif
no sensible combination of spectra objects, so take the left hand side one for example, the same with logicals , and append the strings together
call IXFcopy(w1%spectra,wres%spectra,status) wres%xhist=.true. wres%label=trim(adjustl(w1%label))//' '//trim(adjustl(w2%label))
a simple combination of arrays of strings
len1=size(w1%cell_string) len2=size(w2%cell_string) call IXFallocfortran(wres%cell_string,(len1+len2),status) do i=1,len1 wres%cell_string(i)=w1%cell_string(i) enddo do i=len1+1,len1+len2 wres%cell_string(i)=w2%cell_string(i-len1) enddo
standard manipulation of dataset_2d objects, with checking of length
if(size(w1%d2d) /= size(w2%d2d))then call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, & IXCerr_outofmem, 'd2d failure in operation (IXFplus_testclass)') return else call IXFalloc(wres%d2d,size(w1%d2d),status) do i=1,size(w1%d2d) call IXFplus(wres%d2d(i),w1%d2d(i),w2%d2d(i),status) enddo endif <pre> finally the result object is defined as valid and all operations have been successful
call IXFmark_valid(wres)
end subroutine IXFplus_testclass
Module Definition End
When all the required object methods have been defined below the contains statement, the last line in the file is to end the module
end module IXMtestclass
Preprocessing files
A number of the standard interfaces required by each module are the same, and only differ in construction with the type of object whose method is being interfaced. For example in creation of the IXFcreate interface for the IXTdataset_2d and IXTtestclass object the construction will be as follows:
in the file libclasses\IXMtestclass.f90
interface IXFcreate module procedure IXFcreate_testclass end interface
in the file libclasses\IXMdataset_2d.f90
interface IXFcreate module procedure IXFcreate_dataset_2d end interface
in order to save time and not require explicit declaration of all the interfaces required in each object we can use the preprocessor instead
Preprocessing class_header.f90
in the examples above we can see that there is very little difference between the two interfaces. a preprocessor takes a file containing some common code and keyword/keywords which can be substituted for an appropriately defined variable to make full fortran. this code is then included in the file to be compiled.
the code below is present in libclasses\IXMtestclass.f90, the #define statement defines the keyword IXD_TYPE to be substituted for the string testclass when the preprocessor includes the file class_header.f90.
#define IXD_TYPE testclass #include "class_header.f90"
in the file class_header.f90 we have the following lines
#if defined(IXD_TYPE) interface IXFcreate module procedure IXFcreate_&/**/ &IXD_TYPE end interface IXFcreate #undef IXD_TYPE #endif
it is easy to see that if the keyword IXD_TYPE is substituted for testclass, then the IXFcreate interface can be automatically defined for any object. a preprocessor also needs to be told when to substitute a keyword, so we have a typical construction in the include file:
#if defined (KEYWORD) some code containing the KEYWORD to substitute with another string #undef KEYWORD #endif
it is possible to preprocess lots of code in one large #if defined(KEYWORD) loop, at the end of the loop we need to clean up and undefine the keyword with the following statement #undef KEYWORD.
a preprocessor will only substitute discrete keywords, so we cannot include the line:
module procedure IXFcreate_IXD_TYPE
we therefore have to use the line continuation markers (&) to trick the preprocessor into substituting the keyword properly to make compilable fortran code. the C style comments present (/**/) are an artefact of inconsistencies between the intel fortran preprocessor on windows and linux.
Preprocessing class_base.f90
sometimes the standard object methods differ only very slightly, and to ensure that the code for these methods is the same in every respect, we can use the preprocessor. In the example above the IXFcreate algorithm must be defined explicitly in the module since it involves the use of individual object elements. But there are some standard subroutines which can be generalised. These subroutines are defined in class_base.f90, and are included in the method section of the module with the following statement, where two keywords are defined IXD_TYPE and IXD_SQTYPE
#define IXD_TYPE testclass #define IXD_SQTYPE 'testclass' #include "class_header.f90"
these keywords are then substituted in the code contained in the include file class_base.f90. In the example below the general subroutine to allocate arrays of objects (implements the IXFalloc interface) is defined using two separate keywords and some general code.
The following code will only be preprocessed if both keywords are defined.
#if defined(IXD_TYPE) && defined(IXD_SQTYPE)
the keyword is used here to construct the declaration statement of the subroutine
subroutine IXFalloc_&/**/ &IXD_TYPE (dt, n, status) implicit none integer :: n integer :: istat character(len=256) :: buffer
the keyword is used here to construct the declaration statement of an object
type(IXT&/**/ &IXD_TYPE), allocatable :: dt(:) type(IXTstatus) :: status allocate(dt(n), stat=istat) if (istat /= 0) then
the string type keyword can be substituted directly in the include code
write(buffer,'(A,I8,A,I3,A)') 'IXFalloc error('//IXD_SQTYPE//',size = ', n,', allocate stat = ', istat, ')' call IXFadd_status(status, IXCfacility_libisis, IXCseverity_error, IXCerr_outofmem, buffer) endif call IXFclear_valid(dt) end subroutine #undef IXD_TYPE #undef IXD_SQTYPE #endif