! $Id$ ! ! Earth System Modeling Framework ! Copyright (c) 2002-2023, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the University of Illinois-NCSA License. ! !============================================================================== program test #include "ESMF.h" use ESMF use ESMF_TestMod implicit none ! This test verifies that the actual size of the Fortran 90 "dope vector" ! (private pointer information which stores the rank, indices, data type, ! etc for any Fortran array) will fit within space which has been set aside ! for it. ! ! These tests compute (in C) on the fly the difference between the ! addresses of a(1) and a(2) where a is an array of Fortran pointers. ! This gives the real number of bytes that a "dope vector" takes. ! On all the compilers we have seen there is a base size for rank 1 ! arrays, and then a fixed number of additional bytes for each additional ! rank. (presumably the extra space is where it stores the lower and ! upper index bounds for that rank). ! ! This test compares the run-time computed value with the compiled-in ! fixed numbers. If the run-time size is larger than the compiled-in ! size, the compiled-in size must change in ESMCI_LocalArray.h. ! ! (this size is not computed at run-time because in some places it has ! to be known at compile time to declare fixed size buffers.) integer :: rc, result character(len=ESMF_MAXSTR) :: failMsg, name ! Pointers to arrays of data type Integer * 4 type PtrIWrap1 sequence integer (ESMF_KIND_I4),dimension(:),pointer :: dummy end type type PtrIWrap2 sequence integer (ESMF_KIND_I4),dimension(:,:),pointer :: dummy end type type PtrIWrap3 sequence integer (ESMF_KIND_I4),dimension(:,:,:),pointer :: dummy end type type PtrIWrap4 sequence integer (ESMF_KIND_I4),dimension(:,:,:,:),pointer :: dummy end type type PtrIWrap5 sequence integer (ESMF_KIND_I4),dimension(:,:,:,:,:),pointer :: dummy end type type PtrIWrap6 sequence integer (ESMF_KIND_I4),dimension(:,:,:,:,:,:),pointer :: dummy end type type PtrIWrap7 sequence integer (ESMF_KIND_I4),dimension(:,:,:,:,:,:,:),pointer :: dummy end type #ifdef ESMF_TESTEXHAUSTIVE ! Pointers to arrays of data type Real * 4 type PtrRWrap1 sequence real (ESMF_KIND_R4),dimension(:),pointer :: dummy end type type PtrRWrap2 sequence real (ESMF_KIND_R4),dimension(:,:),pointer :: dummy end type type PtrRWrap3 sequence real (ESMF_KIND_R4),dimension(:,:,:),pointer :: dummy end type type PtrRWrap4 sequence real (ESMF_KIND_R4),dimension(:,:,:,:),pointer :: dummy end type type PtrRWrap5 sequence real (ESMF_KIND_R4),dimension(:,:,:,:,:),pointer :: dummy end type type PtrRWrap6 sequence real (ESMF_KIND_R4),dimension(:,:,:,:,:,:),pointer :: dummy end type type PtrRWrap7 sequence real (ESMF_KIND_R4),dimension(:,:,:,:,:,:,:),pointer :: dummy end type ! Pointers to arrays of data type Real * 8 type PtrR8Wrap1 sequence real (ESMF_KIND_R8),dimension(:),pointer :: dummy end type type PtrR8Wrap2 sequence real (ESMF_KIND_R8),dimension(:,:),pointer :: dummy end type type PtrR8Wrap3 sequence real (ESMF_KIND_R8),dimension(:,:,:),pointer :: dummy end type type PtrR8Wrap4 sequence real (ESMF_KIND_R8),dimension(:,:,:,:),pointer :: dummy end type type PtrR8Wrap5 sequence real (ESMF_KIND_R8),dimension(:,:,:,:,:),pointer :: dummy end type type PtrR8Wrap6 sequence real (ESMF_KIND_R8),dimension(:,:,:,:,:,:),pointer :: dummy end type type PtrR8Wrap7 sequence real (ESMF_KIND_R8),dimension(:,:,:,:,:,:,:),pointer :: dummy end type ! Pointers to arrays of a derived data type type PtrSWrap1 sequence type(PtrIWrap1),dimension(:),pointer :: dummy end type type PtrSWrap2 sequence type(PtrIWrap1),dimension(:,:),pointer :: dummy end type type PtrSWrap3 sequence type(PtrIWrap1),dimension(:,:,:),pointer :: dummy end type type PtrSWrap4 sequence type(PtrIWrap1),dimension(:,:,:,:),pointer :: dummy end type type PtrSWrap5 sequence type(PtrIWrap1),dimension(:,:,:,:,:),pointer :: dummy end type type PtrSWrap6 sequence type(PtrIWrap1),dimension(:,:,:,:,:,:),pointer :: dummy end type type PtrSWrap7 sequence type(PtrIWrap1),dimension(:,:,:,:,:,:,:),pointer :: dummy end type #endif type(PtrIWrap1) :: sizetest1I(2) type(PtrIWrap2) :: sizetest2I(2) type(PtrIWrap3) :: sizetest3I(2) type(PtrIWrap4) :: sizetest4I(2) type(PtrIWrap5) :: sizetest5I(2) type(PtrIWrap6) :: sizetest6I(2) type(PtrIWrap7) :: sizetest7I(2) #ifdef ESMF_TESTEXHAUSTIVE type(PtrRWrap1) :: sizetest1R(2) type(PtrRWrap2) :: sizetest2R(2) type(PtrRWrap3) :: sizetest3R(2) type(PtrRWrap4) :: sizetest4R(2) type(PtrRWrap5) :: sizetest5R(2) type(PtrRWrap6) :: sizetest6R(2) type(PtrRWrap7) :: sizetest7R(2) type(PtrR8Wrap1) :: sizetest1R8(2) type(PtrR8Wrap2) :: sizetest2R8(2) type(PtrR8Wrap3) :: sizetest3R8(2) type(PtrR8Wrap4) :: sizetest4R8(2) type(PtrR8Wrap5) :: sizetest5R8(2) type(PtrR8Wrap6) :: sizetest6R8(2) type(PtrR8Wrap7) :: sizetest7R8(2) type(PtrSWrap1) :: sizetest1S(2) type(PtrSWrap2) :: sizetest2S(2) type(PtrSWrap3) :: sizetest3S(2) type(PtrSWrap4) :: sizetest4S(2) type(PtrSWrap5) :: sizetest5S(2) type(PtrSWrap6) :: sizetest6S(2) type(PtrSWrap7) :: sizetest7S(2) #endif result = 0 !------------------------------------------------------------------------ ! ! test that the compiled-in size is the same as the run-time computed ! ! size of an F90 pointer. this runs the same tests for various ranks ! ! and pointer types. so far the results have always been the same ! ! for any data type - the size differs per rank only. but test it all ! ! anyway just to be sure. call ESMF_TestStart(ESMF_SRCLINE, rc=rc) if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !NEX_UTest call c_ESMF_F90PtrSizePrint(sizetest1I(1), sizetest1I(2), 1, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "1D Integer array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !NEX_UTest call c_ESMF_F90PtrSizePrint(sizetest2I(1), sizetest2I(2), 2, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "2D Integer array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !NEX_UTest call c_ESMF_F90PtrSizePrint(sizetest3I(1), sizetest3I(2), 3, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "3D Integer array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !NEX_UTest call c_ESMF_F90PtrSizePrint(sizetest4I(1), sizetest4I(2), 4, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "4D Integer array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !NEX_UTest call c_ESMF_F90PtrSizePrint(sizetest5I(1), sizetest5I(2), 5, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "5D Integer array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !NEX_UTest call c_ESMF_F90PtrSizePrint(sizetest6I(1), sizetest6I(2), 6, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "6D Integer array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !NEX_UTest call c_ESMF_F90PtrSizePrint(sizetest7I(1), sizetest7I(2), 7, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "7D Integer array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !------------------------------------------------------------------------ #ifdef ESMF_TESTEXHAUSTIVE !------------------------------------------------------------------------ !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest1R(1), sizetest1R(2), 1, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "1D Real*4 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest2R(1), sizetest2R(2), 2, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "2D Real*4 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest3R(1), sizetest3R(2), 3, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "3D Real*4 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest4R(1), sizetest4R(2), 4, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "4D Real*4 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest5R(1), sizetest5R(2), 5, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "5D Real*4 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest6R(1), sizetest6R(2), 6, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "6D Real*4 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest7R(1), sizetest7R(2), 7, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "7D Real*4 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !------------------------------------------------------------------------ !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest1R8(1), sizetest1R8(2), 1, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "1D Real*8 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest2R8(1), sizetest2R8(2), 2, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "2D Real*8 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest3R8(1), sizetest3R8(2), 3, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "3D Real*8 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest4R8(1), sizetest4R8(2), 4, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "4D Real*8 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest5R8(1), sizetest5R8(2), 5, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "5D Real*8 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest6R8(1), sizetest6R8(2), 6, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "6D Real*8 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest7R8(1), sizetest7R8(2), 7, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "7D Real*8 array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !------------------------------------------------------------------------ !------------------------------------------------------------------------ !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest1S(1), sizetest1S(2), 1, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "1D Derived type array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest2S(1), sizetest2S(2), 2, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "2D Derived type array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest3S(1), sizetest3S(2), 3, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "3D Derived type array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest4S(1), sizetest4S(2), 4, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "4D Derived type array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest5S(1), sizetest5S(2), 5, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "5D Derived type array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest6S(1), sizetest6S(2), 6, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "6D Derived type array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !EX_UTest call c_ESMF_F90PtrSizePrint(sizetest7S(1), sizetest7S(2), 7, rc) write(failMsg,*) "Too small dope vector allocation in LocalArray detected" write(name, *) "7D Derived type array pointer size test" call ESMF_Test(rc.eq.ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE) !------------------------------------------------------------------------ !------------------------------------------------------------------------ #endif call ESMF_TestEnd(ESMF_SRCLINE) end program test