Commit bf577626 authored by Florence Monna's avatar Florence Monna

fortran interface working for openmc

parent df67b7da
......@@ -17,18 +17,18 @@
#include "nrm.h"
int nrm_ctxt_create(struct nrm_context **ctxt)
struct nrm_context* nrm_ctxt_create(void)
{
struct nrm_context *ctxt;
ctxt = calloc(1, sizeof(struct nrm_context));
assert(ctxt != NULL);
*ctxt = calloc(1, sizeof(struct nrm_context));
assert(*ctxt != NULL);
return 0;
return ctxt;
}
int nrm_ctxt_delete(struct nrm_context **ctxt)
int nrm_ctxt_delete(struct nrm_context *ctxt)
{
assert(ctxt != NULL);
free(*ctxt);
free(ctxt);
return 0;
}
......@@ -37,11 +37,14 @@ int nrm_init(struct nrm_context *ctxt, const char *uuid)
assert(ctxt != NULL);
assert(uuid != NULL);
const char *uri = getenv(NRM_ENV_URI);
size_t buff_size;
if(uri == NULL)
uri = NRM_DEFAULT_URI;
ctxt->container_uuid = getenv("ARGO_CONTAINER_UUID");
assert(ctxt->container_uuid != NULL);
ctxt->app_uuid = (char *)uuid;
buff_size = strnlen(uuid, 255) + 1;
ctxt->app_uuid = malloc(buff_size*sizeof(char));
strncpy(ctxt->app_uuid, uuid, buff_size);
ctxt->context = zmq_ctx_new();
ctxt->socket = zmq_socket(ctxt->context, ZMQ_DEALER);
zmq_setsockopt(ctxt->socket, ZMQ_IDENTITY, ctxt->app_uuid, strnlen(uuid, 255));
......@@ -64,6 +67,7 @@ int nrm_fini(struct nrm_context *ctxt)
snprintf(buf, 512, NRM_EXIT_FORMAT, ctxt->app_uuid);
int err = zmq_send(ctxt->socket, buf, strnlen(buf, 512), 0);
assert(err > 0);
free(ctxt->app_uuid);
zmq_close(ctxt->socket);
zmq_ctx_destroy(ctxt->context);
return 0;
......
#include "nrm.h"
#include <stdlib.h>
#include <stdint.h>
int f_nrm_init_(void * *ctxt, char* uuid)
int f_nrm_ctxt_create_(uintptr_t *ctxt)
{
*ctxt = nrm_ctxt_create();
return 0;
}
return nrm_init(*ctxt, uuid);
int f_nrm_ctxt_delete_(uintptr_t *ctxt)
{
return nrm_ctxt_delete(*((struct nrm_context **)ctxt));
}
int f_nrm_init_(uintptr_t *ctxt, char* uuid_in, int* size)
{
char* uuid = calloc(*size+1, sizeof(char));
int i, err;
for (i = 0; i < *size; i++)
{
uuid[i] = uuid_in[i];
if (uuid_in[i] == ' ')
{
uuid[i] = 0;
i = *size;
}
}
uuid[*size] = 0;
err = nrm_init(*((struct nrm_context **)ctxt), uuid);
free(uuid);
return err;
}
int f_nrm_fini_(void* *ctxt)
int f_nrm_fini_(uintptr_t *ctxt)
{
return (int) nrm_fini(*ctxt);
return nrm_fini(*((struct nrm_context **)ctxt));
}
int f_nrm_send_progress_(void* *ctxt, unsigned long progress)
int f_nrm_send_progress_(uintptr_t *ctxt, unsigned long *progress)
{
return (int) nrm_send_progress(*ctxt, progress);
return nrm_send_progress(*((struct nrm_context **)ctxt), *progress);
}
int f_nrm_send_phase_context_(void* *ctxt, unsigned int cpu, unsigned int aggregation, unsigned long long int computeTime, unsigned long long int totalTime)
int f_nrm_send_phase_context_(uintptr_t *ctxt, unsigned int *cpu, unsigned int *aggregation, unsigned long long int *computeTime, unsigned long long int *totalTime)
{
return nrm_send_phase_context(*ctxt, cpu, aggregation, computeTime, totalTime);
return nrm_send_phase_context(*((struct nrm_context **)ctxt), *cpu, *aggregation, *computeTime, *totalTime);
}
integer NRM_PTR
parameter(NRM_PTR=8)
integer*8 f_nrm_ctxt_create
external f_nrm_ctxt_create
integer f_nrm_ctxt_delete
external f_nrm_ctxt_delete
integer*8 f_nrm_init
external f_nrm_init
integer f_nrm_fini
......
module fnrm
use ISO_C_BINDING
type, bind(C) :: f_nrm_context
type(c_ptr):: context
type(c_ptr):: socket
character(kind=c_char, len=1) :: container_uuid
character(kind=c_char, len=1) :: app_uuid
integer(c_int) :: time
real(c_double) :: acc
end type f_nrm_context
public :: f_nrm_context, f_nrm_init, f_nrm_fini, f_nrm_send_progress, f_nrm_send_phase_context
interface
function nrm_init_impl(ctxt, uuid) &
bind(c, name='nrm_init_wrapper')
use ISO_C_BINDING
import f_nrm_context
integer(c_int) :: nrm_init_impl
type(f_nrm_context), value :: ctxt
character(c_char), intent(in) :: uuid(*)
end function nrm_init_impl
end interface
interface
function nrm_fini_impl(ctxt) &
bind(c, name='nrm_fini_wrapper')
use ISO_C_BINDING
import f_nrm_context
integer(c_int) :: nrm_fini_impl
type(f_nrm_context) :: ctxt
end function nrm_fini_impl
end interface
interface
function nrm_send_progress_impl(ctxt, progress) &
bind(c, name='nrm_send_progress_wrapper')
use ISO_C_BINDING
import f_nrm_context
integer(c_int) :: nrm_send_progress_impl
type(f_nrm_context) :: ctxt
real(c_double) :: progress
end function nrm_send_progress_impl
end interface
interface
function nrm_send_phase_context_impl(ctxt, cpu, aggregation, computeTime, totalTime) &
bind(c, name='nrm_send_phase_context_wrapper')
use ISO_C_BINDING
import f_nrm_context
integer(c_int) :: nrm_send_phase_context_impl
type(f_nrm_context) :: ctxt
integer(c_int) :: cpu
integer(c_int) :: aggregation
real(c_double) :: computeTime
real(c_double) :: totalTime
end function nrm_send_phase_context_impl
end interface
contains
subroutine f_nrm_init(ctxt, uuid, err)
type(f_nrm_context), intent(inout) :: ctxt
character(len=*), intent(in):: uuid
integer, intent(out) :: err
character, target, dimension(1:len_trim(uuid)+1) :: uuid_c
integer :: ii, ll
ll = len_trim(uuid)
do ii = 1, ll
uuid_c(ii) = uuid(ii:ii)
end do
uuid_c(ll+1) = c_null_char
err = int(nrm_init_impl(ctxt, uuid_c))
end subroutine f_nrm_init
subroutine f_nrm_fini(ctxt,err)
type(f_nrm_context), intent(inout) :: ctxt
integer, intent(out) :: err
err= int(nrm_fini_impl(ctxt))
end subroutine f_nrm_fini
subroutine f_nrm_send_progress(ctxt, progress, err)
type(f_nrm_context), intent(inout) :: ctxt
real(8), intent(in) :: progress
integer, intent(out) :: err
err= int(nrm_send_progress_impl(ctxt, real(progress, c_double)))
end subroutine f_nrm_send_progress
subroutine f_nrm_send_phase_context(ctxt, cpu, aggregation, computeTime, totalTime, err)
type(f_nrm_context), intent(inout) :: ctxt
integer, intent(in) :: cpu, aggregation !to change in unsigned int
real(8), intent(in) :: computeTime, totalTime
integer, intent(out) :: err
err= int(nrm_send_phase_context_impl(ctxt, int(cpu, c_int), int(aggregation, c_int), &
real(computeTime, c_double), real(totalTime, c_double)))
end subroutine f_nrm_send_phase_context
end module fnrm
#include "nrm.h"
#include <stdlib.h>
int nrm_init_wrapper(struct nrm_context *ctxt, char* uuid)
{
return (int) nrm_init(ctxt, uuid);
}
int nrm_fini_wrapper(struct nrm_context *ctxt)
{
return (int) nrm_fini(ctxt);
}
int nrm_send_progress_wrapper(struct nrm_context *ctxt, unsigned long progress)
{
return (int) nrm_send_progress(ctxt, progress);
}
int nrm_send_phase_context_wrapper(struct nrm_context *ctxt, unsigned int cpu, unsigned int aggregation, unsigned long long int computeTime, unsigned long long int totalTime)
{
return (int) nrm_send_phase_context(ctxt, cpu, aggregation, computeTime, totalTime);
}
integer NRM_PTR
parameter(NRM_PTR=8)
integer*8 f_nrm_init
external f_nrm_init
integer f_nrm_fini
external f_nrm_fini
integer f_nrm_send_progress
external f_nrm_send_progress
integer f_nrm_send_phase_context
external f_nrm_send_phase_context
......@@ -36,8 +36,8 @@ struct nrm_context {
#define NRM_PHASE_CONTEXT_FORMAT "{\"api\":\"down_event\",\"type\":\"phase_context\", \"cpu\": %u, \"aggregation\": %u, \"computetime\": %llu, \"totaltime\": %llu, \"application_uuid\": \"%s\"}"
#define NRM_EXIT_FORMAT "{\"api\": \"down_event\", \"type\":\"application_exit\"}"
int nrm_ctxt_create(struct nrm_context **);
int nrm_ctxt_delete(struct nrm_context **);
struct nrm_context* nrm_ctxt_create(void);
int nrm_ctxt_delete(struct nrm_context *);
int nrm_init(struct nrm_context *, const char *);
int nrm_fini(struct nrm_context *);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment