!=================================================== ! DO NOT EDIT THIS FILE, it was generated using /home/cacraig/cam5_1_17_trunk/models/utils/pio/genf90.pl ! Any changes you make to this file may be lost !=================================================== module buffer !----------------------------------------------------------------------- ! ! Purpose: ! LOW level handler for f90 arrays. ! ! Author: J. Edwards ! ! This file is used with genf90.pl to generate buffer.F90 ! !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8, r4=> shr_kind_r4, i4=> shr_kind_i4 use cam_logfile, only: iulog use abortutils, only: endrun implicit none private ! The maximum number of dims in a fortran array #define MAXDIMS 7 type buffer_field_default_type private real(r8), pointer :: data(:,:,:,:,:,:,:) => null() end type buffer_field_default_type ! TYPE int,double,real type buffer_field_int private integer(i4), pointer :: data(:,:,:,:,:,:,:) => null() end type buffer_field_int ! TYPE int,double,real type buffer_field_double private real(r8), pointer :: data(:,:,:,:,:,:,:) => null() end type buffer_field_double ! TYPE int,double,real type buffer_field_real private real(r4), pointer :: data(:,:,:,:,:,:,:) => null() end type buffer_field_real integer(i4), parameter,public :: dtype_i4=1 real(r8), parameter,public :: dtype_r8=1_r8 real(r4), parameter,public :: dtype_r4=1_r4 # 38 "buffer.F90.in" interface buffer_field_allocate ! TYPE int,double,real module procedure buffer_field_allocate_int ! TYPE int,double,real module procedure buffer_field_allocate_double ! TYPE int,double,real module procedure buffer_field_allocate_real end interface # 43 "buffer.F90.in" interface buffer_set_field ! TYPE int,double,real module procedure buffer_set_field_const_int ! TYPE int,double,real module procedure buffer_set_field_const_double ! TYPE int,double,real module procedure buffer_set_field_const_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_1d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_2d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_3d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_4d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_5d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_6d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_7d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_1d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_2d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_3d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_4d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_5d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_6d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_7d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_1d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_2d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_3d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_4d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_5d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_6d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_set_field_7d_real end interface # 51 "buffer.F90.in" interface buffer_get_field_ptr ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_1d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_2d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_3d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_4d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_5d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_6d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_7d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_1d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_2d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_3d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_4d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_5d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_6d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_7d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_1d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_2d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_3d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_4d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_5d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_6d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 module procedure buffer_get_field_ptr_7d_real end interface public :: buffer_field_deallocate, buffer_field_allocate, buffer_set_field, buffer_get_field_ptr, buffer_field_default_type # 60 "buffer.F90.in" CONTAINS # 62 "buffer.F90.in" subroutine buffer_field_deallocate(bfg) type(buffer_field_default_type),intent(inout) :: bfg if(.not.associated(bfg%data)) then call endrun('Attempt to deallocate unassociated array ptr') end if deallocate(bfg%data) nullify(bfg%data) end subroutine buffer_field_deallocate ! TYPE int,double,real # 76 "buffer.F90.in" subroutine buffer_field_allocate_int (bfg, dimsizes, dtype) type(buffer_field_default_type),intent(inout) :: bfg integer, intent(in) :: dimsizes(:) integer :: alldimsizes( MAXDIMS ) integer(i4), intent(in) :: dtype integer :: ierr type(buffer_field_int) :: b1 alldimsizes(:) = 1 alldimsizes(1:size(dimsizes)) = dimsizes if(associated(bfg%data)) then call endrun('Attempt to allocate array to associated ptr') end if allocate(b1%data(alldimsizes(1),alldimsizes(2),alldimsizes(3),alldimsizes(4),& alldimsizes(5),alldimsizes(6),alldimsizes(7)),stat=ierr) if(ierr/=0) then call endrun("allocate failed") end if bfg = transfer(b1,bfg) end subroutine buffer_field_allocate_int ! TYPE int,double,real # 76 "buffer.F90.in" subroutine buffer_field_allocate_double (bfg, dimsizes, dtype) type(buffer_field_default_type),intent(inout) :: bfg integer, intent(in) :: dimsizes(:) integer :: alldimsizes( MAXDIMS ) real(r8), intent(in) :: dtype integer :: ierr type(buffer_field_double) :: b1 alldimsizes(:) = 1 alldimsizes(1:size(dimsizes)) = dimsizes if(associated(bfg%data)) then call endrun('Attempt to allocate array to associated ptr') end if allocate(b1%data(alldimsizes(1),alldimsizes(2),alldimsizes(3),alldimsizes(4),& alldimsizes(5),alldimsizes(6),alldimsizes(7)),stat=ierr) if(ierr/=0) then call endrun("allocate failed") end if bfg = transfer(b1,bfg) end subroutine buffer_field_allocate_double ! TYPE int,double,real # 76 "buffer.F90.in" subroutine buffer_field_allocate_real (bfg, dimsizes, dtype) type(buffer_field_default_type),intent(inout) :: bfg integer, intent(in) :: dimsizes(:) integer :: alldimsizes( MAXDIMS ) real(r4), intent(in) :: dtype integer :: ierr type(buffer_field_real) :: b1 alldimsizes(:) = 1 alldimsizes(1:size(dimsizes)) = dimsizes if(associated(bfg%data)) then call endrun('Attempt to allocate array to associated ptr') end if allocate(b1%data(alldimsizes(1),alldimsizes(2),alldimsizes(3),alldimsizes(4),& alldimsizes(5),alldimsizes(6),alldimsizes(7)),stat=ierr) if(ierr/=0) then call endrun("allocate failed") end if bfg = transfer(b1,bfg) end subroutine buffer_field_allocate_real ! TYPE int,double,real # 105 "buffer.F90.in" subroutine buffer_set_field_const_int(bfg, const, start,kount) type(buffer_field_default_type) :: bfg integer(i4), intent(in) :: const integer, intent(in), optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) ns = size(start) strt(1:ns) = start fin = strt+cnt-1 do i=1,ns fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=const else ptr%data = const endif end subroutine buffer_set_field_const_int ! TYPE int,double,real # 105 "buffer.F90.in" subroutine buffer_set_field_const_double(bfg, const, start,kount) type(buffer_field_default_type) :: bfg real(r8), intent(in) :: const integer, intent(in), optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) ns = size(start) strt(1:ns) = start fin = strt+cnt-1 do i=1,ns fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=const else ptr%data = const endif end subroutine buffer_set_field_const_double ! TYPE int,double,real # 105 "buffer.F90.in" subroutine buffer_set_field_const_real(bfg, const, start,kount) type(buffer_field_default_type) :: bfg real(r4), intent(in) :: const integer, intent(in), optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) ns = size(start) strt(1:ns) = start fin = strt+cnt-1 do i=1,ns fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=const else ptr%data = const endif end subroutine buffer_set_field_const_real !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_1d_int(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg integer(i4), pointer :: field(:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_int), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (1==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (1==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (1==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_1d_int !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_2d_int(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg integer(i4), pointer :: field(:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_int), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (2==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (2==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (2==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_2d_int !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_3d_int(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg integer(i4), pointer :: field(:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_int), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (3==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (3==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (3==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_3d_int !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_4d_int(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg integer(i4), pointer :: field(:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_int), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (4==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (4==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (4==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_4d_int !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_5d_int(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg integer(i4), pointer :: field(:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_int), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (5==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (5==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (5==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_5d_int !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_6d_int(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg integer(i4), pointer :: field(:,:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_int), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (6==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (6==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (6==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_6d_int !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_7d_int(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg integer(i4), pointer :: field(:,:,:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_int), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (7==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (7==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (7==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_7d_int !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_1d_double(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r8), pointer :: field(:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_double), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (1==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (1==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (1==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_1d_double !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_2d_double(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r8), pointer :: field(:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_double), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (2==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (2==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (2==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_2d_double !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_3d_double(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r8), pointer :: field(:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_double), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (3==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (3==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (3==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_3d_double !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_4d_double(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r8), pointer :: field(:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_double), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (4==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (4==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (4==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_4d_double !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_5d_double(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r8), pointer :: field(:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_double), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (5==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (5==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (5==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_5d_double !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_6d_double(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r8), pointer :: field(:,:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_double), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (6==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (6==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (6==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_6d_double !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_7d_double(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r8), pointer :: field(:,:,:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_double), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (7==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (7==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (7==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_7d_double !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_1d_real(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r4), pointer :: field(:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_real), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (1==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (1==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (1==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (1==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_1d_real !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_2d_real(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r4), pointer :: field(:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_real), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (2==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (2==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (2==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (2==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_2d_real !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_3d_real(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r4), pointer :: field(:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_real), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (3==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (3==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (3==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (3==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_3d_real !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_4d_real(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r4), pointer :: field(:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_real), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (4==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (4==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (4==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (4==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_4d_real !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_5d_real(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r4), pointer :: field(:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_real), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (5==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (5==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (5==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (5==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_5d_real !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_6d_real(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r4), pointer :: field(:,:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_real), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (6==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (6==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (6==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (6==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_6d_real !========================================================================================= ! ! Given a physics_buffer chunk and an index return a pointer to a field chunk ! ! ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 149 "buffer.F90.in" subroutine buffer_get_field_ptr_7d_real(bfg, field, start,kount) type(buffer_field_default_type), intent(in) :: bfg real(r4), pointer :: field(:,:,:,:,:,:,:) integer, intent(in), optional :: start(:), kount(:) type(buffer_field_real), target :: ptr integer :: ns, strt(7), fin(7), cnt(7) ptr = transfer(bfg, ptr) strt(:) = 1 cnt = shape(ptr%data) if(present(start)) then ns = size(start) strt(1:ns) = start end if if(present(kount)) then cnt(1:ns) = kount end if fin = strt+cnt-1 #if (7==1) field => ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==2) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==3) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7)) #elif (7==4) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7)) #elif (7==5) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7)) #elif (7==6) field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7)) #else field => ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7)) #endif end subroutine buffer_get_field_ptr_7d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_1d_int(bfg,field,start,kount) type(buffer_field_default_type) :: bfg integer(i4),intent(in) :: field(:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (1==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (1==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (1==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (1==1) ptr%data(:,1,1,1,1,1,1) = field #elif(1==2) ptr%data(:,:,1,1,1,1,1) = field #elif(1==3) ptr%data(:,:,:,1,1,1,1) = field #elif(1==4) ptr%data(:,:,:,:,1,1,1) = field #elif(1==5) ptr%data(:,:,:,:,:,1,1) = field #elif(1==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_1d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_2d_int(bfg,field,start,kount) type(buffer_field_default_type) :: bfg integer(i4),intent(in) :: field(:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (2==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (2==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (2==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (2==1) ptr%data(:,1,1,1,1,1,1) = field #elif(2==2) ptr%data(:,:,1,1,1,1,1) = field #elif(2==3) ptr%data(:,:,:,1,1,1,1) = field #elif(2==4) ptr%data(:,:,:,:,1,1,1) = field #elif(2==5) ptr%data(:,:,:,:,:,1,1) = field #elif(2==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_2d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_3d_int(bfg,field,start,kount) type(buffer_field_default_type) :: bfg integer(i4),intent(in) :: field(:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (3==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (3==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (3==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (3==1) ptr%data(:,1,1,1,1,1,1) = field #elif(3==2) ptr%data(:,:,1,1,1,1,1) = field #elif(3==3) ptr%data(:,:,:,1,1,1,1) = field #elif(3==4) ptr%data(:,:,:,:,1,1,1) = field #elif(3==5) ptr%data(:,:,:,:,:,1,1) = field #elif(3==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_3d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_4d_int(bfg,field,start,kount) type(buffer_field_default_type) :: bfg integer(i4),intent(in) :: field(:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (4==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (4==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (4==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (4==1) ptr%data(:,1,1,1,1,1,1) = field #elif(4==2) ptr%data(:,:,1,1,1,1,1) = field #elif(4==3) ptr%data(:,:,:,1,1,1,1) = field #elif(4==4) ptr%data(:,:,:,:,1,1,1) = field #elif(4==5) ptr%data(:,:,:,:,:,1,1) = field #elif(4==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_4d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_5d_int(bfg,field,start,kount) type(buffer_field_default_type) :: bfg integer(i4),intent(in) :: field(:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (5==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (5==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (5==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (5==1) ptr%data(:,1,1,1,1,1,1) = field #elif(5==2) ptr%data(:,:,1,1,1,1,1) = field #elif(5==3) ptr%data(:,:,:,1,1,1,1) = field #elif(5==4) ptr%data(:,:,:,:,1,1,1) = field #elif(5==5) ptr%data(:,:,:,:,:,1,1) = field #elif(5==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_5d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_6d_int(bfg,field,start,kount) type(buffer_field_default_type) :: bfg integer(i4),intent(in) :: field(:,:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (6==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (6==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (6==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (6==1) ptr%data(:,1,1,1,1,1,1) = field #elif(6==2) ptr%data(:,:,1,1,1,1,1) = field #elif(6==3) ptr%data(:,:,:,1,1,1,1) = field #elif(6==4) ptr%data(:,:,:,:,1,1,1) = field #elif(6==5) ptr%data(:,:,:,:,:,1,1) = field #elif(6==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_6d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_7d_int(bfg,field,start,kount) type(buffer_field_default_type) :: bfg integer(i4),intent(in) :: field(:,:,:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_int) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (7==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (7==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (7==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (7==1) ptr%data(:,1,1,1,1,1,1) = field #elif(7==2) ptr%data(:,:,1,1,1,1,1) = field #elif(7==3) ptr%data(:,:,:,1,1,1,1) = field #elif(7==4) ptr%data(:,:,:,:,1,1,1) = field #elif(7==5) ptr%data(:,:,:,:,:,1,1) = field #elif(7==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_7d_int ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_1d_double(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r8),intent(in) :: field(:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (1==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (1==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (1==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (1==1) ptr%data(:,1,1,1,1,1,1) = field #elif(1==2) ptr%data(:,:,1,1,1,1,1) = field #elif(1==3) ptr%data(:,:,:,1,1,1,1) = field #elif(1==4) ptr%data(:,:,:,:,1,1,1) = field #elif(1==5) ptr%data(:,:,:,:,:,1,1) = field #elif(1==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_1d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_2d_double(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r8),intent(in) :: field(:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (2==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (2==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (2==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (2==1) ptr%data(:,1,1,1,1,1,1) = field #elif(2==2) ptr%data(:,:,1,1,1,1,1) = field #elif(2==3) ptr%data(:,:,:,1,1,1,1) = field #elif(2==4) ptr%data(:,:,:,:,1,1,1) = field #elif(2==5) ptr%data(:,:,:,:,:,1,1) = field #elif(2==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_2d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_3d_double(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r8),intent(in) :: field(:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (3==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (3==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (3==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (3==1) ptr%data(:,1,1,1,1,1,1) = field #elif(3==2) ptr%data(:,:,1,1,1,1,1) = field #elif(3==3) ptr%data(:,:,:,1,1,1,1) = field #elif(3==4) ptr%data(:,:,:,:,1,1,1) = field #elif(3==5) ptr%data(:,:,:,:,:,1,1) = field #elif(3==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_3d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_4d_double(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r8),intent(in) :: field(:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (4==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (4==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (4==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (4==1) ptr%data(:,1,1,1,1,1,1) = field #elif(4==2) ptr%data(:,:,1,1,1,1,1) = field #elif(4==3) ptr%data(:,:,:,1,1,1,1) = field #elif(4==4) ptr%data(:,:,:,:,1,1,1) = field #elif(4==5) ptr%data(:,:,:,:,:,1,1) = field #elif(4==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_4d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_5d_double(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r8),intent(in) :: field(:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (5==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (5==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (5==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (5==1) ptr%data(:,1,1,1,1,1,1) = field #elif(5==2) ptr%data(:,:,1,1,1,1,1) = field #elif(5==3) ptr%data(:,:,:,1,1,1,1) = field #elif(5==4) ptr%data(:,:,:,:,1,1,1) = field #elif(5==5) ptr%data(:,:,:,:,:,1,1) = field #elif(5==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_5d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_6d_double(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r8),intent(in) :: field(:,:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (6==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (6==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (6==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (6==1) ptr%data(:,1,1,1,1,1,1) = field #elif(6==2) ptr%data(:,:,1,1,1,1,1) = field #elif(6==3) ptr%data(:,:,:,1,1,1,1) = field #elif(6==4) ptr%data(:,:,:,:,1,1,1) = field #elif(6==5) ptr%data(:,:,:,:,:,1,1) = field #elif(6==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_6d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_7d_double(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r8),intent(in) :: field(:,:,:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_double) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (7==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (7==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (7==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (7==1) ptr%data(:,1,1,1,1,1,1) = field #elif(7==2) ptr%data(:,:,1,1,1,1,1) = field #elif(7==3) ptr%data(:,:,:,1,1,1,1) = field #elif(7==4) ptr%data(:,:,:,:,1,1,1) = field #elif(7==5) ptr%data(:,:,:,:,:,1,1) = field #elif(7==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_7d_double ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_1d_real(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r4),intent(in) :: field(:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (1==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (1==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (1==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (1==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (1==1) ptr%data(:,1,1,1,1,1,1) = field #elif(1==2) ptr%data(:,:,1,1,1,1,1) = field #elif(1==3) ptr%data(:,:,:,1,1,1,1) = field #elif(1==4) ptr%data(:,:,:,:,1,1,1) = field #elif(1==5) ptr%data(:,:,:,:,:,1,1) = field #elif(1==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_1d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_2d_real(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r4),intent(in) :: field(:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (2==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (2==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (2==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (2==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (2==1) ptr%data(:,1,1,1,1,1,1) = field #elif(2==2) ptr%data(:,:,1,1,1,1,1) = field #elif(2==3) ptr%data(:,:,:,1,1,1,1) = field #elif(2==4) ptr%data(:,:,:,:,1,1,1) = field #elif(2==5) ptr%data(:,:,:,:,:,1,1) = field #elif(2==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_2d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_3d_real(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r4),intent(in) :: field(:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (3==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (3==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (3==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (3==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (3==1) ptr%data(:,1,1,1,1,1,1) = field #elif(3==2) ptr%data(:,:,1,1,1,1,1) = field #elif(3==3) ptr%data(:,:,:,1,1,1,1) = field #elif(3==4) ptr%data(:,:,:,:,1,1,1) = field #elif(3==5) ptr%data(:,:,:,:,:,1,1) = field #elif(3==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_3d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_4d_real(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r4),intent(in) :: field(:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (4==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (4==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (4==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (4==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (4==1) ptr%data(:,1,1,1,1,1,1) = field #elif(4==2) ptr%data(:,:,1,1,1,1,1) = field #elif(4==3) ptr%data(:,:,:,1,1,1,1) = field #elif(4==4) ptr%data(:,:,:,:,1,1,1) = field #elif(4==5) ptr%data(:,:,:,:,:,1,1) = field #elif(4==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_4d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_5d_real(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r4),intent(in) :: field(:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (5==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (5==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (5==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (5==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (5==1) ptr%data(:,1,1,1,1,1,1) = field #elif(5==2) ptr%data(:,:,1,1,1,1,1) = field #elif(5==3) ptr%data(:,:,:,1,1,1,1) = field #elif(5==4) ptr%data(:,:,:,:,1,1,1) = field #elif(5==5) ptr%data(:,:,:,:,:,1,1) = field #elif(5==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_5d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_6d_real(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r4),intent(in) :: field(:,:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (6==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (6==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (6==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (6==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (6==1) ptr%data(:,1,1,1,1,1,1) = field #elif(6==2) ptr%data(:,:,1,1,1,1,1) = field #elif(6==3) ptr%data(:,:,:,1,1,1,1) = field #elif(6==4) ptr%data(:,:,:,:,1,1,1) = field #elif(6==5) ptr%data(:,:,:,:,:,1,1) = field #elif(6==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_6d_real ! TYPE int,double,real ! DIMS 1,2,3,4,5,6,7 # 194 "buffer.F90.in" subroutine buffer_set_field_7d_real(bfg,field,start,kount) type(buffer_field_default_type) :: bfg real(r4),intent(in) :: field(:,:,:,:,:,:,:) integer,intent(in),optional :: start(:),kount(:) type(buffer_field_real) :: ptr integer :: i, nc, strt(7), fin(7), cnt(7) ptr = transfer(bfg,ptr) if(present(start).and.present(kount)) then strt(:) = 1 cnt = shape(ptr%data) nc=size(start) strt(1:nc) = start fin = strt+cnt-1 do i=1,nc fin(i) = strt(i)+kount(i)-1 if(strt(i)<1 .or. fin(i)>cnt(i)) then call endrun('Start plus kount exceeds dimension bounds') endif enddo #if (7==1) ptr%data(strt(1):fin(1),strt(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==2) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==3) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4),strt(5),strt(6),strt(7))=field #elif (7==4) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5),strt(6),strt(7))=field #elif (7==5) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),strt(5):fin(5),strt(6),strt(7))=field #elif (7==6) ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7))=field #else ptr%data(strt(1):fin(1),strt(2):fin(2),strt(3):fin(3),strt(4):fin(4),& strt(5):fin(5),strt(6):fin(6),strt(7):fin(7))=field #endif else #if (7==1) ptr%data(:,1,1,1,1,1,1) = field #elif(7==2) ptr%data(:,:,1,1,1,1,1) = field #elif(7==3) ptr%data(:,:,:,1,1,1,1) = field #elif(7==4) ptr%data(:,:,:,:,1,1,1) = field #elif(7==5) ptr%data(:,:,:,:,:,1,1) = field #elif(7==6) ptr%data(:,:,:,:,:,:,1) = field #else ptr%data = field #endif end if end subroutine buffer_set_field_7d_real end module buffer