@@ -401,9 +401,9 @@ writevars: $(OBJS_F) | |||
# ./write_vars config-remote.json | |||
debug: | |||
@echo "DEBUGGING" | |||
@echo "make with dynamic dlls" | |||
cc Redis/redis_io.c -c -o obj/redis_io.o | |||
$(FC) -o SimulationCore2_DEBUG $(FCFLAGS) $(OBJS_F) obj/redis_io.o lib/libjsonfortran.a lib/libhiredis.a SimulationCore2.f90 | |||
$(FC) -o SimulationCore2_DEBUG $(FCFLAGS) $(OBJS_F) obj/redis_io.o lib/libjsonfortran.a lib/libhiredis.so SimulationCore2.f90 | |||
$(OBJ_DIR)/%.o: %.f90 | |||
$(FC) $(FCFLAGS) -c -o $@ $< | |||
@@ -7,10 +7,10 @@ Module RedisInterface | |||
INTEGER(C_INT) :: a, b | |||
END SUBROUTINE addnums | |||
SUBROUTINE initConnection_C(address,port,password,datakey) BIND(C, name='initConnection') | |||
SUBROUTINE initConnection_C(address,port,password,datakey,status) BIND(C, name='initConnection') | |||
use iso_c_binding, only: c_char,c_int | |||
character(kind=c_char) :: address(*) | |||
integer(kind=c_int)::port | |||
integer(kind=c_int)::port,status | |||
character(kind=c_char) :: password(*),datakey(*) | |||
END SUBROUTINE initConnection_C | |||
@@ -33,11 +33,11 @@ Module RedisInterface | |||
contains | |||
SUBROUTINE initConnection(configFilename) | |||
SUBROUTINE initConnection(configFilename,status) | |||
use json_module | |||
use iso_c_binding, only: c_null_char,c_char | |||
character(len=*) :: configFilename | |||
integer::port | |||
integer::port,status | |||
type(json_file) :: jsonfile | |||
type(json_value),pointer :: jsonvalue,jsonvalue2 | |||
type(json_core) :: jsoncore | |||
@@ -45,13 +45,13 @@ Module RedisInterface | |||
character(len=:),allocatable::c_address,c_password,c_datakey | |||
call jsonfile%initialize() | |||
print *,"Initilized: ",configFilename | |||
print *,"Initilized: simulation with ",configFilename | |||
call jsonfile%load_file(configFilename); | |||
if (jsonfile%failed()) then | |||
print *,"can not open config file: ",configFilename ; | |||
stop | |||
endif | |||
print *,"file read" | |||
! print *,"file read" | |||
call jsonfile%json_file_get_root(jsonvalue) | |||
call jsoncore%get(jsonvalue,'redis',jsonvalue2) | |||
call jsoncore%get(jsonvalue2,"address",address); | |||
@@ -62,33 +62,35 @@ Module RedisInterface | |||
c_datakey = datakey//c_null_char | |||
c_password = password//c_null_char | |||
c_address = address//c_null_char | |||
call initConnection_C(c_address,port,c_password,c_datakey) | |||
call initConnection_C(c_address,port,c_password,c_datakey,status) | |||
! print *,"returned to initConnection" | |||
END SUBROUTINE initConnection | |||
SUBROUTINE setData(str) | |||
use SimulationVariables | |||
use iso_c_binding, only: c_null_char | |||
character(len=*):: str | |||
character(len=len_trim(str)+1)::c_str | |||
character(len=4)::part | |||
part = "out"//c_null_char | |||
c_str = str//c_null_char | |||
print *,"setting Data: ",len_trim(str) | |||
if(logging>4) print *,"setting Data: ",len_trim(str) | |||
call setData_C(part,c_str) | |||
END SUBROUTINE setData | |||
SUBROUTINE setInput(str) | |||
use SimulationVariables | |||
use iso_c_binding, only: c_null_char | |||
character(len=*):: str | |||
character(len=len_trim(str)+1)::c_str | |||
character(len=4)::part | |||
part = "in"//c_null_char | |||
c_str = str//c_null_char | |||
print *,"setting Data: ",len_trim(str) | |||
if(logging>4) print *,"setting Data: ",len_trim(str) | |||
call setData_C(part,c_str) | |||
END SUBROUTINE setInput | |||
SUBROUTINE getData(string) !result(string) | |||
SUBROUTINE getData(string) | |||
use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr | |||
! character(:),allocatable :: getData2 | |||
character(:),allocatable :: string | |||
@@ -96,9 +98,9 @@ Module RedisInterface | |||
type(c_ptr) :: c_string | |||
integer::l | |||
l = 30000 | |||
print *,"reading data l=",l | |||
! print *,"reading data l=",l | |||
c_string = getData_C(l) | |||
print *,"data read. l=",l | |||
! print *,"data read. l=",l | |||
! len = int(c_len,kind=kind(len)) | |||
string_shape(1) = l!int(l,kind=kind(Integer)) | |||
if(.not. allocated(string)) then | |||
@@ -113,24 +115,24 @@ Module RedisInterface | |||
! getData2=string | |||
END SUBROUTINE getData | |||
SUBROUTINE getData2(string) !result(string) | |||
use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr | |||
! character(:),allocatable :: getData2 | |||
character(:),allocatable :: string | |||
integer :: string_shape(1) | |||
type(c_ptr) :: c_string | |||
integer::l | |||
! print *,"reading data (getData2)" | |||
c_string = getData_C(l) | |||
! string = c_str | |||
! len = int(c_len,kind=kind(len)) | |||
string_shape(1) = l! int(l,kind=kind(integer)) | |||
if(.not. allocated(string)) allocate(character(l) :: string) | |||
call c_f_pointer(c_string, string, string_shape) | |||
c_string=c_null_ptr | |||
! print *,len_trim(string), "chars read." | |||
! print *,string(1:l) | |||
! getData2=string | |||
END SUBROUTINE getData2 | |||
! SUBROUTINE getData2(string) !result(string) | |||
! use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr | |||
! ! character(:),allocatable :: getData2 | |||
! character(:),allocatable :: string | |||
! integer :: string_shape(1) | |||
! type(c_ptr) :: c_string | |||
! integer::l | |||
! ! print *,"reading data (getData2)" | |||
! c_string = getData_C(l) | |||
! ! string = c_str | |||
! ! len = int(c_len,kind=kind(len)) | |||
! string_shape(1) = l! int(l,kind=kind(integer)) | |||
! if(.not. allocated(string)) allocate(character(l) :: string) | |||
! call c_f_pointer(c_string, string, string_shape) | |||
! c_string=c_null_ptr | |||
! ! print *,len_trim(string), "chars read." | |||
! ! print *,string(1:l) | |||
! ! getData2=string | |||
! END SUBROUTINE getData2 | |||
END Module RedisInterface |
@@ -8,10 +8,10 @@ Module RedisInterface | |||
INTEGER(C_INT) :: a, b | |||
END SUBROUTINE addnums | |||
SUBROUTINE initConnection_C(address,port,password,datakey) BIND(C, name='initConnection') | |||
SUBROUTINE initConnection_C(address,port,password,datakey,status) BIND(C, name='initConnection') | |||
use iso_c_binding, only: c_char,c_int | |||
character(kind=c_char) :: address(*) | |||
integer(kind=c_int)::port | |||
integer(kind=c_int)::port,status | |||
character(kind=c_char) :: password(*),datakey(*) | |||
END SUBROUTINE initConnection_C | |||
@@ -34,11 +34,11 @@ Module RedisInterface | |||
contains | |||
SUBROUTINE initConnection(configFilename) | |||
SUBROUTINE initConnection(configFilename,status) | |||
use json_module | |||
use iso_c_binding, only: c_null_char,c_char | |||
character(len=*) :: configFilename | |||
integer::port | |||
integer::port,status | |||
type(json_file) :: jsonfile | |||
type(json_value),pointer :: jsonvalue,jsonvalue2 | |||
type(json_core) :: jsoncore | |||
@@ -46,13 +46,13 @@ Module RedisInterface | |||
character(len=:),allocatable::c_address,c_password,c_datakey | |||
call jsonfile%initialize() | |||
print *,"Initilized: ",configFilename | |||
print *,"Initilized: simulation with ",configFilename | |||
call jsonfile%load_file(configFilename); | |||
if (jsonfile%failed()) then | |||
print *,"can not open config file: ",configFilename ; | |||
stop | |||
endif | |||
print *,"file read" | |||
! print *,"file read" | |||
call jsonfile%json_file_get_root(jsonvalue) | |||
call jsoncore%get(jsonvalue,'redis',jsonvalue2) | |||
call jsoncore%get(jsonvalue2,"address",address); | |||
@@ -63,33 +63,35 @@ Module RedisInterface | |||
c_datakey = datakey//c_null_char | |||
c_password = password//c_null_char | |||
c_address = address//c_null_char | |||
call initConnection_C(c_address,port,c_password,c_datakey) | |||
call initConnection_C(c_address,port,c_password,c_datakey,status) | |||
! print *,"returned to initConnection" | |||
END SUBROUTINE initConnection | |||
SUBROUTINE setData(str) | |||
use SimulationVariables | |||
use iso_c_binding, only: c_null_char | |||
character(len=*):: str | |||
character(len=len_trim(str)+1)::c_str | |||
character(len=4)::part | |||
part = "out"//c_null_char | |||
c_str = str//c_null_char | |||
print *,"setting Data: ",len_trim(str) | |||
if(logging>4) print *,"setting Data: ",len_trim(str) | |||
call setData_C(part,c_str) | |||
END SUBROUTINE setData | |||
SUBROUTINE setInput(str) | |||
use SimulationVariables | |||
use iso_c_binding, only: c_null_char | |||
character(len=*):: str | |||
character(len=len_trim(str)+1)::c_str | |||
character(len=4)::part | |||
part = "in"//c_null_char | |||
c_str = str//c_null_char | |||
print *,"setting Data: ",len_trim(str) | |||
if(logging>4) print *,"setting Data: ",len_trim(str) | |||
call setData_C(part,c_str) | |||
END SUBROUTINE setInput | |||
SUBROUTINE getData(string) !result(string) | |||
SUBROUTINE getData(string) | |||
use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr | |||
! character(:),allocatable :: getData2 | |||
character(:),allocatable :: string | |||
@@ -97,9 +99,9 @@ Module RedisInterface | |||
type(c_ptr) :: c_string | |||
integer::l | |||
l = 30000 | |||
print *,"reading data l=",l | |||
! print *,"reading data l=",l | |||
c_string = getData_C(l) | |||
print *,"data read. l=",l | |||
! print *,"data read. l=",l | |||
! len = int(c_len,kind=kind(len)) | |||
string_shape(1) = l!int(l,kind=kind(Integer)) | |||
if(.not. allocated(string)) then | |||
@@ -114,24 +116,24 @@ Module RedisInterface | |||
! getData2=string | |||
END SUBROUTINE getData | |||
SUBROUTINE getData2(string) !result(string) | |||
use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr | |||
! character(:),allocatable :: getData2 | |||
character(:),allocatable :: string | |||
integer :: string_shape(1) | |||
type(c_ptr) :: c_string | |||
integer::l | |||
! print *,"reading data (getData2)" | |||
c_string = getData_C(l) | |||
! string = c_str | |||
! len = int(c_len,kind=kind(len)) | |||
string_shape(1) = l! int(l,kind=kind(integer)) | |||
if(.not. allocated(string)) allocate(character(l) :: string) | |||
call c_f_pointer(c_string, string, string_shape) | |||
c_string=c_null_ptr | |||
! print *,len_trim(string), "chars read." | |||
! print *,string(1:l) | |||
! getData2=string | |||
END SUBROUTINE getData2 | |||
! SUBROUTINE getData2(string) !result(string) | |||
! use iso_c_binding, only: c_char,c_ptr,c_f_pointer,c_null_ptr | |||
! ! character(:),allocatable :: getData2 | |||
! character(:),allocatable :: string | |||
! integer :: string_shape(1) | |||
! type(c_ptr) :: c_string | |||
! integer::l | |||
! ! print *,"reading data (getData2)" | |||
! c_string = getData_C(l) | |||
! ! string = c_str | |||
! ! len = int(c_len,kind=kind(len)) | |||
! string_shape(1) = l! int(l,kind=kind(integer)) | |||
! if(.not. allocated(string)) allocate(character(l) :: string) | |||
! call c_f_pointer(c_string, string, string_shape) | |||
! c_string=c_null_ptr | |||
! ! print *,len_trim(string), "chars read." | |||
! ! print *,string(1:l) | |||
! ! getData2=string | |||
! END SUBROUTINE getData2 | |||
END Module RedisInterface |
@@ -11,9 +11,9 @@ void addnums( int* a, int* b ) | |||
printf("sum of %i and %i is %i\n", (*a), (*b), c ); | |||
} | |||
void initConnection(char *address, int *port,char * password,char *datakey) | |||
void initConnection(char *address, int *port,char * password,char *datakey,int *returnValue) | |||
{ | |||
printf("Intializing Connection with %s@%s:%d\n",password,address,*port); | |||
// printf("Intializing Connection with %s@%s:%d\n",password,address,*port); | |||
context = redisConnect(address,*port);//"127.0.0.1", 6379); | |||
if (context == NULL || context->err) { | |||
if (context) { | |||
@@ -22,6 +22,8 @@ void initConnection(char *address, int *port,char * password,char *datakey) | |||
} else { | |||
printf("Can't allocate redis context\n"); | |||
} | |||
(*returnValue) = -1; | |||
return; | |||
} | |||
printf("Connection Stablished to %s\n",address); | |||
if(strlen(password)>0) | |||
@@ -29,17 +31,18 @@ void initConnection(char *address, int *port,char * password,char *datakey) | |||
redisReply *reply= redisCommand(context, "AUTH %s", password); | |||
if (reply->type == REDIS_REPLY_ERROR) { | |||
printf("Authentication failed.\n"); | |||
(*returnValue) = -1; | |||
return; | |||
} | |||
else { | |||
printf("Authentication is done.\n"); | |||
} | |||
freeReplyObject(reply); | |||
(*returnValue) = 1; | |||
} | |||
// key = datakey; | |||
key = malloc(sizeof(char) * (strlen(datakey)+1)); | |||
strcpy(key,datakey); | |||
// printf("datakey = %s with len %ld\n",datakey,strlen(datakey)); | |||
// printf("..."); | |||
} | |||
void setData(char *part, char *data) | |||
@@ -53,19 +56,18 @@ void setData(char *part, char *data) | |||
char *getData(int *len) | |||
{ | |||
redisReply *reply; | |||
printf("reading data from redis (key=%s)\n",key); | |||
// printf("reading data from redis (key=%s)\n",key); | |||
reply = redisCommand(context, "GET %s.in",key); | |||
printf("data read from redis: %ld chars\n",strlen(reply->str)); | |||
printf("len(reply->str): %ld\n",strlen(reply->str)); | |||
// printf("data read from redis: %ld chars\n",strlen(reply->str)); | |||
// printf("len(reply->str): %ld\n",strlen(reply->str)); | |||
// result = (char*) malloc(strlen(reply->str)); | |||
result = (char*) malloc(*len); | |||
printf("after malloc"); | |||
// printf("after malloc"); | |||
strcpy(result,reply->str); | |||
*len = strlen(result); | |||
printf("before free"); | |||
// printf("before free"); | |||
freeReplyObject(reply); | |||
printf("after free"); | |||
// printf("after free"); | |||
return result; | |||
} | |||
@@ -82,15 +82,19 @@ module Simulator | |||
subroutine Simulate(configFilename) | |||
character(*)::configFilename | |||
integer::t0,t1,t2,t3,t_read=0,t_write=0,t_exec=0,i | |||
integer::t0,t1,t2,t3,t_read=0,t_write=0,t_exec=0,i,status | |||
integer,dimension(12)::t,t_modules | |||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | |||
do i=1,size(t_modules) | |||
t_modules(i)=0 | |||
end do | |||
print *,"config-file at Simulate = ",configFilename | |||
call initSimulation(configFilename) | |||
call initConnection(configFilename) | |||
call initConnection(configFilename,status) | |||
if (status<0) then | |||
print *,"Can not init connection to redis." | |||
stop | |||
endif | |||
call read_configuration() | |||
! call read_variables() | |||
print *,"connection initialized" | |||
@@ -99,10 +103,10 @@ module Simulator | |||
! call cpu_time(T1) | |||
simulationStep = 1 | |||
do while (.true.) | |||
print *,"simulationStep=",simulationStep | |||
! print *,"simulationStep=",simulationStep | |||
call date_and_time(values=timearray) | |||
t0 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
print *,"start reading." | |||
! print *,"start reading." | |||
call read_variables() | |||
if(simulationStatus==PLAY_TO_DETERMINED_TIME .and. simulationStep>simulationEnd) exit | |||
if(simulationStatus==STOP) exit | |||
@@ -111,7 +115,7 @@ module Simulator | |||
call date_and_time(values=timearray) | |||
t1 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
t_read = t_read+t1-t0 | |||
print *,"read completed" | |||
if(logging>4) print *,"read completed" | |||
!! Rafiee, nothing changed | |||
call BopStack_Step() | |||
call date_and_time(values=timearray) | |||
@@ -196,12 +200,11 @@ module Simulator | |||
t_exec = t_exec+t2-t1 | |||
! call date_and_time(values=timearray) | |||
! t0 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
print *,"exec completed" | |||
call write_variables() | |||
call date_and_time(values=timearray) | |||
t3 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
t_write = t_write+t3-t2 | |||
print *,"write completed" | |||
! print *,"write completed" | |||
! print *,"t=",t | |||
simulationStep = simulationStep + 1 | |||
end do | |||
@@ -230,17 +233,16 @@ module Simulator | |||
! character(len=:),allocatable::c_address,c_password,c_datakey | |||
call jsonfile%initialize() | |||
print *,"init simulation with ",configFilename | |||
! print *,"init simulation with ",configFilename | |||
call jsonfile%load_file(configFilename); | |||
if (jsonfile%failed()) then | |||
print *,"can not open config file: ",configFilename ; | |||
stop | |||
endif | |||
print *,"file read" | |||
! print *,"file read" | |||
call jsonfile%json_file_get_root(jsonvalue) | |||
call jsoncore%get(jsonvalue,'logging',logging) | |||
print *,"logging=",logging | |||
print *,"simulationEnd =",simulationEnd | |||
end subroutine | |||
subroutine write_variables() | |||
@@ -264,25 +266,25 @@ module Simulator | |||
! call ProblemsToJson(jsonroot) | |||
call EquipmentsToJson(jsonroot) | |||
print *,"write starts" | |||
! print *,"write starts" | |||
write (fn,*) "data",simulationStep | |||
! call json%print(jsonroot,trim(fn)//".json") | |||
call json%serialize(jsonroot,redisInput) | |||
! call compress_string(redisContent) | |||
print *,"Writing to redis:",len(redisInput) | |||
if(logging>4) print *,"Writing to redis:",len(redisInput) | |||
call setData(redisInput) | |||
! nullify(redisContent) | |||
! deallocate(redisContent) | |||
! call json%destroy(pval) | |||
call json%destroy(jsonroot) | |||
print *,"write ends" | |||
! print *,"write ends" | |||
end subroutine | |||
subroutine read_configuration() | |||
type(json_value),pointer :: jsonroot | |||
type(json_value),pointer :: pval | |||
call getData(redisOutput) | |||
print *,len(redisOutput)," bytes read from redis" | |||
! print *,len(redisOutput)," bytes read from redis" | |||
open(1,file="redisContent.json",status="REPLACE") | |||
write(1,"(A)") redisOutput | |||
close(1) | |||
@@ -316,7 +318,8 @@ module Simulator | |||
type(json_value),pointer :: jsonroot,pval | |||
call getData(redisOutput) | |||
print *,len(redisOutput)," bytes read from redis" | |||
! print *,len(redisOutput)," bytes read from redis" | |||
! open(1,file="redisContent.json",status="REPLACE") | |||
! write(1,"(A)") redisContent | |||
! close(1) | |||
@@ -335,6 +338,7 @@ module Simulator | |||
msPerStep = 100/simulationSpeed | |||
call json%get(jsonroot,'endstep',pval) | |||
call json%get(pval,simulationEnd) | |||
print *,simulationStep,"/",simulationEnd | |||
! call ConfigurationFromJson(jsonroot) | |||
! call WarningsFromJson(jsonroot) | |||
call ProblemsFromJson(jsonroot) | |||
@@ -83,15 +83,19 @@ module Simulator | |||
subroutine Simulate(configFilename) | |||
character(*)::configFilename | |||
integer::t0,t1,t2,t3,t_read=0,t_write=0,t_exec=0,i | |||
integer::t0,t1,t2,t3,t_read=0,t_write=0,t_exec=0,i,status | |||
integer,dimension(12)::t,t_modules | |||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | |||
do i=1,size(t_modules) | |||
t_modules(i)=0 | |||
end do | |||
print *,"config-file at Simulate = ",configFilename | |||
call initSimulation(configFilename) | |||
call initConnection(configFilename) | |||
call initConnection(configFilename,status) | |||
if (status<0) then | |||
print *,"Can not init connection to redis." | |||
stop | |||
endif | |||
call read_configuration() | |||
! call read_variables() | |||
print *,"connection initialized" | |||
@@ -100,10 +104,10 @@ module Simulator | |||
! call cpu_time(T1) | |||
simulationStep = 1 | |||
do while (.true.) | |||
print *,"simulationStep=",simulationStep | |||
! print *,"simulationStep=",simulationStep | |||
call date_and_time(values=timearray) | |||
t0 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
print *,"start reading." | |||
! print *,"start reading." | |||
call read_variables() | |||
if(simulationStatus==PLAY_TO_DETERMINED_TIME .and. simulationStep>simulationEnd) exit | |||
if(simulationStatus==STOP) exit | |||
@@ -112,7 +116,7 @@ module Simulator | |||
call date_and_time(values=timearray) | |||
t1 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
t_read = t_read+t1-t0 | |||
print *,"read completed" | |||
if(logging>4) print *,"read completed" | |||
!! Rafiee, nothing changed | |||
call BopStack_Step() | |||
call date_and_time(values=timearray) | |||
@@ -197,12 +201,11 @@ module Simulator | |||
t_exec = t_exec+t2-t1 | |||
! call date_and_time(values=timearray) | |||
! t0 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
print *,"exec completed" | |||
call write_variables() | |||
call date_and_time(values=timearray) | |||
t3 = timearray(8)+timearray(7)*1000+timearray(6)*60000 | |||
t_write = t_write+t3-t2 | |||
print *,"write completed" | |||
! print *,"write completed" | |||
! print *,"t=",t | |||
simulationStep = simulationStep + 1 | |||
end do | |||
@@ -231,17 +234,16 @@ module Simulator | |||
! character(len=:),allocatable::c_address,c_password,c_datakey | |||
call jsonfile%initialize() | |||
print *,"init simulation with ",configFilename | |||
! print *,"init simulation with ",configFilename | |||
call jsonfile%load_file(configFilename); | |||
if (jsonfile%failed()) then | |||
print *,"can not open config file: ",configFilename ; | |||
stop | |||
endif | |||
print *,"file read" | |||
! print *,"file read" | |||
call jsonfile%json_file_get_root(jsonvalue) | |||
call jsoncore%get(jsonvalue,'logging',logging) | |||
print *,"logging=",logging | |||
print *,"simulationEnd =",simulationEnd | |||
end subroutine | |||
subroutine write_variables() | |||
@@ -265,25 +267,25 @@ module Simulator | |||
! call ProblemsToJson(jsonroot) | |||
call EquipmentsToJson(jsonroot) | |||
print *,"write starts" | |||
! print *,"write starts" | |||
write (fn,*) "data",simulationStep | |||
! call json%print(jsonroot,trim(fn)//".json") | |||
call json%serialize(jsonroot,redisInput) | |||
! call compress_string(redisContent) | |||
print *,"Writing to redis:",len(redisInput) | |||
if(logging>4) print *,"Writing to redis:",len(redisInput) | |||
call setData(redisInput) | |||
! nullify(redisContent) | |||
! deallocate(redisContent) | |||
! call json%destroy(pval) | |||
call json%destroy(jsonroot) | |||
print *,"write ends" | |||
! print *,"write ends" | |||
end subroutine | |||
subroutine read_configuration() | |||
type(json_value),pointer :: jsonroot | |||
type(json_value),pointer :: pval | |||
call getData(redisOutput) | |||
print *,len(redisOutput)," bytes read from redis" | |||
! print *,len(redisOutput)," bytes read from redis" | |||
open(1,file="redisContent.json",status="REPLACE") | |||
write(1,"(A)") redisOutput | |||
close(1) | |||
@@ -317,7 +319,8 @@ module Simulator | |||
type(json_value),pointer :: jsonroot,pval | |||
call getData(redisOutput) | |||
print *,len(redisOutput)," bytes read from redis" | |||
! print *,len(redisOutput)," bytes read from redis" | |||
! open(1,file="redisContent.json",status="REPLACE") | |||
! write(1,"(A)") redisContent | |||
! close(1) | |||
@@ -336,6 +339,7 @@ module Simulator | |||
msPerStep = 100/simulationSpeed | |||
call json%get(jsonroot,'endstep',pval) | |||
call json%get(pval,simulationEnd) | |||
print *,simulationStep,"/",simulationEnd | |||
! call ConfigurationFromJson(jsonroot) | |||
! call WarningsFromJson(jsonroot) | |||
call ProblemsFromJson(jsonroot) | |||
@@ -1,9 +0,0 @@ | |||
{ | |||
"redis":{ | |||
"address":"aberama.iran.liara.ir", | |||
"port":32815, | |||
"password":"4YKFnubfFFjfh4yTK7b0Rg9X", | |||
"datakey":"data" | |||
}, | |||
"logging":5 | |||
} |
@@ -5,5 +5,5 @@ | |||
"password":"4YKFnubfFFjfh4yTK7b0Rg9X", | |||
"datakey":"data" | |||
}, | |||
"logging":5 | |||
"logging":4 | |||
} |
@@ -1,11 +1,33 @@ | |||
{ | |||
"status": 4, | |||
"speed": 1, | |||
"speed": 0, | |||
"endstep": 10, | |||
"step": 36, | |||
"Configuration": { | |||
"StringConfiguration": { | |||
"StringConfigurationItems": [], | |||
"StringConfigurationItems": [ | |||
{ | |||
"ComponentLength": 0.88931816251424378E-322, | |||
"ComponentType": 0, | |||
"Grade": "A", | |||
"LengthPerJoint": 0.0E+0, | |||
"NominalId": 0.0E+0, | |||
"NominalOd": 0.0E+0, | |||
"NominalToolJointOd": 0.0E+0, | |||
"NumberOfJoint": 0.0E+0, | |||
"WeightPerLength": 0.0E+0 | |||
}, | |||
{ | |||
"ComponentLength": 0.0E+0, | |||
"ComponentType": 0, | |||
"Grade": "B", | |||
"LengthPerJoint": 0.0E+0, | |||
"NominalId": 0.0E+0, | |||
"NominalOd": 0.0E+0, | |||
"NominalToolJointOd": 0.63240402667679558E-321, | |||
"NumberOfJoint": 0.0E+0, | |||
"WeightPerLength": 0.0E+0 | |||
} | |||
], | |||
"BitDefenition": { | |||
"BitCodeHundreds": 0, | |||
"BitCodeOnes": 0, | |||
@@ -19,11 +41,28 @@ | |||
"FloatValve": false | |||
} | |||
}, | |||
"Formations": [], | |||
"Formations": [ | |||
{ | |||
"Abrasiveness": 0.21312660155733048E-263, | |||
"Drillablity": 0.6320758923451116E-66, | |||
"PorePressureGradient": 0.28008646127460173E-84, | |||
"Thickness": 0.65823145377002607E+181, | |||
"ThresholdWeight": 0.19550125239880232E+209, | |||
"Top": 0.0E+0 | |||
}, | |||
{ | |||
"Abrasiveness": 0.43520275400635665E+252, | |||
"Drillablity": 0.9083672029223863E+224, | |||
"PorePressureGradient": 0.81573800331711587E-42, | |||
"Thickness": 0.51434297357626681E+171, | |||
"ThresholdWeight": 0.1490043928945281E+196, | |||
"Top": 0.1E+4 | |||
} | |||
], | |||
"Reservoir": { | |||
"AutoMigrationRate": 0.0E+0, | |||
"FluidGradient": 0.0E+0, | |||
"FluidType": 0, | |||
"FluidGradient": 0.49406564584124654E-323, | |||
"FluidType": 1073741952, | |||
"FluidViscosity": 0.0E+0, | |||
"FormationNo": 0, | |||
"FormationPermeability": 0.0E+0, | |||
@@ -43,13 +82,13 @@ | |||
"ShoeDepth": 0.0E+0 | |||
}, | |||
"Accumulator": { | |||
"AccumulatorMinimumOperatingPressure": 0.0E+0, | |||
"AccumulatorMinimumOperatingPressure": 0.49406564584124654E-323, | |||
"AccumulatorSystemSize": 0.0E+0, | |||
"AirPlungerPumpOutput": 0.0E+0, | |||
"ElectricPumpOutput": 0.0E+0, | |||
"NumberOfBottels": 0, | |||
"OilTankVolume": 0.0E+0, | |||
"PrechargePressure": 0.0E+0, | |||
"NumberOfBottels": 1, | |||
"OilTankVolume": 0.98813129168249309E-323, | |||
"PrechargePressure": 0.35572726500569751E-321, | |||
"StartPressure": 0.0E+0, | |||
"StartPressure2": 0.0E+0, | |||
"StopPressure": 0.0E+0, | |||
@@ -62,22 +101,22 @@ | |||
"AnnularPreventerOpen": 0.0E+0, | |||
"AnnularStringDrag": 0.0E+0, | |||
"BlindRamClose": 0.0E+0, | |||
"BlindRamHeight": 0.0E+0, | |||
"BlindRamHeight": 0.23715151000379834E-321, | |||
"BlindRamOpen": 0.0E+0, | |||
"ChokeClose": 0.0E+0, | |||
"ChokeLineId": 0.0E+0, | |||
"ChokeLineLength": 0.0E+0, | |||
"ChokeOpen": 0.0E+0, | |||
"ChokeOpen": 0.49406564584124654E-323, | |||
"GroundLevel": 0.0E+0, | |||
"KillClose": 0.0E+0, | |||
"KillClose": 0.49406564584124654E-323, | |||
"KillHeight": 0.0E+0, | |||
"KillOpen": 0.0E+0, | |||
"LowerRamClose": 0.0E+0, | |||
"LowerRamHeight": 0.0E+0, | |||
"LowerRamOpen": 0.0E+0, | |||
"KillOpen": 0.53049901345204898E-314, | |||
"LowerRamClose": 0.23715151000379834E-321, | |||
"LowerRamHeight": 0.11419335319803565E-315, | |||
"LowerRamOpen": 0.98813129168249309E-323, | |||
"RamStringDrag": 0.0E+0, | |||
"UpperRamClose": 0.0E+0, | |||
"UpperRamHeight": 0.0E+0, | |||
"UpperRamHeight": 0.98813129168249309E-323, | |||
"UpperRamOpen": 0.0E+0 | |||
}, | |||
"Hoisting": { | |||
@@ -102,19 +141,19 @@ | |||
"MudPump1LinerDiameter": 0.0E+0, | |||
"MudPump1Stroke": 0.0E+0, | |||
"MudPump1MechanicalEfficiency": 0.0E+0, | |||
"MudPump1VolumetricEfficiency": 0.0E+0, | |||
"MudPump1Output": 0.0E+0, | |||
"MudPump1OutputBblStroke": 0.0E+0, | |||
"MudPump1Maximum": 0.0E+0, | |||
"MudPump1ReliefValvePressure": 0.6E+4, | |||
"MudPump2LinerDiameter": 0.0E+0, | |||
"MudPump2Stroke": 0.0E+0, | |||
"MudPump2MechanicalEfficiency": 0.0E+0, | |||
"MudPump2VolumetricEfficiency": 0.0E+0, | |||
"MudPump1VolumetricEfficiency": 0.1E+2, | |||
"MudPump1Output": 0.10199999999999999E+2, | |||
"MudPump1OutputBblStroke": 0.14632E+2, | |||
"MudPump1Maximum": 0.21350000000000001E+2, | |||
"MudPump1ReliefValvePressure": 0.16239999999999998E+2, | |||
"MudPump2LinerDiameter": 0.18800000000000001E+2, | |||
"MudPump2Stroke": 0.15E+1, | |||
"MudPump2MechanicalEfficiency": 0.15E+1, | |||
"MudPump2VolumetricEfficiency": 0.3E+2, | |||
"MudPump2Output": 0.0E+0, | |||
"MudPump2OutputBblStroke": 0.0E+0, | |||
"MudPump2Maximum": 0.0E+0, | |||
"MudPump2ReliefValvePressure": 0.6E+4, | |||
"MudPump2ReliefValvePressure": 0.0E+0, | |||
"CementPumpLinerDiameter": 0.0E+0, | |||
"CementPumpStroke": 0.0E+0, | |||
"CementPumpMechanicalEfficiency": 0.0E+0, | |||
@@ -122,7 +161,7 @@ | |||
"CementPumpOutput": 0.0E+0, | |||
"CementPumpOutputBblStroke": 0.0E+0, | |||
"CementPumpMaximum": 0.0E+0, | |||
"CementPumpReliefValvePressure": 0.6E+4, | |||
"CementPumpReliefValvePressure": 0.0E+0, | |||
"MudPump1ReliefValveIsSet": false, | |||
"MudPump2ReliefValveIsSet": false, | |||
"CementPumpReliefValveIsSet": false, | |||
@@ -157,8 +196,26 @@ | |||
"OpenHoleLength": 0.0E+0 | |||
}, | |||
"Path": { | |||
"Items": [], | |||
"DataPoints": [] | |||
"Items": [ | |||
{ | |||
"HoleType": 0, | |||
"Angle": 0.0E+0, | |||
"Length": 0.1E+4, | |||
"FinalAngle": 0.81573800331703431E-42, | |||
"TotalLength": 0.25384625402140253E+266, | |||
"MeasuredDepth": 0.85260404050988764E+248, | |||
"TotalVerticalDepth": 0.13849770568415003E+220 | |||
}, | |||
{ | |||
"HoleType": 926036234, | |||
"Angle": 0.73530327575511794E+224, | |||
"Length": 0.2E+4, | |||
"FinalAngle": 0.78365824094029884E+200, | |||
"TotalLength": 0.38606650640394845E-85, | |||
"MeasuredDepth": 0.10912776606995678E+276, | |||
"TotalVerticalDepth": 0.57356744358002641E+170 | |||
} | |||
] | |||
}, | |||
"Mud": { | |||
"ActiveMudType": 0, | |||
@@ -182,63 +239,37 @@ | |||
"ActiveTotalTankCapacityGal": 0.0E+0, | |||
"ActiveSettledContents": 0.0E+0, | |||
"ActiveSettledContentsGal": 0.0E+0, | |||
"ActiveTotalContents": 0.0E+0, | |||
"ActiveTotalContentsGal": 0.0E+0, | |||
"ActiveTotalContents": 0.98813129168249309E-323, | |||
"ActiveTotalContentsGal": 0.11419398560206232E-315, | |||
"ActiveAutoDensity": false, | |||
"InitialTripTankMudVolume": 0.0E+0, | |||
"InitialTripTankMudVolumeGal": 0.0E+0, | |||
"PedalFlowMeter": 0.0E+0 | |||
"InitialTripTankMudVolumeGal": 0.53049901345204898E-314, | |||
"PedalFlowMeter": 0.49406564584124654E-323 | |||
} | |||
}, | |||
"Warnings": { | |||
"PumpWithKellyDisconnected": false, | |||
"PumpWithTopdriveDisconnected": false, | |||
"Pump1PopOffValveBlown": false, | |||
"Pump1Failure": false, | |||
"Pump2PopOffValveBlown": false, | |||
"Pump2Failure": false, | |||
"Pump3PopOffValveBlown": false, | |||
"Pump3Failure": false, | |||
"DrawworksGearsAbuse": false, | |||
"RotaryGearsAbuse": false, | |||
"HoistLineBreak": false, | |||
"PartedDrillString": false, | |||
"ActiveTankOverflow": true, | |||
"ActiveTankUnderVolume": false, | |||
"TripTankOverflow": false, | |||
"DrillPipeTwistOff": false, | |||
"DrillPipeParted": false, | |||
"TripWithSlipsSet": false, | |||
"Blowout": false, | |||
"UndergroundBlowout": false, | |||
"MaximumWellDepthExceeded": false, | |||
"CrownCollision": false, | |||
"FloorCollision": false, | |||
"TopdriveRotaryTableConfilict": false | |||
}, | |||
"Problems": { | |||
"BitProblems": { | |||
"JetWashout": { | |||
"ProblemType": 0, | |||
"StatusType": 0, | |||
"Value": 0.0E+0, | |||
"DueValue": 0.0E+0 | |||
"Value": 0.53049901345204898E-314, | |||
"DueValue": 0.49406564584124654E-323 | |||
}, | |||
"PlugJets": { | |||
"ProblemType": 0, | |||
"ProblemType": 2, | |||
"StatusType": 0, | |||
"Value": 0.0E+0, | |||
"DueValue": 0.0E+0 | |||
"Value": 0.11419398560206232E-315, | |||
"DueValue": 0.27667676167109806E-321 | |||
}, | |||
"JetWashoutCount": 0, | |||
"PlugJetsCount": 0 | |||
}, | |||
"BopProblems": { | |||
"AnnularWash": { | |||
"ProblemType": 0, | |||
"ProblemType": 2, | |||
"StatusType": 0, | |||
"Value": 0.0E+0, | |||
"DueValue": 0.0E+0 | |||
"Value": 0.27667676167109806E-321, | |||
"DueValue": 0.49406564584124654E-323 | |||
}, | |||
"AnnularFail": { | |||
"ProblemType": 0, | |||
@@ -409,7 +440,11 @@ | |||
"StatusType": 0, | |||
"Value": 0.0E+0, | |||
"DueValue": 0.0E+0 | |||
} | |||
}, | |||
"ManualChoke1PluggedPercent": 0, | |||
"HydraulicChoke2PluggedPercent": 0, | |||
"HydraulicChoke1PluggedPercent": 0, | |||
"ManualChoke2PluggedPercent": 0 | |||
}, | |||
"DrillStemsProblems": { | |||
"StringDragIncrease": { | |||
@@ -606,7 +641,7 @@ | |||
"IsAutoMigrationRateSelected": false, | |||
"AutoMigrationRate": 0.0E+0 | |||
}, | |||
"Configuration": { | |||
"LostProblems": { | |||
"LostCirculation": { | |||
"ProblemType": 0, | |||
"StatusType": 0, | |||
@@ -764,18 +799,9 @@ | |||
}, | |||
"Equipments": { | |||
"BopControl": { | |||
"AnnularRegulatorSetControl": 0.0E+0, | |||
"AirMasterValve": 0.0E+0, | |||
"ByePassValve": 0.0E+0, | |||
"AnnularValve": 0.0E+0, | |||
"UpperRamsValve": 0.0E+0, | |||
"MiddleRamsValve": 0.0E+0, | |||
"KillLineValve": 0.0E+0, | |||
"ChokeLineValve": 0.0E+0, | |||
"LowerRamsValve": 0.0E+0, | |||
"ManifoldPressureGauge": 0.15E+4, | |||
"AirSupplyPressureGauge": 0.12E+3, | |||
"AccumulatorPressureGauge": 0.3E+4, | |||
"ManifoldPressureGauge": 0.0E+0, | |||
"AirSupplyPressureGauge": 0.0E+0, | |||
"AccumulatorPressureGauge": 0.0E+0, | |||
"AnnularPressureGauge": 0.0E+0, | |||
"AnnularOpenLED": 0, | |||
"AnnularCloseLED": 0, | |||
@@ -789,91 +815,29 @@ | |||
"ChokeLineCloseLED": 0, | |||
"LowerRamsOpenLED": 0, | |||
"LowerRamsCloseLED": 0, | |||
"AnnularStatus": 0.13625E+2, | |||
"UpperRamsStatus": 0.13625E+2, | |||
"MiddleRamsStatus": 0.13625E+2, | |||
"LowerRamsStatus": 0.13625E+2 | |||
"AnnularStatus": 0.0E+0, | |||
"UpperRamsStatus": 0.0E+0, | |||
"MiddleRamsStatus": 0.0E+0, | |||
"LowerRamsStatus": 0.0E+0 | |||
}, | |||
"ChokeControl": { | |||
"ChokePanelPumpSelectorSwitch": 0, | |||
"ChokePanelStrokeResetSwitch": false, | |||
"ChokeSelectorSwitch": false, | |||
"ChokeRateControlKnob": 0.0E+0, | |||
"ChokeControlLever": 0.0E+0, | |||
"ChokePanelRigAirSwitch": false, | |||
"EnableAutoChoke": false, | |||
"StandPipePressure": 0.0E+0, | |||
"CasingPressure": 0.0E+0, | |||
"ChokePosition": 0.0E+0, | |||
"ChokePanelSPMCounter": 0.0E+0, | |||
"ChokePanelTotalStrokeCounter": 0.0E+0, | |||
"Choke1LED": 0, | |||
"Choke2LED": 1 | |||
"Choke2LED": 0 | |||
}, | |||
"ChokeManifold": { | |||
"ChokeManifoldValve1": false, | |||
"ChokeManifoldValve2": false, | |||
"LeftManualChoke": 0.0E+0, | |||
"ChokeManifoldValve4": false, | |||
"ChokeManifoldValve5": false, | |||
"RightManualChoke": 0.0E+0, | |||
"ChokeManifoldValve7": false, | |||
"ChokeManifoldValve8": false, | |||
"ChokeManifoldValve9": false, | |||
"ChokeManifoldValve10": false, | |||
"ChokeManifoldValve11": false, | |||
"ChokeManifoldValve12": false, | |||
"ChokeManifoldValve13": false, | |||
"HydraulicChock1": -2147483548, | |||
"HydraulicChock2": -2147483548, | |||
"HydraulicChock1": 0, | |||
"HydraulicChock2": 0, | |||
"HyChock1OnProblem": false, | |||
"HyChock2OnProblem": false, | |||
"LeftManChokeOnProblem": false, | |||
"RightManChokeOnProblem": false | |||
}, | |||
"DataDisplay": { | |||
"TripAlarmLow": 0.0E+0, | |||
"TripAlarmHigh": 0.0E+0, | |||
"RetFlowAlarmLow": 0.0E+0, | |||
"RetFlowAlarmHigh": 0.0E+0, | |||
"PitAlarmLow": 0.0E+0, | |||
"PitAlarmHigh": 0.0E+0, | |||
"PortWeightOnBit": 0.0E+0, | |||
"PortHookLoad": 0.0E+0, | |||
"PortCasingPressure": 0.0E+0, | |||
"PortPumpPressure": 0.0E+0, | |||
"TripTankSetAlarmLow": 0.0E+0, | |||
"TripTankSetAlarmHigh": 0.0E+0, | |||
"TripTankSetAlarmSwitch": 0, | |||
"TripTankPowerSwitch": false, | |||
"TripTankPumpSwitch": false, | |||
"TripTankHornSwitch": false, | |||
"AcidGasDetectionHornSwitch": false, | |||
"TotalStrokeCounterResetSwitch": false, | |||
"DrillingTrippingSelectorSwitch": false, | |||
"MVTSetAlarmLowKnob": 0.0E+0, | |||
"MVTSetAlarmHighKnob": 0.0E+0, | |||
"MVTSetAlarmSwitch": 0, | |||
"MudTank1Switch": false, | |||
"MudTank2Switch": false, | |||
"MudTank3Switch": false, | |||
"MudTank4Switch": false, | |||
"MVTFineKnob": 0.0E+0, | |||
"MVTCoarseKnob": 0.0E+0, | |||
"MVTHornSwitch": false, | |||
"MVTDeviationTripSelectionSwitch": false, | |||
"MVTPowerSwitch": false, | |||
"MFFIResetTotalStrokes": false, | |||
"MFFIResetFillCounter": false, | |||
"MFFIPumpSelectorSwitch": 0, | |||
"MFFIFillSPMSelectorSwitch": false, | |||
"MFFISetAlarmLowKnob": 0.0E+0, | |||
"MFFISetAlarmHighKnob": 0.0E+0, | |||
"MFFISetAlarmSwitch": 0, | |||
"MFFIPowerSwitch": false, | |||
"MFFIHornSwitch": false, | |||
"ResetWob": false, | |||
"Clutch": false, | |||
"WOBPointer": 0.0E+0, | |||
"HookLoadPointer": 0.0E+0, | |||
"TripTankGauge": 0.0E+0, | |||
@@ -915,58 +879,6 @@ | |||
"Buzzer4": false | |||
}, | |||
"Drilling": { | |||
"AssignmentSwitch": 0, | |||
"EmergencySwitch": false, | |||
"RTTorqueLimitKnob": 0.0E+0, | |||
"MP1CPSwitchI": 0, | |||
"MP1CPSwitchT": 0, | |||
"MP1CPSwitch": 0, | |||
"MP1ThrottleUpdate": false, | |||
"MP1Throttle": 0.0E+0, | |||
"MP2SwitchI": 0, | |||
"MP2SwitchT": false, | |||
"MP2Switch": false, | |||
"MP2ThrottleUpdate": false, | |||
"MP2Throttle": 0.0E+0, | |||
"DWSwitch": 0, | |||
"DWThrottle": 0.0E+0, | |||
"RTSwitch": 0, | |||
"RTThrottle": 0.0E+0, | |||
"DWBreak": 0.0E+0, | |||
"PreviousDWBreak": 0.0E+0, | |||
"ForceBreak": false, | |||
"DWAcceleretor": 0.0E+0, | |||
"DWTransmisionLever": 0.0E+0, | |||
"DWPowerLever": 0.0E+0, | |||
"TongLever": 0.0E+0, | |||
"RTTransmissionLever": 0.0E+0, | |||
"DWClutchLever": 0.0E+0, | |||
"EddyBreakLever": 0.0E+0, | |||
"AutoDW": false, | |||
"GEN1": false, | |||
"GEN2": false, | |||
"GEN3": false, | |||
"GEN4": false, | |||
"Permission_OpenKellyCock": false, | |||
"OpenKellyCock": false, | |||
"Permission_CloseKellyCock": false, | |||
"CloseKellyCock": false, | |||
"Permission_OpenSafetyValve": false, | |||
"OpenSafetyValve": false, | |||
"Permission_CloseSafetyValve": false, | |||
"CloseSafetyValve": false, | |||
"Permission_IRSafetyValve": false, | |||
"IRSafetyValve": false, | |||
"Permission_IRIBop": false, | |||
"IRIBop": false, | |||
"LatchPipe": false, | |||
"UnlatchPipe": false, | |||
"Swing": false, | |||
"FillMouseHole": false, | |||
"Slips": false, | |||
"BrakeLeverCoefficient": 0.0E+0, | |||
"HideDrillingBrake": false, | |||
"ParkingBrakeBtn": false, | |||
"ParkingBrakeLed": false, | |||
"GEN1LED": 0, | |||
"GEN2LED": 0, | |||
@@ -1001,24 +913,9 @@ | |||
}, | |||
"Hook": { | |||
"HookHeight_S": 0.0E+0, | |||
"HookHeight": 0.75E+2 | |||
"HookHeight": 0.0E+0 | |||
}, | |||
"StandPipeManifold": { | |||
"StandPipeManifoldValve1": false, | |||
"StandPipeManifoldValve2": false, | |||
"StandPipeManifoldValve3": false, | |||
"StandPipeManifoldValve4": false, | |||
"StandPipeManifoldValve5": false, | |||
"StandPipeManifoldValve6": false, | |||
"StandPipeManifoldValve7": false, | |||
"StandPipeManifoldValve8": false, | |||
"StandPipeManifoldValve9": false, | |||
"StandPipeManifoldValve10": false, | |||
"StandPipeManifoldValve11": false, | |||
"StandPipeManifoldValve12": false, | |||
"StandPipeManifoldValve13": false, | |||
"StandPipeManifoldValve14": false, | |||
"StandPipeManifoldValve15": false, | |||
"StandPipeGauge1": 0.0E+0, | |||
"StandPipeGauge2": 0.0E+0 | |||
}, | |||
@@ -1034,7 +931,7 @@ | |||
"SPM1": 0.0E+0, | |||
"SPM2": 0.0E+0, | |||
"CasingPressure": 0.0E+0, | |||
"PercentFlow": "NaN", | |||
"PercentFlow": 0.0E+0, | |||
"PitGainLose": 0.0E+0, | |||
"PitVolume": 0.0E+0, | |||
"KillMudVolume": 0.0E+0, | |||
@@ -1042,8 +939,7 @@ | |||
"MudWeightIn": 0.0E+0, | |||
"FillVolume": 0.0E+0, | |||
"MudWeightOut": 0.0E+0 | |||
}, | |||
"Tank": [] | |||
} | |||
} | |||
} | |||