#line 1 "stdin"
!--------------------------------------------------------------------
! Copyright © 2017 United States Government as represented by the   |
! Administrator of the National Aeronautics and Space               |
! Administration. No copyright is claimed in the United States      |
! under Title 17, U.S. Code. All Other Rights Reserved.             |
!                                                                   |
! Licensed under the Apache License, Version 2.0.                   |
!--------------------------------------------------------------------









! Althoug the code below could be compressed to some degree,
! maintainability is enhanced by isolating each complication in
! its own decision block.
!
! User settable tokens:
!    (a)  __use_type
!    (b)  __use_rank  and __use_extents
!    (c)  __use_string and __use_string_deferred
!    (d)  __use_logical
!    (e)  __use_pointer
!    (f)  __use_allocatable
!    (g)  __use_procedure (not complete)
!
!    __USE_EQ
!
! Output macros
!
!    (a)  __TYPE_ASSIGN(dest,src)  ! Set dest to have value src
!    (b)  __TYPE_MOVE(dest,src)    ! If allocatable, move memory for src to variable dest
!                               ! otherwise, behave as __TYPE_ASSIGN(dest,src)
!    (c)  __TYPE_FREE(x)      ! Release memory associated with x (if allocatable)
!
! Output tokens
!
!    (a) __type_declare_component
!    (b) __type_declare_target
!    (c) __type_declare_dummy
!    (d) __type_declare_result
!    (e) __type_interface ! unused - keeping for later use with procedure pointers
!
! Other tokens are for internal use in this file and should be undefined at the end.

!-------------------------------------------------------------------------------
! 1) Declared type

#if defined(__use_string) | defined(__use_string_deferred)
#  define __type_target_type character(len=*)
#  if defined(__use_string)
#    define __type_declare_type character(len=__use_string)
#  else
#    define __type_declare_type character(len=:)
#  endif
#else
#  define __type_declare_type __use_type
#  if defined(__use_procedure)
#    define __type_interface
#    define __type_target_type __type_declare_type
#  else
#    define __type_target_type __type_declare_type
#  endif
#endif


!-------------------------------------------------------------------------------
! 2) Dimensions
!    (a) There are two cases to consider: deferred shape and non-deferred shape.
!    (b) Return pointers are always deferred shape.
#if defined (__use_rank)
#  define __type_rank __use_rank
#else
#  define __type_rank 0
#endif

#if __type_rank == 0
#  define __type_deferred_dim_attr
#elif (__type_rank == 1)
#  define __type_deferred_dim_attr , dimension(:)
#elif (__type_rank == 2)
#  define __type_deferred_dim_attr , dimension(:,:)
#elif (__type_rank == 3)
#  define __type_deferred_dim_attr , dimension(:,:,:)
#elif (__type_rank == 4)
#  define __type_deferred_dim_attr , dimension(:,:,:,:)
#elif (__type_rank == 5)
#  define __type_deferred_dim_attr , dimension(:,:,:,:,:)
#endif

#ifdef __use_extents
#  define __type_dimension_attr , dimension __use_extents
#else
#  define __type_dimension_attr __type_deferred_dim_attr
#endif

#define __type_result_dimension_attr __type_deferred_dim_attr


!-------------------------------------------------------------------------------
! 3) Does the type need to be wrapped
#if defined(__use_pointer)
#  define __type_wrapped
#elif defined(__use_allocatable)
#  define __type_wrapped
#elif defined(__use_string_deferred)
#  define __type_wrapped
#elif __type_rank > 0
#  define __type_wrapped
#endif




!-------------------------------------------------------------------------------
! 4) Attributes for component declaration

#if defined(__use_pointer)
#  if defined(__use_procedure)
#    define __type_component_attrs , pointer, nopass
#  else
#    define __type_component_attrs __type_dimension_attr, pointer
#  endif
#elif defined(__use_allocatable) | defined(__use_string_deferred)
#  define __type_component_attrs __type_dimension_attr, allocatable
#elif (__type_rank > 0)
#  if defined(__use_extents)
#     define __type_component_attrs __type_dimension_attr
#  else
#     define __type_component_attrs __type_dimension_attr, allocatable
#  endif
#else
#  define __type_component_attrs
#endif

! macros for testing equality

#ifdef __USE_EQ
#  define __TYPE_EQ __USE_EQ
#else
#  ifdef __use_pointer
#    define __TYPE_EQ(x,y) associated(x,y)
#  else
#    ifdef __USE_EQ_ELEMENT
#      define __TYPE_EQ_ELEMENT(x,y) __USE_EQ_ELEMENT(x,y)    
#    else
#      ifdef __use_logical 
#         define __TYPE_EQ_ELEMENT(x,y) (x .eqv. y)
#      else
#        define __TYPE_EQ_ELEMENT(x,y) (x == y)
#      endif
#    endif
!    Array support
#    if (__use_rank > 0)
#       ifdef __use_extents
!         Assumes that __USE_EQ_ELEMENT is an elemental function.  If not
!         then the user must define their own __TYPE_EQ(x,y).
#         define __TYPE_EQ(x,y) all(__TYPE_EQ_ELEMENT(x,y))
#       else
#         define __TYPE_EQ(x,y) __PROC(eqArray)(x,y)
#       endif
#    else
#      define __TYPE_EQ(x,y) __TYPE_EQ_ELEMENT(x,y)
#    endif
#  endif
#endif


! macros for comparing order
! User can specify (or override):
#define __type_compare_well_defined
#ifdef __USE_LESS_THAN
#  define __TYPE_LESS_THAN(x,y) __USE_LESS_THAN(x,y)
#else
#  if defined(__use_string) | defined(__use_string_deferred)
#    define __TYPE_LESS_THAN(x,y) (x)<(y)
#  elif defined(__use_less_than_defined)
#    define __TYPE_LESS_THAN(x,y) (x)<(y)
#  else
#    undef __type_compare_well_defined
! In most cases, we can provide a compare operator.  Not recommended for vector,
! but useful for set and keys for map:
#    if  !(defined(__use_allocatable) & !defined(__use_pointer))
#      define __TYPE_LESS_THAN(x,y) defaultLessThan(x,y)
#      define __type_needs_default_compare
#    endif
#  endif
#endif





!-------------------------------------------------------------------------------
! 5) Attributes for target and dummy declaration

#if defined(__use_pointer)
#  if defined(__use_procedure)
#    define __type_target_attrs
#    define __type_dummy_attrs __type_target_attrs
#  else
#    define __type_target_attrs __type_dimension_attr, target
#    define __type_dummy_attrs __type_dimension_attr, target
#  endif
#else
#  define __type_target_attrs  __type_dimension_attr
#  define __type_dummy_attrs __type_dimension_attr
#endif


!-------------------------------------------------------------------------------
! 6) Attributes for function result declaration
!    Always used deferred shape here as pointer cannot work 
!    with non-deferred shape.

#define __type_result_attrs __type_deferred_dim_attr



!-------------------------------------------------------------------------------
! 8) Assembly

#define __type_declare_component __type_declare_type __type_component_attrs
#define __type_declare_target    __type_target_type __type_target_attrs
#define __type_declare_dummy     __type_target_type __type_dummy_attrs
#define __type_declare_result    __type_declare_type __type_result_attrs


!-------------------------------------------------------------------------------
! 9) Macros that manipulate storage

#ifdef __USE_ASSIGN
#  define __TYPE_ASSIGN(dest,src) __USE_ASSIGN(dest,src)   
#  define __TYPE_MOVE(dest,src) __USE_MOVE(dest,src)   
#  define __TYPE_FREE(x) __USE_FREE(x)
#else
#  ifdef __use_pointer

#    define __TYPE_ASSIGN(dest,src)  dest=>src
#    define __TYPE_MOVE(dest,src)  dest=>src
!#    define __TYPE_FREE(x)  nullify(x)
#    define __TYPE_FREE(x)

#  elif defined(__use_allocatable)

#    define __TYPE_ASSIGN(dest,src)  allocate(dest, source=src)
#    define __TYPE_MOVE(dest,src)  call move_alloc(from=src, to=dest)
#    define __TYPE_FREE(x)  deallocate(x)

#  elif defined (__use_rank) & (__use_rank > 0) & !defined(__use_extents)
#    define __TYPE_ASSIGN(dest,src) __ASSIGN_DIM(dest,src)
#    define __TYPE_MOVE(dest,src) call move_alloc(from=src, to=dest)
#    define __TYPE_FREE(x)  deallocate(x)

#elif defined (__use_string_deferred)

#    define __TYPE_ASSIGN(dest,src)  dest=src
#    ifdef __GFORTRAN__
#      define __TYPE_MOVE(dest,src) dest=src;deallocate(src)
#    else
#    define __TYPE_MOVE(dest,src) call move_alloc(from=src, to=dest)
#    endif
#    define __TYPE_FREE(x)  deallocate(x)

#else

#    define __TYPE_ASSIGN(dest,src)  dest=src
#    define __TYPE_MOVE(dest,src) dest=src
#    define __TYPE_FREE(x)

#  endif
#endif



