diff --git a/Makefile b/Makefile index baceb05cb7..968746bdc4 100644 --- a/Makefile +++ b/Makefile @@ -48,7 +48,7 @@ ftn: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) titan-cray: ( $(MAKE) all \ @@ -66,7 +66,7 @@ titan-cray: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) pgi: ( $(MAKE) all \ @@ -91,7 +91,7 @@ pgi: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) pgi-nersc: ( $(MAKE) all \ @@ -112,7 +112,7 @@ pgi-nersc: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) pgi-llnl: ( $(MAKE) all \ @@ -133,7 +133,7 @@ pgi-llnl: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) ifort: ( $(MAKE) all \ @@ -158,7 +158,7 @@ ifort: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) ifort-scorep: ( $(MAKE) all \ @@ -183,7 +183,7 @@ ifort-scorep: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) ifort-gcc: ( $(MAKE) all \ @@ -208,7 +208,7 @@ ifort-gcc: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) gfortran: ( $(MAKE) all \ @@ -233,7 +233,7 @@ gfortran: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) gfortran-clang: ( $(MAKE) all \ @@ -258,7 +258,7 @@ gfortran-clang: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) g95: ( $(MAKE) all \ @@ -279,7 +279,7 @@ g95: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) pathscale-nersc: ( $(MAKE) all \ @@ -300,7 +300,7 @@ pathscale-nersc: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) cray-nersc: ( $(MAKE) all \ @@ -321,7 +321,7 @@ cray-nersc: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) gnu-nersc: ( $(MAKE) all \ @@ -344,7 +344,7 @@ gnu-nersc: "DEBUG = $(DEBUG)" \ "SERIAL = $(SERIAL)" \ "USE_PAPI = $(USE_PAPI)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -D_MPI $(FILE_OFFSET) $(ZOLTAN_DEFINE)" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI $(FILE_OFFSET) $(ZOLTAN_DEFINE)" ) intel-nersc: ( $(MAKE) all \ @@ -369,7 +369,7 @@ intel-nersc: "DEBUG = $(DEBUG)" \ "USE_PAPI = $(USE_PAPI)" \ "OPENMP = $(OPENMP)" \ - "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE" ) + "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI" ) bluegene: ( $(MAKE) all \ diff --git a/src/Makefile.in.ACME b/src/Makefile.in.ACME index ad507cf3af..5c4208d781 100644 --- a/src/Makefile.in.ACME +++ b/src/Makefile.in.ACME @@ -53,12 +53,6 @@ override CPPINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(INSTALL_SHAREDP override FCINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(INSTALL_SHAREDPATH)/include -I$(INSTALL_SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include LIBS += -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -L$(LIBROOT) -L$(INSTALL_SHAREDPATH)/lib -lpio -lpnetcdf -lnetcdf -ifneq (,$(findstring FORTRANUNDERSCORE, $(CPPFLAGS))) -ifeq (,$(findstring DUNDERSCORE, $(CPPFLAGS))) - override CPPFLAGS += -DUNDERSCORE -endif -endif - ifeq ($(DEBUG), TRUE) override CPPFLAGS += -DMPAS_DEBUG endif diff --git a/src/Makefile.in.CESM b/src/Makefile.in.CESM index 7644f65c4a..2af642b047 100644 --- a/src/Makefile.in.CESM +++ b/src/Makefile.in.CESM @@ -53,12 +53,6 @@ override CPPINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(SHAREDPATH)/inc override FCINCLUDES += -I$(EXEROOT)/$(COMPONENT)/source/inc -I$(SHAREDPATH)/include -I$(SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share -I$(NETCDF)/include -I$(PIO) -I$(PNETCDF)/include LIBS += -L$(PIO) -L$(PNETCDF)/lib -L$(NETCDF)/lib -L$(LIBROOT) -L$(SHAREDPATH)/lib -lpio -lpnetcdf -lnetcdf -ifneq (,$(findstring FORTRANUNDERSCORE, $(CPPFLAGS))) -ifeq (,$(findstring DUNDERSCORE, $(CPPFLAGS))) - override CPPFLAGS += -DUNDERSCORE -endif -endif - ifeq ($(DEBUG), TRUE) override CPPFLAGS += -DMPAS_DEBUG endif diff --git a/src/core_init_atmosphere/mpas_init_atm_gwd.F b/src/core_init_atmosphere/mpas_init_atm_gwd.F index 3bc260c3c2..6d1632f9b2 100644 --- a/src/core_init_atmosphere/mpas_init_atm_gwd.F +++ b/src/core_init_atmosphere/mpas_init_atm_gwd.F @@ -7,15 +7,35 @@ ! module mpas_init_atm_gwd + use iso_c_binding, only : c_char, c_int, c_float, c_ptr, c_loc + use mpas_derived_types, only : MPAS_LOG_ERR use mpas_framework use mpas_timekeeping use mpas_log, only : mpas_log_write + use mpas_c_interfacing, only : mpas_f_to_c_string public :: compute_gwd_fields private + interface + subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, & + scalefactor, wordsize, status) bind(C) + use iso_c_binding, only : c_char, c_int, c_float, c_ptr + character (c_char), dimension(*), intent(in) :: fname + type (c_ptr), value :: rarray + integer (c_int), intent(in), value :: nx + integer (c_int), intent(in), value :: ny + integer (c_int), intent(in), value :: nz + integer (c_int), intent(in), value :: isigned + integer (c_int), intent(in), value :: endian + real (c_float), intent(in), value :: scalefactor + integer (c_int), intent(in), value :: wordsize + integer (c_int), intent(inout) :: status + end subroutine read_geogrid + end interface + integer, parameter :: I1KIND = selected_int_kind(2) real (kind=RKIND), parameter :: Re = 6371229.0_RKIND ! Earth radius in MPAS-Atmosphere @@ -314,14 +334,17 @@ function read_global_30s_topo(path, sub_path) result(iErr) integer, parameter :: tile_y = 1200 ! y-dimension of each tile of global 30-arc-second topography integer, parameter :: tile_bdr = 3 ! number of layers of border/halo points surrounding each tile - integer :: istatus + integer (c_int) :: istatus integer :: ix, iy, ishift, ix_shift - integer :: isigned, endian, wordsize, nx, ny, nz - real (kind=R4KIND) :: scalefactor - real (kind=R4KIND), dimension(:,:,:), allocatable :: tile + integer (c_int) :: isigned, endian, wordsize, nx, ny, nz + real (c_float) :: scalefactor + real (c_float), dimension(:,:,:), pointer, contiguous :: tile + type (c_ptr) :: tile_ptr character(len=StrKIND) :: filename + character(kind=c_char), dimension(StrKIND+1) :: c_filename allocate(tile(tile_x+2*tile_bdr,tile_y+2*tile_bdr,1)) + tile_ptr = c_loc(tile) isigned = 1 endian = 0 @@ -345,7 +368,8 @@ function read_global_30s_topo(path, sub_path) result(iErr) do ix=1,topo_x,tile_x write(filename,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(path)//trim(sub_path), ix, '-', (ix+tile_x-1), '.', & iy, '-', (iy+tile_y-1) - call read_geogrid(filename, len_trim(filename), tile, nx, ny, nz, isigned, endian, & + call mpas_f_to_c_string(filename, c_filename) + call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & scalefactor, wordsize, istatus) if (istatus /= 0) then call mpas_log_write('Error reading topography tile '//trim(filename), messageType=MPAS_LOG_ERR) @@ -389,14 +413,17 @@ function read_global_30s_landuse(path) result(iErr) integer, parameter :: tile_x = 1200 ! x-dimension of each tile of global 30-arc-second landuse integer, parameter :: tile_y = 1200 ! y-dimension of each tile of global 30-arc-second landuse - integer :: istatus + integer (c_int) :: istatus integer :: ix, iy - integer :: isigned, endian, wordsize, nx, ny, nz - real (kind=R4KIND) :: scalefactor - real (kind=R4KIND), dimension(:,:,:), allocatable :: tile + integer (c_int) :: isigned, endian, wordsize, nx, ny, nz + real (c_float) :: scalefactor + real (c_float), dimension(:,:,:), pointer, contiguous :: tile + type (c_ptr) :: tile_ptr character(len=StrKIND) :: filename + character(kind=c_char), dimension(StrKIND+1) :: c_filename allocate(tile(tile_x,tile_y,1)) + tile_ptr = c_loc(tile) isigned = 1 endian = 0 @@ -410,7 +437,8 @@ function read_global_30s_landuse(path) result(iErr) do ix=1,topo_x,tile_x write(filename,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(path)//'/landuse_30s/', ix, '-', (ix+tile_x-1), '.', & iy, '-', (iy+tile_y-1) - call read_geogrid(filename, len_trim(filename), tile, nx, ny, nz, isigned, endian, & + call mpas_f_to_c_string(filename, c_filename) + call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & scalefactor, wordsize, istatus) if (istatus /= 0) then call mpas_log_write('Error reading landuse tile '//trim(filename)) diff --git a/src/core_init_atmosphere/mpas_init_atm_static.F b/src/core_init_atmosphere/mpas_init_atm_static.F index 253d681f94..7d57d7dd0e 100644 --- a/src/core_init_atmosphere/mpas_init_atm_static.F +++ b/src/core_init_atmosphere/mpas_init_atm_static.F @@ -15,9 +15,12 @@ module mpas_init_atm_static use mpas_log, only : mpas_log_write use init_atm_hinterp use init_atm_llxy + use mpas_c_interfacing, only : mpas_f_to_c_string use mpas_atmphys_utilities + use iso_c_binding, only : c_char, c_int, c_float, c_loc, c_ptr + implicit none private public:: init_atm_static, & @@ -26,6 +29,23 @@ module mpas_init_atm_static nearest_cell, & sphere_distance + interface + subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, & + scalefactor, wordsize, status) bind(C) + use iso_c_binding, only : c_char, c_int, c_float, c_ptr + character (c_char), dimension(*), intent(in) :: fname + type (c_ptr), value :: rarray + integer (c_int), intent(in), value :: nx + integer (c_int), intent(in), value :: ny + integer (c_int), intent(in), value :: nz + integer (c_int), intent(in), value :: isigned + integer (c_int), intent(in), value :: endian + real (c_float), intent(in), value :: scalefactor + integer (c_int), intent(in), value :: wordsize + integer (c_int), intent(inout) :: status + end subroutine read_geogrid + end interface + contains !================================================================================================== @@ -41,6 +61,7 @@ subroutine init_atm_static(mesh, dims, configs) type(proj_info):: proj character(len=StrKIND) :: fname + character(kind=c_char), dimension(StrKIND+1) :: c_fname character(len=StrKIND), pointer :: config_geog_data_path character(len=StrKIND), pointer :: config_landuse_data character(len=StrKIND), pointer :: config_topo_data @@ -49,16 +70,17 @@ subroutine init_atm_static(mesh, dims, configs) integer:: isice_lu,iswater_lu,ismax_lu - integer:: nx,ny,nz - integer:: endian,isigned,istatus,wordsize + integer(c_int):: nx,ny,nz + integer(c_int):: endian,isigned,istatus,wordsize integer:: i,j,k integer:: iCell,iEdge,iVtx,iPoint,iTileStart,iTileEnd,jTileStart,jTileEnd integer,dimension(5) :: interp_list integer,dimension(:),allocatable :: nhs integer,dimension(:,:),allocatable:: ncat - real(kind=4):: scalefactor - real(kind=4),dimension(:,:,:),allocatable:: rarray + real(kind=c_float):: scalefactor + real(kind=c_float),dimension(:,:,:),pointer,contiguous :: rarray + type(c_ptr) :: rarray_ptr real(kind=RKIND):: start_lat real(kind=RKIND):: start_lon @@ -239,6 +261,8 @@ subroutine init_atm_static(mesh, dims, configs) nhs(:) = 0 ter(:) = 0.0 + rarray_ptr = c_loc(rarray) + start_lat = -89.99583 select case(trim(config_topo_data)) case('GTOPO30') @@ -266,8 +290,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//trim(geog_sub_path), & iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus, fname) @@ -326,6 +351,8 @@ subroutine init_atm_static(mesh, dims, configs) ncat(:,:) = 0 lu_index(:) = 0.0 + rarray_ptr = c_loc(rarray) + do jTileStart = 1,20401,ny jTileEnd = jTileStart + ny - 1 @@ -334,8 +361,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & trim(geog_sub_path),iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus, fname) @@ -390,6 +418,8 @@ subroutine init_atm_static(mesh, dims, configs) ncat(:,:) = 0 soilcat_top(:) = 0.0 + rarray_ptr = c_loc(rarray) + do jTileStart = 1,20401,ny jTileEnd = jTileStart + ny - 1 @@ -398,8 +428,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'soiltype_top_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus, fname) @@ -481,6 +512,8 @@ subroutine init_atm_static(mesh, dims, configs) allocate(soiltemp_1deg(-2:363,-2:183)) soiltemp(:) = 0.0 + rarray_ptr = c_loc(rarray) + call map_set(PROJ_LATLON, proj, & latinc = 1.0_RKIND, & loninc = 1.0_RKIND, & @@ -492,8 +525,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'soiltemp_1deg/',1,'-',180,'.',1,'-',180 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned, endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned, endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus, fname) soiltemp_1deg(-2:180,-2:183) = rarray(1:183,1:186,1) @@ -501,8 +535,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'soiltemp_1deg/',181,'-',360,'.',1,'-',180 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname, len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) soiltemp_1deg(181:363,-2:183) = rarray(4:186,1:186,1) @@ -554,6 +589,8 @@ subroutine init_atm_static(mesh, dims, configs) allocate(maxsnowalb(-2:363,-2:183)) snoalb(:) = 0.0 + rarray_ptr = c_loc(rarray) + call map_set(PROJ_LATLON, proj, & latinc = 1.0_RKIND, & loninc = 1.0_RKIND, & @@ -565,8 +602,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'maxsnowalb/',1,'-',180,'.',1,'-',180 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) maxsnowalb(-2:180,-2:183) = rarray(1:183,1:186,1) @@ -574,8 +612,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'maxsnowalb/',181,'-',360,'.',1,'-',180 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus, fname) maxsnowalb(181:363,-2:183) = rarray(4:186,1:186,1) @@ -628,6 +667,8 @@ subroutine init_atm_static(mesh, dims, configs) allocate(vegfra(-2:2503,-2:1253,12)) greenfrac(:,:) = 0.0 + rarray_ptr = c_loc(rarray) + call map_set(PROJ_LATLON, proj, & latinc = 0.144_RKIND, & loninc = 0.144_RKIND, & @@ -639,8 +680,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'greenfrac/',1,'-',1250,'.',1,'-',1250 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12) @@ -648,8 +690,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'greenfrac/',1251,'-',2500,'.',1,'-',1250 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12) @@ -699,6 +742,8 @@ subroutine init_atm_static(mesh, dims, configs) allocate(vegfra(-2:2503,-2:1253,12)) albedo12m(:,:) = 0.0 + rarray_ptr = c_loc(rarray) + call map_set(PROJ_LATLON, proj, & latinc = 0.144_RKIND, & loninc = 0.144_RKIND, & @@ -710,8 +755,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'albedo_ncep/',1,'-',1250,'.',1,'-',1250 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor, wordsize, istatus) call init_atm_check_read_error(istatus,fname) vegfra(-2:1250,-2:1253,1:12) = rarray(1:1253,1:1256,1:12) @@ -719,8 +765,9 @@ subroutine init_atm_static(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)// & 'albedo_ncep/',1251,'-',2500,'.',1,'-',1250 call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) vegfra(1251:2503,-2:1253,1:12) = rarray(4:1256,1:1256,1:12) @@ -769,6 +816,7 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) character(len=StrKIND) :: mess character(len=StrKIND) :: fname + character(kind=c_char), dimension(StrKIND+1) :: c_fname character(len=StrKIND) :: dir_gwdo character(len=StrKIND), pointer :: config_geog_data_path character(len=StrKIND+1) :: geog_data_path ! same as config_geog_data_path, but guaranteed to have a trailing slash @@ -779,15 +827,16 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) integer, dimension(:,:), pointer :: cellsOnCell integer, dimension(:), pointer :: landmask - integer:: nx,ny,nz - integer:: endian,isigned,istatus,wordsize + integer(c_int):: nx,ny,nz + integer(c_int):: endian,isigned,istatus,wordsize integer:: i,j integer:: iCell,iPoint,iTileStart,iTileEnd,jTileStart,jTileEnd integer,dimension(5) :: interp_list integer,dimension(:),allocatable:: nhs - real(kind=4):: scalefactor - real(kind=4),dimension(:,:,:),allocatable:: rarray + real(c_float):: scalefactor + real(c_float),dimension(:,:,:),pointer,contiguous :: rarray + type(c_ptr) :: rarray_ptr real(kind=RKIND):: lat,lon,x,y real(kind=RKIND):: lat_pt,lon_pt @@ -860,6 +909,9 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) allocate(nhs(nCells)) nhs(:) = 0 rarray(:,:,:) = 0._RKIND + + rarray_ptr = c_loc(rarray) + do jTileStart = 1,13801,ny jTileEnd = jTileStart + ny - 1 @@ -868,8 +920,9 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//'varsso/', & iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) @@ -1004,10 +1057,14 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/con/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + + rarray_ptr = c_loc(rarray) + + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1107,10 +1164,14 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/oa1/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + + rarray_ptr = c_loc(rarray) + + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1209,10 +1270,13 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/oa2/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1312,10 +1376,13 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/oa3/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1415,10 +1482,12 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/oa4/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1518,10 +1587,12 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/ol1/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1621,10 +1692,12 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/ol2/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1724,10 +1797,12 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/ol3/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1827,10 +1902,12 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/ol4/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) @@ -1930,11 +2007,13 @@ subroutine init_atm_static_orogwd(mesh, dims, configs) write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') & trim(geog_data_path)//trim(dir_gwdo)//'/var/',1,'-',nx,'.',1,'-',ny call mpas_log_write(trim(fname)) + call mpas_f_to_c_string(fname, c_fname) allocate(xarray(nx,ny)) allocate(rarray(nx,ny,nz)) - call read_geogrid(fname,len_trim(fname),rarray,nx,ny,nz,isigned,endian, & + rarray_ptr = c_loc(rarray) + call read_geogrid(c_fname,rarray_ptr,nx,ny,nz,isigned,endian, & scalefactor,wordsize,istatus) call init_atm_check_read_error(istatus,fname) xarray(1:nx,1:ny) = rarray(1:nx,1:ny,1) diff --git a/src/core_init_atmosphere/read_geogrid.c b/src/core_init_atmosphere/read_geogrid.c index ef783e208f..e6ffc6d305 100644 --- a/src/core_init_atmosphere/read_geogrid.c +++ b/src/core_init_atmosphere/read_geogrid.c @@ -9,10 +9,6 @@ Sample subroutine to read an array from the geogrid binary format. - Notes: Depending on the compiler and compiler flags, the name of - the read_geogrid() routine may need to be adjusted with respect - to the number of trailing underscores when calling from Fortran. - Michael G. Duda, NCAR/MMM */ @@ -20,27 +16,43 @@ #include #include -#ifdef UNDERSCORE -#define read_geogrid read_geogrid_ -#endif -#ifdef DOUBLEUNDERSCORE -#define read_geogrid read_geogrid__ -#endif #define GEOG_BIG_ENDIAN 0 #define GEOG_LITTLE_ENDIAN 1 +/* In Fortran, use the following as an interface for read_geogrid: + + use iso_c_binding, only : c_char, c_int, c_float, c_ptr, c_loc + + interface + subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, & + scalefactor, wordsize, status) bind(C) + use iso_c_binding, only : c_char, c_int, c_float, c_ptr + character (c_char), dimension(*), intent(in) :: fname + type (c_ptr), value :: rarray + integer (c_int), intent(in), value :: nx + integer (c_int), intent(in), value :: ny + integer (c_int), intent(in), value :: nz + integer (c_int), intent(in), value :: isigned + integer (c_int), intent(in), value :: endian + real (c_float), intent(in), value :: scalefactor + integer (c_int), intent(in), value :: wordsize + integer (c_int), intent(inout) :: status + end subroutine read_geogrid + end interface + +*/ + int read_geogrid( char * fname, /* The name of the file to read from */ - int * len, /* The length of the filename */ float * rarray, /* The array to be filled */ - int * nx, /* x-dimension of the array */ - int * ny, /* y-dimension of the array */ - int * nz, /* z-dimension of the array */ - int * isigned, /* 0=unsigned data, 1=signed data */ - int * endian, /* 0=big endian, 1=little endian */ - float * scalefactor, /* value to multiply array elements by before truncation to integers */ - int * wordsize, /* number of bytes to use for each array element */ + int nx, /* x-dimension of the array */ + int ny, /* y-dimension of the array */ + int nz, /* z-dimension of the array */ + int isigned, /* 0=unsigned data, 1=signed data */ + int endian, /* 0=big endian, 1=little endian */ + float scalefactor, /* value to multiply array elements by before truncation to integers */ + int wordsize, /* number of bytes to use for each array element */ int * status) { int i, ival, cnt, narray; @@ -48,27 +60,22 @@ int read_geogrid( int A3, B3, C3; int A4, B4, C4, D4; unsigned char * c; - char local_fname[1024]; FILE * bfile; *status = 0; - narray = (*nx) * (*ny) * (*nz); - - /* Make a null-terminated local copy of the filename */ - strncpy(local_fname,fname,*len); - local_fname[*len]='\0'; + narray = (nx) * (ny) * (nz); /* Attempt to open file for reading */ - if (!(bfile = fopen(local_fname,"rb"))) + if (!(bfile = fopen(fname,"rb"))) { *status = 1; return 1; } /* Allocate memory to hold bytes from file and read data */ - c = (unsigned char *)malloc(sizeof(unsigned char)*(*wordsize) * narray); - cnt = fread((void *)c, sizeof(unsigned char), narray*(*wordsize), bfile); + c = (unsigned char *)malloc(sizeof(unsigned char)* wordsize * narray); + cnt = fread((void *)c, sizeof(unsigned char), narray * wordsize, bfile); fclose(bfile); @@ -83,7 +90,7 @@ int read_geogrid( A, B, C, D give the offsets of the LSB through MSB (i.e., for word ABCD, A=MSB, D=LSB) in the array from the beginning of a word */ - if (*endian == GEOG_BIG_ENDIAN) { + if (endian == GEOG_BIG_ENDIAN) { A2 = 0; B2 = 1; A3 = 0; B3 = 1; C3 = 2; A4 = 0; B4 = 1; C4 = 2; D4 = 3; @@ -95,12 +102,12 @@ int read_geogrid( } /* Convert words from native byte order */ - switch(*wordsize) { + switch(wordsize) { case 1: for(i=0; i (1 << 7))) ival -= (1 << 8); + if ((isigned) && (ival > (1 << 7))) ival -= (1 << 8); rarray[i] = (float)ival; } break; @@ -109,7 +116,7 @@ int read_geogrid( for(i=0; i (1 << 15))) ival -= (1 << 16); + if ((isigned) && (ival > (1 << 15))) ival -= (1 << 16); rarray[i] = (float)ival; } break; @@ -118,7 +125,7 @@ int read_geogrid( for(i=0; i (1 << 23))) ival -= (1 << 24); + if ((isigned) * (ival > (1 << 23))) ival -= (1 << 24); rarray[i] = (float)ival; } break; @@ -127,7 +134,7 @@ int read_geogrid( for(i=0; i (1 << 31))) ival = -(~ival + 1); + if ((isigned) && (ival > (1 << 31))) ival = -(~ival + 1); rarray[i] = (float)ival; } break; @@ -136,10 +143,10 @@ int read_geogrid( free(c); /* Scale real-valued array by scalefactor */ - if (*scalefactor != 1.0) + if (scalefactor != 1.0) { for (i=0; i +/* In Fortran, use the following as an interface for compute_ev_2 and + compute_ev_3: + + interface + subroutine compute_ev_2(A, wr, wi) bind(C)!{{{ + use iso_c_binding, only: c_double + real (c_double), dimension(2,2) :: A + real (c_double), dimension(2) :: wr + real (c_double), dimension(2) :: wi + end subroutine compute_ev_2!}}} + end interface + + interface + subroutine compute_ev_3(A, wr, wi) bind(C)!{{{ + use iso_c_binding, only: c_double + real (c_double), dimension(3,3) :: A + real (c_double), dimension(3) :: wr + real (c_double), dimension(3) :: wi + end subroutine compute_ev_3!}}} + end interface + + */ -#ifdef UNDERSCORE -#define compute_ev_2 compute_ev_2_ -#define compute_ev_3 compute_ev_3_ -#else -#ifdef DOUBLEUNDERSCORE -#define compute_ev_2 compute_ev_2__ -#define compute_ev_3 compute_ev_3__ -#endif -#endif +#include #ifdef SINGLE_PRECISION typedef float real; diff --git a/src/framework/mpas_pool_routines.F b/src/framework/mpas_pool_routines.F index 6d99e56be3..5660c98cf6 100644 --- a/src/framework/mpas_pool_routines.F +++ b/src/framework/mpas_pool_routines.F @@ -3271,7 +3271,7 @@ subroutine mpas_pool_get_field_info(inPool, key, info)!{{{ info % isActive = .false. endl = len_trim(key) - call pool_hash(hash, key, endl) + call pool_hash(hash, key) hash = mod(hash, inPool % size) + 1 @@ -5703,7 +5703,7 @@ logical function pool_add_member(inPool, key, newmem)!{{{ integer :: hash, oldLevel type (mpas_pool_member_type), pointer :: ptr - call pool_hash(hash, trim(newmem % key), newmem % keylen) + call pool_hash(hash, trim(newmem % key)) hash = mod(hash, inPool % size) + 1 @@ -5762,7 +5762,7 @@ function pool_get_member(inPool, key, memType)!{{{ nullify(pool_get_member) endl = len_trim(key) - call pool_hash(hash, key, endl) + call pool_hash(hash, key) hash = mod(hash, inPool % size) + 1 @@ -5797,7 +5797,7 @@ logical function pool_remove_member(inPool, key, memType)!{{{ threadNum = mpas_threading_get_thread_num() endl = len_trim(key) - call pool_hash(hash, key, endl) + call pool_hash(hash, key) hash = mod(hash, inPool % size) + 1 @@ -5992,5 +5992,30 @@ integer function pool_get_member_decomp_type(dimName) result(decompType)!{{{ end function pool_get_member_decomp_type!}}} + subroutine pool_hash(hash, key)!{{{ + + use iso_c_binding, only : c_int, c_char + use mpas_c_interfacing, only : mpas_f_to_c_string + + implicit none + + interface + subroutine c_pool_hash(hash, key) bind(c) + use iso_c_binding, only : c_int, c_char + integer (c_int), intent(inout) :: hash + character (c_char), dimension(*), intent(in) :: key + end subroutine c_pool_hash + end interface + + integer (c_int), intent(inout) :: hash + character(len=*), intent(in) :: key + + character(kind=c_char), dimension(StrKIND+1) :: c_key + + call mpas_f_to_c_string(key, c_key) + call c_pool_hash(hash, c_key) + + end subroutine pool_hash!}}} + end module mpas_pool_routines diff --git a/src/framework/mpas_stream_manager.F b/src/framework/mpas_stream_manager.F index a74c0d643e..1ac973d7a7 100644 --- a/src/framework/mpas_stream_manager.F +++ b/src/framework/mpas_stream_manager.F @@ -104,6 +104,11 @@ subroutine MPAS_stream_mgr_init(manager, ioContext, clock, allFields, allPackage implicit none + interface + subroutine seed_random() bind(c) + end subroutine seed_random + end interface + character (len=*), parameter :: sub = 'MPAS_stream_mgr_init' type (MPAS_streamManager_type), pointer :: manager @@ -4148,8 +4153,19 @@ end subroutine mpas_build_stream_filename !}}} !----------------------------------------------------------------------- subroutine build_stream(stream, direction, allFields, allPackages, timeLevelIn, mgLevelIn, ierr) !{{{ + use iso_c_binding, only : c_int, c_char + use mpas_c_interfacing, only : mpas_c_to_f_string + implicit none + interface + subroutine gen_random(len, id) bind(c) + use iso_c_binding, only : c_int, c_char + integer (c_int), intent(in), value :: len + character (c_char), dimension(*), intent(inout) :: id + end subroutine gen_random + end interface + type (MPAS_stream_list_type), intent(inout) :: stream integer, intent(in) :: direction type (MPAS_Pool_type), intent(in) :: allFields @@ -4184,8 +4200,9 @@ subroutine build_stream(stream, direction, allFields, allPackages, timeLevelIn, integer :: local_ierr - integer, parameter :: idLength = 10 - character (len=idLength) :: file_id + integer (c_int), parameter :: idLength = 10 + character(len=idLength) :: f_file_id + character(kind=c_char), dimension(idLength+1) :: c_file_id character (len=StrKIND), pointer :: packages logical :: active_field @@ -4228,8 +4245,9 @@ subroutine build_stream(stream, direction, allFields, allPackages, timeLevelIn, ! ! Generate file_id and write to stream ! - call gen_random(idLength, file_id) - call mpas_writeStreamAtt(stream % stream, 'file_id', file_id, syncVal=.true., ierr=local_ierr) + call gen_random(idLength, c_file_id) + call mpas_c_to_f_string(c_file_id, f_file_id) + call mpas_writeStreamAtt(stream % stream, 'file_id', f_file_id, syncVal=.true., ierr=local_ierr) if (local_ierr /= MPAS_STREAM_NOERR) then ierr = MPAS_STREAM_MGR_ERROR return diff --git a/src/framework/pool_hash.c b/src/framework/pool_hash.c index a0930e91ae..ea305d6b05 100644 --- a/src/framework/pool_hash.c +++ b/src/framework/pool_hash.c @@ -1,21 +1,25 @@ -#include +#define NULL_CHARACTER '\0' -#ifdef UNDERSCORE -#define pool_hash pool_hash_ -#else -#ifdef DOUBLEUNDERSCORE -#define pool_hash pool_hash__ -#endif -#endif +/* + use iso_c_binding, only : c_int, c_char -void pool_hash(int* hash, char* key, int* len) + interface + subroutine c_pool_hash(hash, key) bind(c) + use iso_c_binding, only : c_int, c_char + integer (c_int), intent(inout) :: hash + character (c_char), dimension(*), intent(in) :: key + end subroutine c_pool_hash + end interface +*/ + +void c_pool_hash(int* hash, char* key) { int i; unsigned int whash; whash = 0; - for (i=0; i<(*len); i++) { + for (i=0; key[i] != NULL_CHARACTER; i++) { whash += (unsigned int)key[i]; } diff --git a/src/framework/random_id.c b/src/framework/random_id.c index 567bc51887..fdaf3e29d0 100644 --- a/src/framework/random_id.c +++ b/src/framework/random_id.c @@ -9,28 +9,37 @@ #include #include -#ifdef UNDERSCORE -#define gen_random gen_random_ -#define seed_random seed_random_ -#else -#ifdef DOUBLEUNDERSCORE -#define gen_random gen_random__ -#define seed_random seed_random__ -#endif -#endif +/* Use the following interface in Fortran for seed_random() + interface + subroutine seed_random() bind(c) + end subroutine seed_random + end interface + +*/ void seed_random() { srand(time(NULL)); } -void gen_random(int * len, char * id) {/*{{{*/ +/* Use the following interface in Fortran for gen_random() + + interface + subroutine gen_random(len, id) bind(c) + use iso_c_binding, only : c_int, c_char + integer (c_int), intent(in), value :: len + character (c_char), dimension(*), intent(inout) :: id + end subroutine gen_random + end interface + +*/ +void gen_random(int len, char * id) {/*{{{*/ int i; int r; static const char alphanum[] = "0123456789" "abcdefghijklmnopqrstuvwxyz"; - for (i = 0; i < *len; ++i) { + for (i = 0; i < len; ++i) { r = rand(); id[i] = alphanum[r % (sizeof(alphanum) - 1)]; }