From 06375b1720e5d4a3a1466cfda7a130d14860f7d1 Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Sun, 29 Oct 2023 01:35:20 +1300 Subject: [PATCH 01/13] partial occlusions added --- src/bindings/c/geometry.c | 8 + src/bindings/c/geometry.f90 | 32 +- src/bindings/c/geometry.h | 1 + src/lib/geometry.f90 | 1040 ++++++++++++++++++----------------- 4 files changed, 568 insertions(+), 513 deletions(-) diff --git a/src/bindings/c/geometry.c b/src/bindings/c/geometry.c index a92d29b4..6d19af66 100644 --- a/src/bindings/c/geometry.c +++ b/src/bindings/c/geometry.c @@ -21,6 +21,7 @@ int get_local_node_f_c(const char *ndimension, int *dimension_len, const char *n void define_rad_from_geom_c(const char *order_system, int *order_system_len, double *control_param, const char *start_from, int *start_from_len, double *start_rad, const char *group_type, int *group_type_len, const char *group_options, int *group_options_len); +void occlude_vessel_c(int *VESSEL_NUMBER, double *RATIO); void element_connectivity_1d_c(void); void evaluate_ordering_c(void); void volume_of_mesh_c(double *volume_model, double *volume_tree); @@ -130,6 +131,13 @@ void define_rad_from_geom(const char *order_system, double control_param, const } +void occlude_vessel(int VESSEL_NUMBER, double RATIO) +{ + + occlude_vessel_c(&VESSEL_NUMBER, &RATIO); + +} + void element_connectivity_1d() { element_connectivity_1d_c(); diff --git a/src/bindings/c/geometry.f90 b/src/bindings/c/geometry.f90 index 411da8ae..fb401073 100644 --- a/src/bindings/c/geometry.f90 +++ b/src/bindings/c/geometry.f90 @@ -4,7 +4,7 @@ module geometry_c use indices !use mesh_functions !use precision ! sets dp for precision - !use math_constants !pi + !use math_constants !pi implicit none private @@ -175,7 +175,7 @@ end subroutine import_ply_triangles_c subroutine make_data_grid_c(surface_elems_len, surface_elems, offset, spacing, & filename, filename_len, groupname, groupname_len)& bind(C, name="make_data_grid_c") - + use arrays,only: dp use iso_c_binding, only: c_ptr use utils_c, only: strncpy @@ -210,7 +210,7 @@ subroutine make_2d_vessel_from_1d_c(elemlist, elemlist_len) bind(C, name="make_2 call make_2d_vessel_from_1d(elemlist) end subroutine make_2d_vessel_from_1d_c - + ! !################################################################################### ! @@ -303,6 +303,26 @@ subroutine define_rad_from_geom_c(order_system, order_system_len, control_param, call define_rad_from_geom(order_system_f, control_param, start_from_f, start_rad, group_type_f, group_options_f) end subroutine define_rad_from_geom_c + ! + !################################################################################## + ! + !*define_rad_from_geom:* Defines vessel or airway radius based on their geometric structure + subroutine occlude_vessel_c(VESSEL_NUMBER, RATIO) bind(C, name="occlude_vessel_c") + + !use iso_c_binding, only: c_ptr + !use utils_c, only: strncpy + !use other_consts, only: MAX_STRING_LEN + use arrays, only: dp + use geometry, only: occlude_vessel + implicit none + + integer,intent(in) :: VESSEL_NUMBER + real(dp),intent(in) :: RATIO + !character(len=MAX_STRING_LEN) :: order_system_f, start_from_f, group_type_f, group_options_f + + call occlude_vessel(VESSEL_NUMBER, RATIO) + + end subroutine occlude_vessel_c ! !########################################################################### ! @@ -347,10 +367,10 @@ function get_local_node_f_c(ndimension,np_global) result(get_local_node) bind(C, use arrays, only: dp use geometry, only: get_local_node_f implicit none - + integer :: ndimension,np_global integer :: get_local_node - + get_local_node=get_local_node_f(ndimension,np_global) end function get_local_node_f_c @@ -417,5 +437,3 @@ end subroutine write_node_geometry_2d_c ! end module geometry_c - - diff --git a/src/bindings/c/geometry.h b/src/bindings/c/geometry.h index 21b010ab..b32ce638 100644 --- a/src/bindings/c/geometry.h +++ b/src/bindings/c/geometry.h @@ -21,6 +21,7 @@ SHO_PUBLIC void define_rad_from_file(const char *FIELDFILE, const char *radius_t SHO_PUBLIC int get_local_node_f(const char *ndimenstion, const char *np_global); SHO_PUBLIC void define_rad_from_geom(const char *ORDER_SYSTEM, double CONTROL_PARAM, const char *START_FROM, double START_RAD, const char *GROUP_TYPE, const char *GROUP_OPTIONS); +SHO_PUBLIC void occlude_vessel(int VESSEL_NUMBER, double RATIO); SHO_PUBLIC void element_connectivity_1d(); SHO_PUBLIC void evaluate_ordering(); SHO_PUBLIC void volume_of_mesh(double *volume_model, double *volume_tree); diff --git a/src/lib/geometry.f90 b/src/lib/geometry.f90 index a07bf1ab..3897d8af 100644 --- a/src/lib/geometry.f90 +++ b/src/lib/geometry.f90 @@ -14,15 +14,15 @@ module geometry use mesh_utilities use other_consts ! currently has pi use precision ! sets dp for precision - + implicit none - + !Module parameters - + !Module types - + !Module variables - + !Interfaces private public add_mesh @@ -37,6 +37,7 @@ module geometry public define_data_geometry public define_rad_from_file public define_rad_from_geom + public occlude_vessel public element_connectivity_1d public element_connectivity_2d public evaluate_ordering @@ -56,23 +57,23 @@ module geometry public get_four_nodes public write_elem_geometry_2d public write_node_geometry_2d - + contains !!!############################################################################# - + subroutine allocate_node_arrays(num_nodes) !*allocate_node_arrays:* allocate memory for arrays associated with 1D trees - + integer,intent(in) :: num_nodes ! Local variables character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'allocate_node_arrays' call enter_exit(sub_name,1) - + if(.not.allocated(nodes)) allocate (nodes(num_nodes)) if(.not.allocated(node_xyz)) allocate (node_xyz(3,num_nodes)) if(.not.allocated(node_field)) allocate (node_field(num_nj,num_nodes)) @@ -80,11 +81,11 @@ subroutine allocate_node_arrays(num_nodes) nodes = 0 !initialise node index values node_xyz = 0.0_dp !initialise node_field = 0.0_dp !initialise - + call enter_exit(sub_name,2) - + end subroutine allocate_node_arrays - + !!!############################################################################# subroutine add_mesh(AIRWAY_MESHFILE) @@ -106,21 +107,21 @@ subroutine add_mesh(AIRWAY_MESHFILE) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'add_mesh' call enter_exit(sub_name,1) ios = 0 line = 0 open(fh, file=AIRWAY_MESHFILE) - + ! ios is negative if an end of record condition is encountered or if ! an endfile condition was detected. It is positive if an error was ! detected. ios is zero otherwise. ios=0 line=0 i=0 ! count the number of elements read in - + do while (ios == 0) read(fh, '(A)', iostat=ios) buffer ! line contains: element, parent element, generation, @@ -130,7 +131,7 @@ subroutine add_mesh(AIRWAY_MESHFILE) line = line + 1 i=i+1 i_ss_end = len(buffer) - + do nlabel = 1,7 ibeg = index(buffer," ") + 1 !get location of first integer beyond ws in string buffer = adjustl(buffer(ibeg:i_ss_end)) ! get info beyond ws, remove leading ws @@ -155,80 +156,80 @@ subroutine add_mesh(AIRWAY_MESHFILE) endif enddo close(fh) - + num_elems_to_add = i - + !!! increase the size of node and element arrays to accommodate the additional elements ! the number of nodes after adding mesh will be: num_nodes_new = num_nodes + num_units*num_elems_to_add ! the number of elems after adding mesh will be: num_elems_new = num_elems + num_units*num_elems_to_add call reallocate_node_elem_arrays(num_elems_new,num_nodes_new) - + ne = num_elems ! the starting local element number ne_global = elems(ne) ! assumes this is the highest element number (!!!) np = num_nodes ! the starting local node number np_global = nodes(np) ! assumes this is the highest node number (!!!) - + do nunit = 1,num_units ! for all terminal branches, append the mesh - + ne_parent = units(nunit) ! local element number of terminal, to append to ngen_parent = elem_ordrs(1,ne_parent) ne_start = ne !starting element number for the unit - + do i=1,num_elems_to_add - + if(parent_element(i).eq.0)then ne_parent = units(nunit) else ne_parent = ne_start+parent_element(i) endif - + ne0 = ne_parent np0 = elem_nodes(2,ne0) - + ne_global = ne_global + 1 ! new global element number ne = ne + 1 ! new local element number np_global = np_global + 1 !new global node number np = np + 1 ! new local node number - + nodes(np) = np_global elems(ne) = ne_global - + elem_nodes(1,ne) = np0 elem_nodes(2,ne) = np - + elem_ordrs(1,ne) = ngen_parent + generation(i) elem_ordrs(no_type,ne) = 1 ! ntype ! 0 for respiratory, 1 for conducting elem_symmetry(ne) = symmetry_temp(i)+1 ! uses 0/1 in file; 1/2 in code - + ! record the element connectivity elem_cnct(-1,0,ne) = 1 ! one parent branch elem_cnct(-1,1,ne) = ne0 ! store parent element elem_cnct(1,0,ne0) = elem_cnct(1,0,ne0) + 1 elem_cnct(1,elem_cnct(1,0,ne0),ne0) = ne - + ! record the direction and location of the branch do j=1,3 elem_direction(j,ne) = elem_direction(j,ne0) node_xyz(j,np) = node_xyz(j,np0) + & elem_direction(j,ne)*length(i) enddo !j - + elem_field(ne_length,ne) = length(i) elem_field(ne_radius,ne) = radius(i) elem_field(ne_a_A,ne) = a_A(i) elem_field(ne_vol,ne) = PI*radius(i)**2*length(i) - + enddo !i enddo !nunit - + num_nodes = np num_elems = ne - + call element_connectivity_1d call evaluate_ordering ! calculate new ordering of tree - + call enter_exit(sub_name,2) end subroutine add_mesh @@ -236,7 +237,7 @@ end subroutine add_mesh !!!############################################################################# subroutine add_matching_mesh() - !*add_matching_mesh:* + !*add_matching_mesh:* !Parameters to become inputs real(dp) :: offset(3) @@ -251,7 +252,7 @@ subroutine add_matching_mesh() character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'add_matching_mesh' call enter_exit(sub_name,1) !Ultimately offset should be an input argument @@ -278,7 +279,7 @@ subroutine add_matching_mesh() ne_global = elems(ne0) ! assumes this is the highest element number (!!!) np0 = num_nodes ! the starting local node number np_global = nodes(np0) ! assumes this is the highest node number (!!!) - + do nonode=1,num_nodes np=np_global+nonode np_m=nodes(nonode) @@ -290,7 +291,7 @@ subroutine add_matching_mesh() elems_at_node(np,0)=0 !initialise !Doesnt map versions, would be added here enddo - + do noelem=1,num_elems ne=ne_global+noelem elem_field(ne_group,ne)=2.0_dp!VEIN @@ -332,7 +333,7 @@ subroutine add_matching_mesh() nindex=no_hord elem_ordrs(nindex,ne)=elem_ordrs(nindex,ne_m) enddo - + !update current no of nodes and elements to determine connectivity np0=np !current highest node ne1=ne !current highest element @@ -379,7 +380,7 @@ subroutine add_matching_mesh() deallocate(np_map) call enter_exit(sub_name,2) - + end subroutine add_matching_mesh !!!############################################################################# @@ -392,7 +393,7 @@ subroutine append_units() character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'append_units' call enter_exit(sub_name,1) @@ -402,18 +403,18 @@ subroutine append_units() num_units=num_units+1 endif enddo - + if(allocated(units))then !increasing the array size; just overwrite deallocate(units) deallocate(unit_field) endif allocate(units(num_units)) allocate(unit_field(num_nu,num_units)) - + unit_field=0.0_dp units=0 elem_units_below(1:num_elems) = 0 !initialise the number of terminal units below a branch - + nu=0 do ne=1,num_elems if(elem_cnct(1,0,ne).eq.0)THEN @@ -422,7 +423,7 @@ subroutine append_units() elem_units_below(ne)=1 endif enddo - + ! count the effective number of elements below each branch do ne=num_elems,2,-1 ne0=elem_cnct(-1,1,ne) @@ -438,7 +439,7 @@ end subroutine append_units subroutine define_1d_elements(ELEMFILE) !*define_1d_elements:* Reads in an 1D element ipelem file to define a geometry - + character(len=MAX_FILENAME_LEN), intent(in) :: ELEMFILE ! Local Variables integer :: ibeg,iend,ierror,i_ss_end,j,ne,ne_global,& @@ -447,20 +448,20 @@ subroutine define_1d_elements(ELEMFILE) character(len=300) :: readfile character(LEN=40) :: sub_string character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'define_1d_elements' call enter_exit(sub_name,1) - + if(index(ELEMFILE, ".ipelem")> 0) then !full filename is given readfile = ELEMFILE else ! need to append the correct filename extension readfile = trim(ELEMFILE)//'.ipelem' endif - + open(10, file=readfile, status='old') - + read_number_of_elements : do read(unit=10, fmt="(a)", iostat=ierror) ctemp1 if(index(ctemp1, "elements")> 0) then @@ -468,7 +469,7 @@ subroutine define_1d_elements(ELEMFILE) exit read_number_of_elements endif end do read_number_of_elements - + !!! allocate memory for element arrays if(allocated(elems)) deallocate(elems) allocate(elems(num_elems)) @@ -492,7 +493,7 @@ subroutine define_1d_elements(ELEMFILE) if(allocated(expansile)) deallocate(expansile) allocate(expansile(num_elems)) endif - + !!! initialise element arrays elems = 0 elem_nodes = 0 @@ -500,9 +501,9 @@ subroutine define_1d_elements(ELEMFILE) elem_symmetry = 1 elem_field = 0.0_dp if(model_type.eq.'gas_mix')expansile = .false. - + ne=0 - + read_an_element : do !.......read element number read(unit=10, fmt="(a)", iostat=ierror) ctemp1 @@ -510,7 +511,7 @@ subroutine define_1d_elements(ELEMFILE) ne_global = get_final_integer(ctemp1) !return the final integer ne=ne+1 elems(ne)=ne_global - + read_element_nodes : do read(unit=10, fmt="(a)", iostat=ierror) ctemp1 if(index(ctemp1, "global")> 0) then !found the correct line @@ -531,11 +532,11 @@ subroutine define_1d_elements(ELEMFILE) end do read_element_nodes if(ne.ge.num_elems) exit read_an_element endif - + end do read_an_element - + close(10) - + ! calculate the element lengths and directions do ne=1,num_elems np1=elem_nodes(1,ne) @@ -549,12 +550,12 @@ subroutine define_1d_elements(ELEMFILE) node_xyz(j,np1))/elem_field(ne_length,ne) enddo !j enddo - + call element_connectivity_1d call evaluate_ordering elem_ordrs(no_type,:) = 1 ! 0 for respiratory, 1 for conducting - + call enter_exit(sub_name,2) end subroutine define_1d_elements @@ -570,20 +571,20 @@ subroutine define_elem_geometry_2d(ELEMFILE,sf_option) integer :: ierror,ne,ne_global,nn,np,number_of_elements character(len=132) :: ctemp1,readfile character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'define_elem_geometry_2d' call enter_exit(sub_name,1) - + if(index(ELEMFILE, ".ipelem")> 0) then !full filename is given readfile = ELEMFILE else ! need to append the correct filename extension readfile = trim(ELEMFILE)//'.ipelem' endif - + open(10, file=readfile, status='old') - + read_number_of_elements : do read(unit=10, fmt="(a)", iostat=ierror) ctemp1 if(index(ctemp1, "elements")> 0) then @@ -591,7 +592,7 @@ subroutine define_elem_geometry_2d(ELEMFILE,sf_option) exit read_number_of_elements endif end do read_number_of_elements - + num_elems_2d=number_of_elements if(allocated(elems_2d))then deallocate(elems_2d) @@ -601,18 +602,18 @@ subroutine define_elem_geometry_2d(ELEMFILE,sf_option) allocate(elems_2d(num_elems_2d)) allocate(elem_nodes_2d(4,num_elems_2d)) allocate(elem_versn_2d(4,num_elems_2d)) - + ne = 0 - - read_an_element : do + + read_an_element : do !.......read element number read(unit=10, fmt="(a)", iostat=ierror) ctemp1 if(index(ctemp1, "Element")> 0) then ne_global = get_final_integer(ctemp1) !return the final integer ne = ne + 1 elems_2d(ne) = ne_global - - read_element_nodes : do + + read_element_nodes : do read(unit=10, fmt="(a)", iostat=ierror) ctemp1 if(index(ctemp1, "global")> 0) then !found the correct line call get_four_nodes(ne,ctemp1) !number of versions for node np @@ -631,21 +632,21 @@ subroutine define_elem_geometry_2d(ELEMFILE,sf_option) exit read_element_nodes endif !index end do read_element_nodes - + if(ne.ge.number_of_elements) exit read_an_element endif - + end do read_an_element - + close(10) - + call element_connectivity_2d call line_segments_for_2d_mesh(sf_option) call enter_exit(sub_name,2) - + end subroutine define_elem_geometry_2d - + !!!############################################################################# subroutine define_mesh_geometry_test() @@ -654,15 +655,15 @@ subroutine define_mesh_geometry_test() ! Local Variables integer :: j,ne,np,np1,np2 character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'define_mesh_geometry_test' call enter_exit(sub_name,1) - + num_elems = 400 num_nodes = num_elems + 1 - + !!! allocate memory if(.not.allocated(nodes)) allocate (nodes(num_nodes)) if(.not.allocated(node_xyz)) allocate (node_xyz(3,num_nodes)) @@ -677,7 +678,7 @@ subroutine define_mesh_geometry_test() if(.not.allocated(elem_field)) allocate(elem_field(num_ne,num_elems)) if(.not.allocated(elem_direction)) allocate(elem_direction(3,num_elems)) if(.not.allocated(expansile)) allocate(expansile(num_elems)) - + !!! initialise array values nodes = 0 !initialise node index values node_xyz = 0.0_dp !initialise @@ -687,14 +688,14 @@ subroutine define_mesh_geometry_test() elem_symmetry = 1 elem_field = 0.0_dp expansile = .false. - + !!! set up node arrays nodes(1) = 1 do np=2,101 nodes(np) = np node_xyz(3,np) = node_xyz(3,np-1) - 1.0_dp enddo - + np=102 node_xyz(1,np) = node_xyz(1,np-1) - 0.5_dp do np=102,151 @@ -702,7 +703,7 @@ subroutine define_mesh_geometry_test() node_xyz(3,np) = node_xyz(3,np-1) - 0.5_dp node_xyz(1,np) = node_xyz(1,np-1) - 0.5_dp enddo - + np=152 nodes(np) = np node_xyz(1,np) = node_xyz(1,101) + 0.5_dp @@ -712,7 +713,7 @@ subroutine define_mesh_geometry_test() node_xyz(3,np) = node_xyz(3,np-1) - 0.5_dp node_xyz(1,np) = node_xyz(1,np-1) + 0.5_dp enddo - + np=202 nodes(np) = np node_xyz(1,np) = node_xyz(1,151) - 0.5_dp @@ -722,7 +723,7 @@ subroutine define_mesh_geometry_test() node_xyz(3,np) = node_xyz(3,np-1) - 0.5_dp node_xyz(1,np) = node_xyz(1,np-1) - 0.5_dp enddo - + np=252 nodes(np) = np node_xyz(1,np) = node_xyz(1,151) + 0.5_dp @@ -732,7 +733,7 @@ subroutine define_mesh_geometry_test() node_xyz(3,np) = node_xyz(3,np-1) - 0.5_dp node_xyz(1,np) = node_xyz(1,np-1) + 0.5_dp enddo - + np=302 nodes(np) = np node_xyz(1,np) = node_xyz(1,201) - 0.5_dp @@ -742,7 +743,7 @@ subroutine define_mesh_geometry_test() node_xyz(3,np) = node_xyz(3,np-1) - 0.5_dp node_xyz(1,np) = node_xyz(1,np-1) - 0.5_dp enddo - + np=352 nodes(np) = np node_xyz(1,np) = node_xyz(1,201) + 0.5_dp @@ -752,24 +753,24 @@ subroutine define_mesh_geometry_test() node_xyz(3,np) = node_xyz(3,np-1) - 0.5_dp node_xyz(1,np) = node_xyz(1,np-1) + 0.5_dp enddo - + !!! set up element arrays do ne=1,num_elems elems(ne) = ne elem_nodes(1,ne) = ne elem_nodes(2,ne) = ne+1 enddo - + elem_nodes(1,151) = 101 elem_nodes(1,201) = 151 elem_nodes(1,251) = 151 elem_nodes(1,301) = 201 elem_nodes(1,351) = 201 - + elem_field(ne_radius,1:100) = 10.0_dp elem_field(ne_radius,101:200) = 5.0_dp elem_field(ne_radius,201:400) = sqrt(elem_field(ne_radius,101)**2/2.0_dp) - + ! calculate the element lengths and directions do ne=1,num_elems np1=elem_nodes(1,ne) @@ -787,19 +788,19 @@ subroutine define_mesh_geometry_test() elem_field(ne_length,ne) elem_field(ne_a_A,ne) = 1.0_dp ! set default for ratio a/A enddo - + call element_connectivity_1d call evaluate_ordering - + call enter_exit(sub_name,2) - + end subroutine define_mesh_geometry_test !!!############################################################################# - + subroutine define_node_geometry(NODEFILE) !*define_node_geometry:* Reads in an ipnode file to define a tree geometry - + character(len=MAX_FILENAME_LEN), intent(in) :: NODEFILE !Input nodefile ! Local Variables integer :: i,ierror,np,np_global,num_nodes_temp,num_versions,nv,NJT=0 @@ -807,22 +808,22 @@ subroutine define_node_geometry(NODEFILE) logical :: overwrite = .false. ! initialised character(len=300) :: ctemp1,readfile character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'define_node_geometry' call enter_exit(sub_name,1) - + if(index(NODEFILE, ".ipnode")> 0) then !full filename is given readfile = NODEFILE else ! need to append the correct filename extension readfile = trim(NODEFILE)//'.ipnode' endif - + open(10, file=readfile, status='old') - + if(num_nodes.gt.0) overwrite = .true. - + !.....read in the total number of nodes. read each line until one is found !.....that has the correct keyword (nodes). then return the integer that is !.....at the end of the line @@ -833,9 +834,9 @@ subroutine define_node_geometry(NODEFILE) exit read_number_of_nodes !exit the named do loop endif end do read_number_of_nodes - + if(.not.overwrite) call allocate_node_arrays(num_nodes_temp) ! don't allocate if just overwriting - + !.....read in the number of coordinates read_number_of_coords : do !define a do loop name read(unit=10, fmt="(a)", iostat=ierror) ctemp1 !read a line into ctemp1 @@ -844,17 +845,17 @@ subroutine define_node_geometry(NODEFILE) exit read_number_of_coords !exit the named do loop endif end do read_number_of_coords - - ! note that only the first version of coordinate is currently read in - - !.....read the coordinate, derivative, and version information for each node. + + ! note that only the first version of coordinate is currently read in + + !.....read the coordinate, derivative, and version information for each node. np=0 read_a_node : do !define a do loop name !.......read node number read(unit=10, fmt="(a)", iostat=ierror) ctemp1 if(index(ctemp1, "Node")> 0) then np_global = get_final_integer(ctemp1) !get node number - + np = np+1 nodes(np) = np_global !.......read coordinates @@ -883,20 +884,20 @@ subroutine define_node_geometry(NODEFILE) endif !index if(np.ge.num_nodes_temp) exit read_a_node end do read_a_node - + if(.not.overwrite) num_nodes = num_nodes_temp - + close(10) - + call enter_exit(sub_name,2) - + end subroutine define_node_geometry !!!############################################################################# subroutine define_node_geometry_2d(NODEFILE) !*define_node_geometry_2d:* Reads in an ipnode file to define surface nodes - + character(len=*),intent(in) :: NODEFILE ! Local Variables integer :: i,ierror,np,np_global,& @@ -904,20 +905,20 @@ subroutine define_node_geometry_2d(NODEFILE) integer,parameter :: num_derivs = 3 character(len=132) :: ctemp1,readfile character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'define_node_geometry_2d' call enter_exit(sub_name,1) - + if(index(NODEFILE, ".ipnode")> 0) then !full filename is given readfile = NODEFILE else ! need to append the correct filename extension readfile = trim(NODEFILE)//'.ipnode' endif - + open(10, file=readfile, status='old') - + !.....read in the total number of nodes. read each line until one is found !.....that has the correct keyword (nodes). then return the integer that is !.....at the end of the line @@ -928,7 +929,7 @@ subroutine define_node_geometry_2d(NODEFILE) exit read_number_of_nodes !exit the named do loop endif end do read_number_of_nodes - + !!!allocate memory to arrays that require node number if(allocated(nodes_2d))then ! deallocate deallocate(nodes_2d) @@ -938,18 +939,18 @@ subroutine define_node_geometry_2d(NODEFILE) allocate(nodes_2d(num_nodes_2d)) allocate(node_xyz_2d(4,10,3,num_nodes_2d)) allocate(node_versn_2d(num_nodes_2d)) - - !.....read the coordinate, derivative, and version information for each node. + + !.....read the coordinate, derivative, and version information for each node. np=0 read_a_node : do !define a do loop name !.......read node number read(unit=10, fmt="(a)", iostat=ierror) ctemp1 if(index(ctemp1, "Node")> 0) then np_global = get_final_integer(ctemp1) !get node number - + np=np+1 nodes_2d(np) = np_global - + !.......read coordinates do i=1,3 ! for the x,y,z coordinates num_versions = 0 @@ -961,7 +962,7 @@ subroutine define_node_geometry_2d(NODEFILE) if(num_versions > 1)then read(unit=10, fmt="(a)", iostat=ierror) ctemp1 ! "For version number..." endif - !...........coordinate + !...........coordinate if(num_versions > 0) & read(unit=10, fmt="(a)", iostat=ierror) ctemp1 node_xyz_2d(1,nv,i,np) = get_final_real(ctemp1) @@ -989,11 +990,11 @@ subroutine define_node_geometry_2d(NODEFILE) endif !index if(np.ge.num_nodes_2d) exit read_a_node end do read_a_node - + close(10) - + call enter_exit(sub_name,2) - + end subroutine define_node_geometry_2d !!!############################################################################# @@ -1011,7 +1012,7 @@ subroutine define_data_geometry(datafile) sub_name = 'define_data_geometry' call enter_exit(sub_name,1) - + if(index(datafile, ".ipdata")> 0) then !full filename is given readfile = datafile else ! need to append the correct filename extension @@ -1023,7 +1024,7 @@ subroutine define_data_geometry(datafile) !set the counted number of data points to zero ncount = 0 - + !!! first run through to count the number of data points read_line_to_count : do read(unit=10, fmt="(a)", iostat=ierror) buffer @@ -1033,33 +1034,33 @@ subroutine define_data_geometry(datafile) num_data = ncount close (10) write(*,'('' Read'',I7,'' data points from file'')') num_data - + !!! allocate arrays now that we know the size required if(allocated(data_xyz)) deallocate(data_xyz) if(allocated(data_weight)) deallocate(data_weight) allocate(data_xyz(3,num_data)) allocate(data_weight(3,num_data)) - + !!! read the data point information open(10, file=readfile, status='old') read(unit=10, fmt="(a)", iostat=ierror) buffer - + !set the counted number of data points to zero ncount = 0 read_line_of_data : do - + ! read the data #; z; y; z; wd1; wd2; wd3 for each data point read(unit=10, fmt="(a)", iostat=ierror) buffer if(ierror<0) exit !ierror<0 means end of file length_string = len_trim(buffer) !length of buffer, and removed trailing blanks - + ! read data number buffer=adjustl(buffer) !remove leading blanks iend=index(buffer," ",.false.)-1 !index returns location of first blank if(length_string == 0) exit ncount=ncount+1 read (buffer(1:iend), '(i6)') itemp - + do nj=1,3 ! read x,y,z coordinates buffer = adjustl(buffer(iend+1:length_string)) !remove data number from string @@ -1068,7 +1069,7 @@ subroutine define_data_geometry(datafile) iend=index(buffer," ",.false.)-1 !index returns location of first blank read (buffer(1:iend), '(D25.17)') data_xyz(nj,ncount) enddo !nj - + do nj=1,3 ! ! read weightings ! buffer = adjustl(buffer(iend+1:length_string)) !remove data number from string @@ -1078,11 +1079,11 @@ subroutine define_data_geometry(datafile) ! read (buffer(1:iend), '(D25.17)') data_weight(nj,ncount) data_weight(nj,ncount)=1.0_dp enddo !nj - + enddo read_line_of_data - + close(10) - + call enter_exit(sub_name,2) end subroutine define_data_geometry @@ -1092,24 +1093,24 @@ end subroutine define_data_geometry subroutine import_node_geometry_2d(NODEFILE) !*define_node_geometry_2d:* Reads in an exnode file to define surface nodes !DEC$ ATTRIBUTES DLLEXPORT,ALIAS:"SO_DEFINE_NODE_GEOMETRY_2D" :: DEFINE_NODE_GEOMETRY_2D - + character(len=*),intent(in) :: NODEFILE ! Local Variables integer :: i,ierror,index_location,np,np_global,num_versions,nv character(len=132) :: ctemp1,readfile character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'import_node_geometry_2d' call enter_exit(sub_name,1) - + if(index(NODEFILE, ".exnode")> 0) then !full filename is given readfile = NODEFILE else ! need to append the correct filename extension readfile = trim(NODEFILE)//'.exnode' endif - + open(10, file=readfile, status='old') !.....get the total number of nodes. @@ -1130,8 +1131,8 @@ subroutine import_node_geometry_2d(NODEFILE) nodes_2d = 0 node_xyz_2d = 0.0_dp node_versn_2d = 0 - - !.....read the coordinate, derivative, and version information for each node. + + !.....read the coordinate, derivative, and version information for each node. open(10, file=readfile, status='old') np = 0 num_versions = 1 @@ -1151,7 +1152,7 @@ subroutine import_node_geometry_2d(NODEFILE) np = np+1 nodes_2d(np) = np_global node_versn_2d(np) = num_versions - + !.......read coordinates do i =1,3 ! for the x,y,z coordinates do nv = 1,node_versn_2d(np) @@ -1161,11 +1162,11 @@ subroutine import_node_geometry_2d(NODEFILE) endif !index if(np.ge.num_nodes_2d) exit read_a_node end do read_a_node - + close(10) - + call enter_exit(sub_name,2) - + end subroutine import_node_geometry_2d !!!############################################################################# @@ -1180,24 +1181,24 @@ subroutine import_ply_triangles(ply_file) integer :: i,ibeg,iend,ierror,nt,nv character(len=132) :: string,readfile character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'import_ply_triangles' call enter_exit(sub_name,1) - + if(index(ply_file, ".ply")> 0) then !full filename is given readfile = ply_file else ! need to append the correct filename extension readfile = trim(ply_file)//'.ply' endif - + open(10, file=readfile, status='old') !.....get the total number of vertices num_vertices = 0 read_number_of_vertices : do !define a do loop name - read(unit=10, fmt="(a)", iostat=ierror) string + read(unit=10, fmt="(a)", iostat=ierror) string if(ierror<0) exit !ierror<0 means end of file if(index(string, "element vertex")> 0) then !keyword is found iend = len(string) !get the length of the string @@ -1206,11 +1207,11 @@ subroutine import_ply_triangles(ply_file) exit endif end do read_number_of_vertices - + !.....get the total number of triangles num_triangles = 0 read_number_of_triangles : do !define a do loop name - read(unit=10, fmt="(a)", iostat=ierror) string + read(unit=10, fmt="(a)", iostat=ierror) string if(ierror<0) exit !ierror<0 means end of file if(index(string, "element face")> 0) then !keyword is found iend = len(string) !get the length of the string @@ -1234,19 +1235,19 @@ subroutine import_ply_triangles(ply_file) read(unit=10, fmt=*) i,triangle(1,nt),triangle(2,nt),triangle(3,nt) enddo triangle = triangle + 1 ! offset all vertices by 1 because indexing starts from zero - + close(10) - + call enter_exit(sub_name,2) - + end subroutine import_ply_triangles !!!############################################################################# subroutine triangles_from_surface(surface_elems) !*triangles_from_surface:* generates a linear surface mesh of triangles - ! from an existing high order surface mesh. - + ! from an existing high order surface mesh. + integer,intent(in) :: surface_elems(:) ! Local variables integer,parameter :: ndiv = 4 ! the number of triangle divisions in each direction @@ -1256,7 +1257,7 @@ subroutine triangles_from_surface(surface_elems) logical :: four_nodes character(len=3) :: repeat character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- sub_name = 'triangles_from_surface' @@ -1272,7 +1273,7 @@ subroutine triangles_from_surface(surface_elems) num_surfaces = count(surface_elems.ne.0) num_triangles = 0 num_vertices = 0 - num_tri_vert = 0 + num_tri_vert = 0 do nelem = 1,num_surfaces ne = surface_elems(nelem) @@ -1285,7 +1286,7 @@ subroutine triangles_from_surface(surface_elems) select case(repeat) case ('0_0') - + nmax_1 = ndiv+1 ! ndiv+1 vertices in xi1 direction step_1 = 0 ! # of vertices in xi1 is constant nmax_2 = ndiv+1 ! ndiv+1 vertices in xi2 direction @@ -1293,36 +1294,36 @@ subroutine triangles_from_surface(surface_elems) index1 = 1 index2 = 2 four_nodes = .true. - + case ('1_0') - + nmax_1 = 1 ! start with 1 vertex in xi1 direction step_1 = 1 ! increase # of vertices in xi1 with each step in xi2 nmax_2 = ndiv+1 ! ndiv+1 vertices in xi2 direction step_2 = 0 ! # of vertices in xi2 is constant index1 = 1 index2 = 2 - + case ('1_1') - + nmax_1 = ndiv+1 ! start with ndiv+1 vertices in xi1 direction step_1 = -1 ! decrease # of vertices in xi1 with each step in xi2 nmax_2 = ndiv+1 ! ndiv+1 vertices in xi2 direction step_2 = 0 ! # of vertices in xi2 is constant index1 = 1 index2 = 2 - + case ('2_0') - + nmax_2 = ndiv+1 ! ndiv+1 vertices in xi1 direction step_2 = 0 ! # of vertices in xi1 is constant nmax_1 = 1 ! start with 1 vertex in xi2 direction - step_1 = 1 ! increase # of vertices in xi2 with each step in xi1 + step_1 = 1 ! increase # of vertices in xi2 with each step in xi1 index2 = 1 index1 = 2 - + case ('2_1') - + nmax_2 = ndiv+1 ! ndiv+1 vertices in xi1 direction step_2 = 0 ! # of vertices in xi1 is constant nmax_1 = ndiv+1 ! start with ndiv+1 vertices in xi2 direction @@ -1368,9 +1369,9 @@ subroutine triangles_from_surface(surface_elems) nmax_1 = nmax_1 + step_1 enddo !i enddo - + call enter_exit(sub_name,2) - + end subroutine triangles_from_surface !!!############################################################################# @@ -1380,29 +1381,29 @@ subroutine group_elem_parent_term(parent_list,ne_parent) ! a given parent element (ne_parent) use mesh_utilities,only: group_elem_by_parent - + integer :: parent_list(:) ! will contain terminal elements below ne_parent on exit integer,intent(in) :: ne_parent ! the parent element number ! Local Variables integer :: ne,ne_count,noelem,num_parents integer,allocatable :: templist(:) character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- sub_name = 'group_elem_parent_term' call enter_exit(sub_name,1) - + allocate(templist(num_elems)) !if(.not.allocated(parentlist)) allocate(parentlist(num_elems)) - + ! get the list of elements that are subtended by ne_parent call group_elem_by_parent(ne_parent,templist) - + ne_count = count(templist.ne.0) ! number of subtended elements num_parents = 0 ! parentlist=0 - + do noelem = 1,ne_count ne = templist(noelem) if(elem_cnct(1,0,ne).eq.0)then @@ -1410,18 +1411,18 @@ subroutine group_elem_parent_term(parent_list,ne_parent) parent_list(num_parents)=ne endif !elem_cnct enddo !noelem - + deallocate(templist) - + call enter_exit(sub_name,2) - + end subroutine group_elem_parent_term - + !!!############################################################################# - + subroutine make_data_grid(surface_elems, offset, spacing, filename, groupname) !*make_data_grid:* makes a regularly-spaced 3D grid of data points to - ! fill a bounding surface + ! fill a bounding surface integer,intent(in) :: surface_elems(:) real(dp),intent(in) :: offset, spacing @@ -1435,9 +1436,9 @@ subroutine make_data_grid(surface_elems, offset, spacing, filename, groupname) real(dp),allocatable :: data_temp(:,:) logical :: internal character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'make_data_grid' call enter_exit(sub_name,1) @@ -1459,7 +1460,7 @@ subroutine make_data_grid(surface_elems, offset, spacing, filename, groupname) vertex_xyz(1:3,i) - (cofm2(1:3)-cofm1(1:3)) !!! find the bounding coordinates for the surface mesh - + min_bound = minval(vertex_xyz,2) max_bound = maxval(vertex_xyz,2) boxrange = max_bound - min_bound @@ -1467,17 +1468,17 @@ subroutine make_data_grid(surface_elems, offset, spacing, filename, groupname) (boxrange(2)/spacing+1.0_dp) * (boxrange(3))/spacing+1.0_dp) * & volume_internal_to_surface(triangle,vertex_xyz)/ & (boxrange(1)*boxrange(2)*boxrange(3))) - + !!! allocate arrays based on estimated number of data points - + if(allocated(data_xyz)) deallocate(data_xyz) allocate(data_xyz(3,num_data_estimate)) i=0 num_data = 0 - point_xyz = min_bound + 0.5_dp*spacing + point_xyz = min_bound + 0.5_dp*spacing do while(point_xyz(3).le.max_bound(3)) ! for z direction i=i+1 - j=0 + j=0 do while(point_xyz(2).le.max_bound(2)) ! for y direction j=j+1 k=0 @@ -1498,7 +1499,7 @@ subroutine make_data_grid(surface_elems, offset, spacing, filename, groupname) allocate(data_xyz(3,num_data_estimate)) data_xyz(:,1:num_data-1) = data_temp(:,1:num_data-1) deallocate(data_temp) !deallocate the temporary array - + write(*,'('' WARNING: number of data is'',I6, & &''; increased array size'')') num_data data_xyz(:,num_data) = point_xyz @@ -1515,26 +1516,26 @@ subroutine make_data_grid(surface_elems, offset, spacing, filename, groupname) point_xyz(1:2) = min_bound(1:2) + 0.5_dp*spacing point_xyz(3) = point_xyz(3) + spacing enddo - + write(*,'('' Made'',I7,'' data points inside surface elements'')') num_data - + if(allocated(data_weight)) deallocate(data_weight) allocate(data_weight(3,num_data)) data_weight(:,1:num_data) = 1.0_dp if(allocated(elem_list)) deallocate(elem_list) - + call enter_exit(sub_name,2) - + end subroutine make_data_grid - + !!!############################################################################# - + subroutine make_2d_vessel_from_1d(elem_list) !*make_2d_vessel_from_1d:* create a surface mesh that aligns with the ! centrelines of a 1D tree, and located at distance 'radius' from the centre. ! a template for a set of 5 nodes (that together define a bifurcation) is - ! scaled, rotated, translated to align with the 1d mesh and its radii. + ! scaled, rotated, translated to align with the 1d mesh and its radii. integer,intent(in) :: elem_list(:) ! Local variables @@ -1557,7 +1558,7 @@ subroutine make_2d_vessel_from_1d(elem_list) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'make_2d_vessel_from_1d' call enter_exit(sub_name,1) @@ -1583,7 +1584,7 @@ subroutine make_2d_vessel_from_1d(elem_list) ne_new = 0 ! initialise the surface mesh element numbering np_new = 0 ! initialise the surface mesh node numbering -!!! set up a generic structure (in template_coords) that will be rotated, scaled, and placed +!!! set up a generic structure (in template_coords) that will be rotated, scaled, and placed ! the following arrays define the template bifurcation template_vrsns = (/2,6,2,6,2/) template_vrsn_map = reshape((/1,2,3,1,1,3,2,1,1,5,4,2,2,4,5,1/),shape(template_vrsn_map)) @@ -1610,18 +1611,18 @@ subroutine make_2d_vessel_from_1d(elem_list) node_xyz_2d(:,1,:,np_new) = new_coords_derivs(:,1,:,i) ! coordinates and derivatives 1,2,1_2 enddo !i elem_node_map(1,5,np1) = elem_node_map(1,1,np1) !dummy (5th) node to help with mapping - + !!! work through each of the elements in the given list, creating a ring of new !!! nodes and joining them to the previous ring of nodes. The assumption is that !!! the elements comprise a continuous tree ne_count = 1 ! counter for the 1d elements in the list do while (ne /= 0) - + ne0 = elem_cnct(-1,1,ne) ! parent 1d element - np1 = elem_nodes(1,ne) ! start node of current element + np1 = elem_nodes(1,ne) ! start node of current element np2 = elem_nodes(2,ne) ! end node of current element - + radius = elem_field(ne_radius,ne) length = elem_field(ne_length,ne) ! length of current element if(.not.bifurcation_element(ne).and.bifurcation_element(ne0)) & @@ -1632,7 +1633,7 @@ subroutine make_2d_vessel_from_1d(elem_list) forall (k = 1:4) short_elements(num_short + k) = ne_new + k num_short = num_short + 4 endif - + ! calculate the rotation angle, translation (Txyz), and rotation matrices (Rx, Ry) call mesh_rotate_about_axis(ne,angle,Rx,Ry,Txyz,template_coords) @@ -1642,7 +1643,7 @@ subroutine make_2d_vessel_from_1d(elem_list) ! which 'ring' of parent nodes to join to when making new elements nvb = which_child(ne,ne0) ! the 2nd child branch endif - + if(.not.bifurcation_element(ne))then !!! ---- for a single element that is the parent of a single element: ! make 4 new nodes using 'new_coords_derivs' at the end of the 1d element @@ -1651,15 +1652,15 @@ subroutine make_2d_vessel_from_1d(elem_list) radius_weighted = 0.0_dp call mesh_rotate_vector_about_axis(4,template_vrsns,angle,length,radius, & radius_weighted,Rx,Ry,Txyz,template_coords,new_coords_derivs) - + ! as each new point is placed, check whether it is the closest to the first ! surface mesh node in ring of nodes surrounding the element, i.e. around ! node np1. This is used to determine the node numbering in the new element. smallest = 1.0e+6_dp - point1(:) = node_xyz_2d(1,1,:,elem_node_map(nvb,1,np1)) + point1(:) = node_xyz_2d(1,1,:,elem_node_map(nvb,1,np1)) do i = 1,4 ! four nodes in the end 'ring' np_new = np_new + 1 - nodes_2d(np_new) = np_new + nodes_2d(np_new) = np_new node_xyz_2d(:,1,:,np_new) = new_coords_derivs(:,1,:,i) ! coordinates and derivatives 1,2,1_2 point2(:) = node_xyz_2d(1,1,:,np_new) distance = distance_between_points(point1,point2) @@ -1682,27 +1683,27 @@ subroutine make_2d_vessel_from_1d(elem_list) elem_node_map(1,j,np2) = np_close(1)+j-1 endif enddo ! j = 2,4 - + ! make new elements, using the node mapping stored in elem_node_map. ! nodes 1 and 2 use mapping stored at 1d node np1, and nodes 3 and 4 - ! use mapping stored at 1d node np2. if the underlying 1d element is + ! use mapping stored at 1d node np2. if the underlying 1d element is ! a child branch in a bifurcation then we need to get the correct ! version numbers (for derivatives) from template_vrsn_map. do i = 1,4 ! 4 new elements ne_new = ne_new + 1 - elems_2d(ne_new) = ne_new + elems_2d(ne_new) = ne_new forall(nn = 1:2) elem_nodes_2d(nn,ne_new) = elem_node_map(nvb,nn+i-1,np1) forall(nn = 3:4) elem_nodes_2d(nn,ne_new) = elem_node_map(1,i+nn-3,np2) - if(bifurcation_element(ne0)) & + if(bifurcation_element(ne0)) & forall(nn = 1:2) elem_versn_2d(nn,ne_new) = template_vrsn_map(nn,i+(nvb-1)*4) enddo ! i = 1,4 forall (i=1:4) elem_node_map(1,i,np2) = np_new-4+i elem_node_map(1,5,np2) = elem_node_map(1,1,np2) - + else if(bifurcation_element(ne)) then !!! ---- for an element that is the parent of a bifurcation: ! create surface mesh nodes around the 1d element end node and at the crux. - + ! Apply rotation and translation to each new node from the generic template radius_weighted = 0.5_dp*radius+0.5_dp*max(elem_field(ne_radius,elem_cnct(1,1,ne)), & elem_field(ne_radius,elem_cnct(1,2,ne))) ! average of branch and largest child @@ -1710,15 +1711,15 @@ subroutine make_2d_vessel_from_1d(elem_list) radius_weighted,Rx,Ry,Txyz,template_coords,new_coords_derivs) new_coords_derivs(3,1,:,1) = new_coords_derivs(3,2,:,1) new_coords_derivs(3,1,:,3) = new_coords_derivs(3,2,:,3) - + ! adjust location of crux node using the location of the end node of ! the underlying 1d element, and end nodes of two child elements call mesh_2d_from_1d_crux(elem_nodes(2,ne),elem_cnct(1,1,ne), & elem_cnct(1,2,ne),cruxdist,new_coords_derivs) - + do i = 1,5 ! five nodes in the bifurcation np_new = np_new+1 - nodes_2d(np_new) = np_new + nodes_2d(np_new) = np_new elem_node_map(2,i,np2) = np_new ! record nodes in ring around np2 node_versn_2d(np_new) = template_vrsns(i) ring_coords(:,i) = new_coords_derivs(1,1,:,i) ! store the coords for 'ring' @@ -1756,7 +1757,7 @@ subroutine make_2d_vessel_from_1d(elem_list) elem_node_map(nvb,j,np1) = np_close(1)+j-1 endif enddo !j - + ! create new surface elements joining the np1 and np2 rings do i = 1,4 ne_new = ne_new+1 @@ -1767,13 +1768,13 @@ subroutine make_2d_vessel_from_1d(elem_list) enddo ! i elem_nodes_2d(2,ne_new) = elem_node_map(nvb,1,np1) elem_nodes_2d(4,ne_new) = np_new-4 - + elem_node_map(1,1,np2) = np_new elem_node_map(2,3,np2) = np_new elem_node_map(1:2,5,np2) = elem_node_map(1:2,1,np2) np_crux = np_new - + ! for an element that is the parent of a bifurcation, also create ! nodes and elements along each of the two child branches np0 = np1 ! the start node of the parent element @@ -1784,21 +1785,21 @@ subroutine make_2d_vessel_from_1d(elem_list) length = max(cruxdist*1.25_dp, 0.5_dp*(cruxdist*1.25_dp+ & (elem_field(ne_length,ne_child) - radius*0.5_dp))) ring_distance(ne_child) = length - + ! calculate the rotation angle for the branch call mesh_rotate_about_axis(ne_child,angle,Rx,Ry,Txyz,template_coords) - + radius = elem_field(ne_radius,ne_child) radius_weighted = radius call mesh_rotate_vector_about_axis(4,template_vrsns,angle,length,radius, & radius_weighted,Rx,Ry,Txyz,template_coords,new_coords_derivs) - + do i = 1,4 ! four nodes in the new 'ring' np_new = np_new + 1 nodes_2d(np_new) = np_new ! store new node number node_xyz_2d(:,1,:,np_new) = new_coords_derivs(:,1,:,i) ! coordinates and derivatives 1,2,1_2 enddo ! i - + ! the bifurcation offers two potential rings of nodes to attach to. ! determine which is the correct ring using the angle between the ! direction of the child element and the direction from the start @@ -1818,7 +1819,7 @@ subroutine make_2d_vessel_from_1d(elem_list) nvb = 1 if(angle.gt.angle_btwn_points(point1,point2,point3)) nvb = 2 - + ! determine which of the nodes in the bifurcation ring the new nodes ! should attach to based on which of the new nodes is the closest to ! the 5th (for nvb=1) or 1st (for nvb=2) ring node @@ -1835,7 +1836,7 @@ subroutine make_2d_vessel_from_1d(elem_list) np_close(nvb) = np_new + j endif enddo !i - + ! record the node mapping in the ring elem_node_map(k,1,np1) = np_close(nvb) elem_node_map(k,5,np1) = elem_node_map(k,1,np1) @@ -1860,9 +1861,9 @@ subroutine make_2d_vessel_from_1d(elem_list) forall(nn = 3:4) elem_nodes_2d(nn,ne_new) = elem_node_map(k,i+nn-3,np1) enddo !i enddo !k - + endif ! .not.bifurcation(ne) - + ne_count = ne_count+1 if(ne_count.gt.num_elems)then ne = 0 @@ -1875,7 +1876,7 @@ subroutine make_2d_vessel_from_1d(elem_list) endif endif enddo ! while (ne /= 0) - + num_nodes_2d = np_new num_elems_2d = ne_new @@ -1892,9 +1893,9 @@ subroutine make_2d_vessel_from_1d(elem_list) deallocate(elem_node_map) deallocate(ring_distance) deallocate(short_elements) - + call enter_exit(sub_name,2) - + end subroutine make_2d_vessel_from_1d !!!############################################################################# @@ -1910,13 +1911,13 @@ subroutine mesh_2d_from_1d_generic(template_coords) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'mesh_2d_from_1d_generic' call enter_exit(sub_name,1) - + template_coords = 0.0_dp - !.....Set up a default ring of nodes. + !.....Set up a default ring of nodes. do i = 1,4 ! step around the ring of nodes in four steps angle = 2.0_dp * pi * dble(i-1)/4.0_dp !=2*PI*step/number_of_steps !.......Derivatives @@ -1943,7 +1944,7 @@ subroutine mesh_2d_from_1d_generic(template_coords) template_coords(3,2:5,2,2) = 0.0_dp template_coords(3,2:5,3,2)= 0.33_dp template_coords(3,4:5,1,2)= 0.33_dp - + !.....Second side node template_coords(1,:,3,3) = -1.5_dp ! side node template_coords(3,2,1,3) = -0.15_dp @@ -1957,14 +1958,14 @@ subroutine mesh_2d_from_1d_generic(template_coords) template_coords(3,2:5,2,4) = 0.0_dp template_coords(3,2:5,3,4)= 0.33_dp template_coords(3,4:5,1,4)= 0.33_dp - + !.....Crux node template_coords(1,:,3,5) = 1.5_dp template_coords(2,1,2,5) = 1.0_dp template_coords(2,2,:,5) = -template_coords(2,1,:,5) template_coords(3,1,1,5) = -0.3_dp template_coords(3,2,1,5) = 0.3_dp - + call enter_exit(sub_name,2) end subroutine mesh_2d_from_1d_generic @@ -1975,7 +1976,7 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) !*mesh_rotate_about_axis:* calculates the rotation matrices and z-angle for ! rotation of a vector about an arbitrary axis defined by the direction ! of element ne. - + integer,intent(in) :: ne real(dp) :: angle_z,Rx(:,:),Ry(:,:),Txyz(:) real(dp),intent(in) :: template_coords(:,:,:,:) @@ -1986,13 +1987,13 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'mesh_rotate_about_axis' call enter_exit(sub_name,1) - + np1 = elem_nodes(1,ne) np2 = elem_nodes(2,ne) - + ! Find next bifurcation nodes, for calculating rotation about the z-axis if(elem_cnct(1,0,ne).ge.2)then !get adjacent nodes np0 = np1 @@ -2017,7 +2018,7 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) enddo endif -!!! .....Calculate the rotation and translation matrices +!!! .....Calculate the rotation and translation matrices !!! np1 == start node, np2 == end node, np3 == end of child 1, np4 == end of child 2 @@ -2029,7 +2030,7 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) !!! | 0 b/d c/d | | a 0 d | | 0 0 | !!! where U(a,b,c) == branch direction (elem_direction(1:3,ne)) and d = sqrt(b2 + c2) !!! see www.paulbourke.net/geometry/rotate for explanation - + Rx = 0.0_dp Ry = 0.0_dp Rx(1,1) = 1.0_dp !x-x = 1 @@ -2039,13 +2040,13 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) Rx(2,3) = elem_direction(2,ne)/ln_23 Rx(3,2) = -Rx(2,3) Rx(3,3) = Rx(2,2) - + Ry(2,2) = 1.0_dp !x-x = 1 Ry(1,1) = ln_23 Ry(1,3) = elem_direction(1,ne) Ry(3,1) = -Ry(1,3) Ry(3,3) = Ry(1,1) - + !.....The angle for rotation about the z-axis is equal to the angle !.....between the normal to the plane containing bifurcation nodes and !.....the theta=0 direction @@ -2073,7 +2074,7 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) enddo !nj V = X2 !-Txyz(nj) V = unit_vector(V) ! the direction of the vector rotated about x and y axes - + angle_z = min(scalar_product_3(V,NML),1.0_dp) angle_z = max(scalar_product_3(V,NML),-1.0_dp) @@ -2084,7 +2085,7 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) else angle_z = acos(angle_z) ! angle between normal and 2nd (front) node endif - + V(:) = template_coords(1,1,:,3) ! direction to the 'side' node V = unit_vector(V) !.......Calculate location of V if rotation about x- and y- was applied @@ -2109,18 +2110,18 @@ subroutine mesh_rotate_about_axis(ne,angle_z,Rx,Ry,Txyz,template_coords) else angle_z = 0.0_dp endif - + call enter_exit(sub_name,2) - + end subroutine mesh_rotate_about_axis - + !!!############################################################################# subroutine mesh_rotate_vector_about_axis(N,template_vrsns,angle,length, & radius,radius_weighted,Rx,Ry,Txyz,template_coords,new_coords_derivs) !*mesh_rotate_vector_about_axis:* rotates a vector (starting at (0,0,0)) ! about an arbitrary axis. Rotation matrices are in Rx and Ry. - ! angle is the amount to rotate about z-axis. + ! angle is the amount to rotate about z-axis. integer,intent(in) :: N,template_vrsns(:) real(dp),intent(in) :: angle,length,radius,radius_weighted,Rx(3,3), & @@ -2132,12 +2133,12 @@ subroutine mesh_rotate_vector_about_axis(N,template_vrsns,angle,length, & character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'mesh_rotate_vector_about_axis' call enter_exit(sub_name,1) - + new_coords_derivs = 0.0_dp - + do i = 1,N !each node in ring, plus crux if at bifurcation do nk = 1,4 do nv = 1,template_vrsns(i) @@ -2196,7 +2197,7 @@ subroutine mesh_rotate_vector_about_axis(N,template_vrsns,angle,length, & enddo !i call enter_exit(sub_name,2) - + end subroutine mesh_rotate_vector_about_axis !!!############################################################################# @@ -2204,7 +2205,7 @@ end subroutine mesh_rotate_vector_about_axis subroutine mesh_2d_from_1d_crux(np0,ne_1,ne_2,distance,new_coords_derivs) !*mesh_2d_from_1d_crux:* adjusts the location of the crux node for deriving ! a 2d surface mesh over a 1d tree mesh. - + integer,intent(in) :: ne_1,ne_2,np0 real(dp) :: distance,new_coords_derivs(:,:,:,:) ! Local variables @@ -2213,10 +2214,10 @@ subroutine mesh_2d_from_1d_crux(np0,ne_1,ne_2,distance,new_coords_derivs) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'mesh_2d_from_1d_crux' call enter_exit(sub_name,1) - + !adjust location of crux node radius_U = elem_field(ne_radius,ne_1) radius_V = elem_field(ne_radius,ne_2) @@ -2242,7 +2243,7 @@ subroutine mesh_2d_from_1d_crux(np0,ne_1,ne_2,distance,new_coords_derivs) !!!..... n.w = 0 !!!..... u.w = cos(angle_u) * Lw !!!..... v.w = cos(angle_v) * Lw - + matrix(1,:) = N(:) matrix(2,:) = elem_direction(:,ne_1) matrix(3,:) = elem_direction(:,ne_2) @@ -2265,12 +2266,12 @@ subroutine mesh_2d_from_1d_crux(np0,ne_1,ne_2,distance,new_coords_derivs) else weight = 0.75_dp endif - + new_coords_derivs(1,1,1:3,5) = node_xyz(1:3,np0) + W(1:3) * distance * weight new_coords_derivs(1,2,:,5) = new_coords_derivs(1,1,:,5) call enter_exit(sub_name,2) - + end subroutine mesh_2d_from_1d_crux !!!########################################################################### @@ -2285,7 +2286,7 @@ subroutine merge_2d_from_1d_mesh character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'merge_2d_from_1d_mesh' call enter_exit(sub_name,1) @@ -2322,7 +2323,7 @@ subroutine merge_2d_from_1d_mesh ne = ne + 4 ! skip to next ring endif enddo - + non_zero = 0 do np = 1,num_nodes_2d if(nodes_2d(np).ne.0)then @@ -2330,7 +2331,7 @@ subroutine merge_2d_from_1d_mesh endif enddo num_nodes_2d = non_zero - + non_zero = 0 do ne = 1,num_elems_2d if(elems_2d(ne).ne.0)then @@ -2357,7 +2358,7 @@ subroutine merge_trifurcations(short_elements) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'merge_trifurcations' call enter_exit(sub_name,1) @@ -2367,8 +2368,8 @@ subroutine merge_trifurcations(short_elements) ! for each of the 'short' surface elements, delete them by joining the ! parent and child elements together. Work on a group of 4 elements at ! a time, where the four elements run in the Xi1 direction == a ring - ! of elements in a cylinder . - + ! of elements in a cylinder . + do while (ne /= 0) ne_parent = elem_cnct_2d(-2,1,ne) ! element proximal to the current one ne_child = elem_cnct_2d(2,1,ne) ! element distal to the current one @@ -2387,7 +2388,7 @@ subroutine merge_trifurcations(short_elements) elem_nodes_2d(3,ne_parent) = elem_nodes_2d(3,ne) elem_versn_2d(3,ne_parent) = elem_versn_2d(3,ne) elems_2d(ne) = 0 - + k = k + 1 ne = short_elements(k) ne_parent = elem_cnct_2d(-2,1,ne) @@ -2441,19 +2442,19 @@ subroutine merge_trifurcations(short_elements) k = k + 1 ne = short_elements(k) enddo - + num_nodes_2d = count(nodes_2d.ne.0) num_elems_2d = count(elems_2d.ne.0) - + call enter_exit(sub_name,2) - + end subroutine merge_trifurcations !!!############################################################################# subroutine define_rad_from_file(FIELDFILE, radius_type_in) - !*define_rad_from_file:* reads in a radius field associated with an - ! airway tree and assigns radius information to each element, also + !*define_rad_from_file:* reads in a radius field associated with an + ! airway tree and assigns radius information to each element, also ! calculates volume of each element character(len=MAX_FILENAME_LEN), intent(in) :: FIELDFILE @@ -2469,23 +2470,23 @@ subroutine define_rad_from_file(FIELDFILE, radius_type_in) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'define_rad_from_file' call enter_exit(sub_name,1) - + versions = .TRUE. if(present(radius_type_in))then radius_type = radius_type_in else radius_type = 'no_taper' endif - + if(index(FIELDFILE, ".ipfiel")> 0) then !full filename is given readfile = FIELDFILE(1:250) else ! need to append the correct filename extension readfile = trim(FIELDFILE)//'.ipfiel' endif - + open(10, file=readfile, status='old') !!! check whether reading in a node-based or element-based field @@ -2512,7 +2513,7 @@ subroutine define_rad_from_file(FIELDFILE, radius_type_in) exit read_versions !exit the named do loop endif end do read_versions - + np = 0 !.....read the coordinate, derivative, and version information for each node. read_a_node : do !define a do loop name @@ -2573,7 +2574,7 @@ subroutine define_rad_from_file(FIELDFILE, radius_type_in) ne = 0 ne_counter = 0 - + read_an_elem : do !define a do loop name !.......read element number read(unit=10, fmt="(a)", iostat=ierror) ctemp1 @@ -2599,7 +2600,7 @@ subroutine define_rad_from_file(FIELDFILE, radius_type_in) end do read_an_elem endif - + !!! Calculate element volume do ne = 1,num_elems if(radius_type.eq.'taper')then @@ -2619,7 +2620,7 @@ subroutine define_rad_from_file(FIELDFILE, radius_type_in) enddo call enter_exit(sub_name,2) - + end subroutine define_rad_from_file !!!############################################################################# @@ -2647,7 +2648,7 @@ subroutine define_rad_from_geom(ORDER_SYSTEM, CONTROL_PARAM, START_FROM, & character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'define_rad_from_geom' call enter_exit(sub_name,1) @@ -2680,7 +2681,7 @@ subroutine define_rad_from_geom(ORDER_SYSTEM, CONTROL_PARAM, START_FROM, & else!element number defined read (START_FROM,'(I10)') ne_start endif - + ne=ne_start if(ORDER_SYSTEM(1:3).eq.'fit')then @@ -2709,7 +2710,7 @@ subroutine define_rad_from_geom(ORDER_SYSTEM, CONTROL_PARAM, START_FROM, & enddo endif enddo - + else !Strahler and Horsfield ordering system @@ -2738,11 +2739,38 @@ subroutine define_rad_from_geom(ORDER_SYSTEM, CONTROL_PARAM, START_FROM, & endif call enter_exit(sub_name,2) - + end subroutine define_rad_from_geom + !!!############################################################################# + + subroutine occlude_vessel(VESSEL_NUMBER, RATIO) + !*occlude_vessel:* Occludes/modifies vessel or airway radius based on + ! the ratio provided by user. This subroutine is made for partial occlusions + ! where the vessel (artery or vein) element number and the ratio is provided by user + ! and this will be applied on unstrained radius of the vessels. This subroutine should + ! be called after define_rad_from_geom/file so that the tree radii are identified. + ! This subroutine is useful for running Pulmonary hypertension or pulmonary embolism cases. + + integer, intent(in) :: VESSEL_NUMBER ! Element number that you want to apply occlusion on + real(dp), intent(in) :: RATIO ! partial/or full occlsion ratio (100 means full occlusions + ! and any other number between 0 and 100 is partial occlusion) + + character(len=60) :: sub_name + + ! -------------------------------------------------------------------------- + + sub_name = 'occlude_vessel' + call enter_exit(sub_name,1) + + elem_field(ne_radius, VESSEL_NUMBER) = RATIO * elem_field(ne_radius, VESSEL_NUMBER) + + call enter_exit(sub_name,2) + + end subroutine occlude_vessel + !!!############################################################################# - + subroutine element_connectivity_1d() !*element_connectivity_1d:* Calculates element connectivity in 1D and ! stores in array elem_cnct @@ -2753,15 +2781,15 @@ subroutine element_connectivity_1d() character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'element_connectivity_1d' call enter_exit(sub_name,1) - + elem_cnct = 0 !initialise ! calculate elems_at_node array: stores the elements that nodes are in elems_at_node(1:num_nodes,0) = 0 !initialise number of adjacent elements - + do ne=1,num_elems do nn=1,2 np=elem_nodes(nn,ne) @@ -2769,11 +2797,11 @@ subroutine element_connectivity_1d() elems_at_node(np,elems_at_node(np,0))=ne ! local element that np is in enddo !nn enddo !noelem - + ! calculate elem_cnct array: stores the connectivity of all elements - + elem_cnct=0 !initialise all elem_cnct - + do ne=1,num_elems ! ne_global=elems(noelem) if(NNT == 2) THEN !1d @@ -2790,13 +2818,13 @@ subroutine element_connectivity_1d() enddo !noelem2 endif enddo - + call enter_exit(sub_name,2) end subroutine element_connectivity_1d !!!############################################################################# - + subroutine element_connectivity_2d !*element_connectivity_2d:* Calculates element connectivity in 2D and ! stores in array elem_cnct_2d @@ -2807,21 +2835,21 @@ subroutine element_connectivity_2d character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'element_connectivity_2d' call enter_exit(sub_name,1) - + if(allocated(elems_at_node_2d))then deallocate(elem_cnct_2d) deallocate(elems_at_node_2d) endif allocate(elem_cnct_2d(-2:2,0:10,num_elems_2d)) allocate(elems_at_node_2d(num_nodes_2d,0:10)) - + !!! calculate elems_at_node_2d array: stores the elements that nodes are in - + elems_at_node_2d = 0 !initialise all - + do ne = 1,num_elems_2d do nn = 1,num_elem_nodes np = elem_nodes_2d(nn,ne) @@ -2829,11 +2857,11 @@ subroutine element_connectivity_2d elems_at_node_2d(np,elems_at_node_2d(np,0)) = ne !element that np is in enddo !nn enddo !noelem - + !!! calculate elem_cnct_2d array: stores the connectivity of all elements - + elem_cnct_2d = 0 !initialise all elem_cnct_2d - + do ne = 1,num_elems_2d ! for each of the 2d elements np_list(1:4) = elem_nodes_2d(1:4,ne) ! the list of nodes in the element (including repeated) !!! check the elements attached to the 1st node @@ -2844,13 +2872,13 @@ subroutine element_connectivity_2d if(np_list(2).ne.np_list(1))then ! only if first two nodes are not repeated if(inlist(np_list(2),np_list_2))then elem_cnct_2d(-2,0,ne) = elem_cnct_2d(-2,0,ne)+1 - elem_cnct_2d(-2,elem_cnct_2d(-2,0,ne),ne) = ne2 + elem_cnct_2d(-2,elem_cnct_2d(-2,0,ne),ne) = ne2 endif endif if(np_list(3).ne.np_list(1))then ! only if the two nodes are not repeated if(inlist(np_list(3),np_list_2))then elem_cnct_2d(-1,0,ne) = elem_cnct_2d(-1,0,ne)+1 - elem_cnct_2d(-1,elem_cnct_2d(-1,0,ne),ne) = ne2 + elem_cnct_2d(-1,elem_cnct_2d(-1,0,ne),ne) = ne2 endif endif endif @@ -2863,28 +2891,28 @@ subroutine element_connectivity_2d if(np_list(2).ne.np_list(4))then ! only if two nodes are not repeated if(inlist(np_list(2),np_list_2))then elem_cnct_2d(1,0,ne) = elem_cnct_2d(1,0,ne)+1 - elem_cnct_2d(1,elem_cnct_2d(1,0,ne),ne) = ne2 + elem_cnct_2d(1,elem_cnct_2d(1,0,ne),ne) = ne2 endif endif if(np_list(3).ne.np_list(4))then ! only if the two nodes are not repeated if(inlist(np_list(3),np_list_2))then elem_cnct_2d(2,0,ne) = elem_cnct_2d(2,0,ne)+1 - elem_cnct_2d(2,elem_cnct_2d(2,0,ne),ne) = ne2 + elem_cnct_2d(2,elem_cnct_2d(2,0,ne),ne) = ne2 endif endif endif enddo !noelem2 enddo - + call enter_exit(sub_name,2) - + end subroutine element_connectivity_2d !!!############################################################################# subroutine line_segments_for_2d_mesh(sf_option) !*line_segments_for_2d_mesh:* set up the line segment arrays for a 2d mesh - + character(len=4),intent(in) :: sf_option ! Local variables integer :: index_nodes(2,4),j,line_nodes(2),ne,ne_adjacent,ni1,nj, & @@ -2892,26 +2920,26 @@ subroutine line_segments_for_2d_mesh(sf_option) logical :: MAKE logical :: based_on_elems = .true., found_nl character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'line_segments_for_2d_mesh' call enter_exit(sub_name,1) nxi = [1,1,2,2] index_nodes = reshape([1,2,3,4,1,3,2,4],shape(index_nodes)) - + if(allocated(elem_lines_2d)) deallocate(elem_lines_2d) if(allocated(scale_factors_2d)) deallocate(scale_factors_2d) allocate(elem_lines_2d(4,num_elems_2d)) allocate(scale_factors_2d(16,num_elems_2d)) - + elem_lines_2d = 0 num_lines_2d = 4 * num_elems_2d - + if(based_on_elems)then elem_lines_2d = 0 - + if(allocated(lines_2d)) deallocate(lines_2d) if(allocated(line_versn_2d)) deallocate(line_versn_2d) if(allocated(lines_in_elem)) deallocate(lines_in_elem) @@ -2921,7 +2949,7 @@ subroutine line_segments_for_2d_mesh(sf_option) allocate(line_versn_2d(2,3,num_lines_2d)) allocate(lines_in_elem(0:4,num_lines_2d)) allocate(nodes_in_line(3,0:3,num_lines_2d)) - allocate(arclength(num_lines_2d)) + allocate(arclength(num_lines_2d)) lines_in_elem = 0 lines_2d = 0 @@ -2954,7 +2982,7 @@ subroutine line_segments_for_2d_mesh(sf_option) lines_2d(num_lines_2d) = num_lines_2d !record a new line number lines_in_elem(0,num_lines_2d) = lines_in_elem(0,num_lines_2d) + 1 lines_in_elem(lines_in_elem(0,num_lines_2d),num_lines_2d) = ne !line num_lines_2d is in element ne - elem_lines_2d(nline,ne) = num_lines_2d + elem_lines_2d(nline,ne) = num_lines_2d nodes_in_line(2,1,num_lines_2d) = np1 nodes_in_line(3,1,num_lines_2d) = np2 nodes_in_line(1,0,num_lines_2d) = nxi(nline) @@ -2969,11 +2997,11 @@ subroutine line_segments_for_2d_mesh(sf_option) enddo !nline enddo ! ne endif - + call calc_scale_factors_2d(sf_option) - + call enter_exit(sub_name,2) - + end subroutine line_segments_for_2d_mesh !!!############################################################################# @@ -2987,12 +3015,12 @@ subroutine evaluate_ordering() n_generation,n_horsfield,OUTLETS,STRAHLER,STRAHLER_ADD,temp1 LOGICAL :: DISCONNECT,DUPLICATE character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'evaluate_ordering' call enter_exit(sub_name,1) - + !!! Calculate branch generations elem_ordrs = 0 maxgen=1 @@ -3044,7 +3072,7 @@ subroutine evaluate_ordering() elem_ordrs(2,ne)=n_horsfield !store the Horsfield order elem_ordrs(3,ne)=STRAHLER+STRAHLER_ADD !Strahler order enddo !noelem - + !!! Check for disconnected nodes and number of inlets and outlets DUPLICATE=.FALSE. do ne=1,num_elems @@ -3054,7 +3082,7 @@ subroutine evaluate_ordering() DUPLICATE=.TRUE. endif enddo - + DISCONNECT=.FALSE. INLETS=0 OUTLETS=0 @@ -3070,9 +3098,9 @@ subroutine evaluate_ordering() WRITE(*,*) ' Node ',np,' attached to',num_attach,' elements' endif enddo - + call enter_exit(sub_name,2) - + end subroutine evaluate_ordering !!!############################################################################# @@ -3081,7 +3109,7 @@ subroutine set_initial_volume(Gdirn,COV,total_volume,Rmax,Rmin) !*set_initial_volume:* assigns a volume to terminal units appended on a ! tree structure based on an assumption of a linear gradient in the ! gravitational direction with max, min, and COV values defined. - + integer,intent(in) :: Gdirn real(dp),intent(in) :: COV,total_volume,Rmax,Rmin ! Local parameters @@ -3091,20 +3119,20 @@ subroutine set_initial_volume(Gdirn,COV,total_volume,Rmax,Rmin) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'set_initial_volume' call enter_exit(sub_name,1) - + volume_estimate = 1.0_dp volume_of_tree = 0.0_dp - + call volume_of_mesh(volume_estimate,volume_of_tree) - + random_number=-1.1_dp - + Vmax = Rmax * (total_volume-volume_estimate)/elem_units_below(1) Vmin = Rmin * (total_volume-volume_estimate)/elem_units_below(1) - + !!! for each elastic unit find the maximum and minimum coordinates in the Gdirn direction max_z=-1.0e+6_dp min_z=1.0e+6_dp @@ -3114,10 +3142,10 @@ subroutine set_initial_volume(Gdirn,COV,total_volume,Rmax,Rmin) max_z=MAX(max_z,node_xyz(Gdirn,np2)) min_z=MIN(min_z,node_xyz(Gdirn,np2)) enddo !nunit - + range_z=abs(max_z-min_z) if(abs(range_z).le.1.0e-5_dp) range_z=1.0_dp - + !!! for each elastic unit allocate a size based on a gradient in the Gdirn direction, and !!! perturb by a user-defined COV. This should be calling a random number generator. do nunit=1,num_units @@ -3129,20 +3157,20 @@ subroutine set_initial_volume(Gdirn,COV,total_volume,Rmax,Rmin) unit_field(nu_vol,nunit)=(Vmax*Xi+Vmin*(1.0_dp-Xi))*(1.0_dp+COV*random_number) unit_field(nu_vt,nunit)=0.0_dp !initialise the tidal volume to a unit enddo !nunit - + ! correct unit volumes such that total volume is exactly as specified call volume_of_mesh(volume_estimate,volume_of_tree) factor_adjust = (total_volume-volume_of_tree)/(volume_estimate-volume_of_tree) do nunit=1,num_units unit_field(nu_vol,nunit) = unit_field(nu_vol,nunit)*factor_adjust enddo - + write(*,'('' Number of elements is '',I5)') num_elems write(*,'('' Initial volume is '',F6.2,'' L'')') total_volume/1.0e+6_dp write(*,'('' Deadspace volume is '',F6.1,'' mL'')') volume_of_tree/1.0e+3_dp - + call enter_exit(sub_name,2) - + end subroutine set_initial_volume !!!############################################################################# @@ -3150,7 +3178,7 @@ end subroutine set_initial_volume subroutine volume_of_mesh(volume_model,volume_tree) !*volume_of_mesh:* calculates the volume of an airway mesh including ! conducting and respiratory airways - + real(dp) :: volume_model,volume_tree ! Local Variables integer :: ne,ne0,nunit @@ -3161,10 +3189,10 @@ subroutine volume_of_mesh(volume_model,volume_tree) sub_name = 'volume_of_mesh' call enter_exit(sub_name,1) - + if(.not.allocated(vol_anat)) allocate(vol_anat(num_elems)) if(.not.allocated(vol_below)) allocate(vol_below(num_elems)) - + vol_anat = elem_field(ne_vol,1:num_elems) !initialise to branch volume vol_below = elem_field(ne_vol,1:num_elems) !initialise to branch volume @@ -3188,16 +3216,16 @@ subroutine volume_of_mesh(volume_model,volume_tree) deallocate(vol_anat) deallocate(vol_below) - + call enter_exit(sub_name,2) - + end subroutine volume_of_mesh !!!############################################################################# subroutine write_geo_file(type, filename) !*write_geo_file:* converts a surface mesh (created using make_2d_vessel_from_1d) - ! into a gmsh formatted mesh and writes to file. + ! into a gmsh formatted mesh and writes to file. ! options on 'type': 1== single layered surface mesh of the vessel wall ! 2== double-layered thick-walled volume mesh of vessel wall ! 3== volume mesh of vessel lumen @@ -3215,19 +3243,19 @@ subroutine write_geo_file(type, filename) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'write_geo_file' call enter_exit(sub_name,1) opfile = trim(filename)//'.geo' open(10, file=opfile, status='replace') - + write(ifile,'(''/***********************'')') write(ifile,'(''*'')') write(ifile,'(''* Conversion of LungSim to GMSH'')') write(ifile,'(''*'')') write(ifile,'(''***********************/'')') - + write(ifile,'(/''lc ='',f8.4,'';'')') lc0 write(ifile,'(/''sc ='',f8.4,'';'')') lc1 write(ifile,'(/)') @@ -3236,14 +3264,14 @@ subroutine write_geo_file(type, filename) allocate(elem_surfaces(5,num_elems_2d)) element_spline = 0 elem_surfaces = 0 - ncount_spline = 0 + ncount_spline = 0 np_offset = 0 if(type.eq.1)then !!! write out a surface mesh that describes a structured vessel surface call write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & ncount_loop,ncount_spline,np_offset) - + else if(type.eq.2)then !!! write out a volume that encloses a thick-walled vessel tree. Make a gmsh .geo file !!! for the surface of the tree, then copy, scale, and translate to get an 'outer shell'. @@ -3288,11 +3316,11 @@ subroutine write_geo_file(type, filename) close(ifile) call enter_exit(sub_name,2) - + end subroutine write_geo_file - + !!!############################################################################# - + function get_final_real(string) !*get_final_real:* gets the last real number on a string @@ -3301,9 +3329,9 @@ function get_final_real(string) integer :: ibeg,iend real(dp) :: rsign,rtemp,get_final_real character :: sub_string*(40) - + ! -------------------------------------------------------------------------- - + iend=len(string) !get the length of the string ibeg=index(string,":")+1 !get location of real in string sub_string = adjustl(string(ibeg:iend)) ! get the characters beyond : @@ -3315,12 +3343,12 @@ function get_final_real(string) rsign=1.0_dp ibeg=1 endif - + read (sub_string(ibeg:iend), * ) rtemp !get real value rtemp=rtemp*rsign !apply sign to number - + get_final_real=rtemp !return the real value - + end function get_final_real !!!############################################################################# @@ -3338,10 +3366,10 @@ subroutine get_final_string(string,rtemp) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'get_final_string' call enter_exit(sub_name,1) - + iend=len(string) !get the length of the string ibeg=index(string,":")+1 !get location of real in string sub_string = adjustl(string(ibeg:iend)) ! get the characters beyond : @@ -3355,7 +3383,7 @@ subroutine get_final_string(string,rtemp) endif read (sub_string(ibeg:iend), '(D25.17)' ) rtemp !get real value rtemp=rtemp*rsign !apply sign to number - + call enter_exit(sub_name,2) end subroutine get_final_string @@ -3373,10 +3401,10 @@ subroutine get_local_node(np_global,np_local) character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'get_local_node' call enter_exit(sub_name,1) - + np=1 found=.false. do while (.not.found) @@ -3390,13 +3418,13 @@ subroutine get_local_node(np_global,np_local) np=np+1 endif enddo - + np_local = np call enter_exit(sub_name,2) end subroutine get_local_node - + !!!############################################################################# function get_parent_branch(ne) @@ -3422,7 +3450,7 @@ function get_parent_branch(ne) endif end function get_parent_branch - + !!!############################################################################# subroutine geo_entry_exit_cap(element_spline,ifile,ncount_loop, & @@ -3435,13 +3463,13 @@ subroutine geo_entry_exit_cap(element_spline,ifile,ncount_loop, & character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'geo_entry_exit_cap' call enter_exit(sub_name,1) - + ne = 1 do while (ne.le.num_elems_2d) - + if(elem_cnct_2d(-2,0,ne).eq.0)then do k = 0,3 np1 = elem_nodes_2d(1,ne+k) @@ -3469,7 +3497,7 @@ subroutine geo_entry_exit_cap(element_spline,ifile,ncount_loop, & ncount_loop, ncount_loop - 1 enddo endif - + if(elem_cnct_2d(2,0,ne).eq.0)then do k = 0,3 np1 = elem_nodes_2d(3,ne+k) @@ -3497,32 +3525,32 @@ subroutine geo_entry_exit_cap(element_spline,ifile,ncount_loop, & ncount_loop, ncount_loop - 1 enddo endif - + ne = ne + 4 enddo call enter_exit(sub_name,2) - + end subroutine geo_entry_exit_cap !!!############################################################################# subroutine geo_node_offset(node_xyz_offset) - + real(dp) :: node_xyz_offset(:,:) ! Local variables integer:: j,k,ne,np1 real(dp) :: point_temp(3),point_xyz_centre(3),wall_thickness character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'geo_node_offset' call enter_exit(sub_name,1) - + ne = 1 do while (ne.le.num_elems_2d) - + !!!....nodes at model entry if(elem_cnct_2d(-2,0,ne).eq.0)then point_xyz_centre(:) = 0.0_dp @@ -3538,10 +3566,10 @@ subroutine geo_node_offset(node_xyz_offset) np1 = elem_nodes_2d(1,ne+k) point_temp(1:3) = node_xyz_2d(1,1,1:3,np1) node_xyz_offset(:,np1) = wall_thickness * & - direction_point_to_point(point_xyz_centre,point_temp) + direction_point_to_point(point_xyz_centre,point_temp) enddo ! k endif ! elem_cnct - + !!!....nodes at Xi2=1 ends of 'rings' point_xyz_centre(:) = 0.0_dp do k = 0,3 @@ -3569,15 +3597,15 @@ subroutine geo_node_offset(node_xyz_offset) endif ne = ne + 4 - + enddo ! while (ne.le.num_elems_2d) - + call enter_exit(sub_name,2) - + end subroutine geo_node_offset - + !!!############################################################################# - + subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) !*reallocate_node_elem_arrays:* Reallocates the size of geometric ! arrays when modifying geometries @@ -3595,34 +3623,34 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) sub_name = 'reallocate_node_elem_arrays' call enter_exit(sub_name,1) - + allocate(nodelem_temp(num_nodes)) nodelem_temp = nodes ! copy to temporary array deallocate(nodes) !deallocate initially allocated memory allocate(nodes(num_nodes_new)) nodes(1:num_nodes)=nodelem_temp(1:num_nodes) deallocate(nodelem_temp) !deallocate the temporary array - + allocate(xyz_temp(3,num_nodes)) xyz_temp=node_xyz deallocate(node_xyz) allocate(node_xyz(3,num_nodes_new)) node_xyz(1:3,1:num_nodes)=xyz_temp(1:3,1:num_nodes) - + allocate(nodelem_temp(num_elems)) nodelem_temp = elems ! copy to temporary array deallocate(elems) !deallocate initially allocated memory allocate(elems(num_elems_new)) elems(1:num_elems)=nodelem_temp(1:num_elems) deallocate(nodelem_temp) !deallocate the temporary array - + allocate(enodes_temp(2,num_elems)) enodes_temp=elem_nodes deallocate(elem_nodes) allocate(elem_nodes(2,num_elems_new)) elem_nodes(1:2,1:num_elems)=enodes_temp(1:2,1:num_elems) deallocate(enodes_temp) - + if(allocated(elem_field).and.num_ne.gt.0)then allocate(rnodes_temp(num_ne,num_elems)) rnodes_temp=elem_field @@ -3632,7 +3660,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) deallocate(rnodes_temp) elem_field(1:num_ne,num_elems+1:num_elems_new) = 0.0_dp endif - + allocate(rnodes_temp(3,num_elems)) rnodes_temp=elem_direction deallocate(elem_direction) @@ -3640,7 +3668,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) elem_direction(1:3,1:num_elems)=rnodes_temp(1:3,1:num_elems) deallocate(rnodes_temp) elem_direction(1:3,num_elems+1:num_elems_new) = 0.0_dp - + if(allocated(node_field).and.num_nj.gt.0)then allocate(rnodes_temp(num_nj,num_nodes)) rnodes_temp=node_field @@ -3650,7 +3678,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) deallocate(rnodes_temp) node_field(1:num_nj,num_nodes+1:num_nodes_new)=0.0_dp endif - + allocate(nodelem_temp(num_elems)) nodelem_temp = elem_symmetry ! copy to temporary array deallocate(elem_symmetry) !deallocate initially allocated memory @@ -3658,7 +3686,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) elem_symmetry(1:num_elems)=nodelem_temp(1:num_elems) deallocate(nodelem_temp) !deallocate the temporary array elem_symmetry(num_elems+1:num_elems_new)=1 - + allocate(enodes_temp2(-1:1,0:2,0:num_elems)) enodes_temp2=elem_cnct deallocate(elem_cnct) @@ -3666,7 +3694,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) elem_cnct(-1:1,0:2,0:num_elems)=enodes_temp2(-1:1,0:2,0:num_elems) deallocate(enodes_temp2) elem_cnct(-1:1,0:2,num_elems+1:num_elems_new) = 0 - + allocate(enodes_temp(num_ord,num_elems)) enodes_temp=elem_ordrs deallocate(elem_ordrs) @@ -3674,7 +3702,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) elem_ordrs(1:num_ord,1:num_elems)=enodes_temp(1:num_ord,1:num_elems) deallocate(enodes_temp) elem_ordrs(1:num_ord,num_elems+1:num_elems_new) = 0 - + if(allocated(elem_units_below).and.num_nu.gt.0)then allocate(nodelem_temp(num_elems)) nodelem_temp=elem_units_below @@ -3684,7 +3712,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) deallocate(nodelem_temp) elem_units_below(num_elems+1:num_elems_new)=0 endif - + allocate(enodes_temp(num_nodes,0:3)) enodes_temp=elems_at_node deallocate(elems_at_node) @@ -3692,7 +3720,7 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) elems_at_node(1:num_nodes,0:3)=enodes_temp(1:num_nodes,0:3) deallocate(enodes_temp) elems_at_node(num_nodes+1:num_nodes_new,0:3)=0 - + if(model_type.eq.'gas_mix')then allocate(exp_temp(num_elems)) exp_temp = expansile @@ -3702,15 +3730,15 @@ subroutine reallocate_node_elem_arrays(num_elems_new,num_nodes_new) deallocate(exp_temp) expansile(num_elems+1:num_elems_new)=.false. endif - + call enter_exit(sub_name,2) - + end subroutine reallocate_node_elem_arrays - + !!!############################################################################# - + function get_local_node_f(ndimension,np_global) result(get_local_node) - + integer,intent(in) :: ndimension,np_global ! Local variables integer :: np @@ -3721,9 +3749,9 @@ function get_local_node_f(ndimension,np_global) result(get_local_node) found = .false. np = 0 - + select case (ndimension) - + case(1) do while (.not.found) np=np+1 @@ -3736,7 +3764,7 @@ function get_local_node_f(ndimension,np_global) result(get_local_node) found = .true. endif enddo - + case(2) do while (.not.found) np=np+1 @@ -3750,24 +3778,24 @@ function get_local_node_f(ndimension,np_global) result(get_local_node) found = .true. endif enddo - + end select - + end function get_local_node_f - + !!!############################################################################# - + function get_final_integer(string) !*get_final_integer* - + character,intent(in) :: string*(*) ! Local parameters integer :: ibeg,iend,ierror,nsign,ntemp character :: sub_string*(40) integer :: get_final_integer - + ! -------------------------------------------------------------------------- - + iend=len(string) !get the length of the string ibeg=index(string,":")+1 !get location of integer in string, follows ":" sub_string = adjustl(string(ibeg:iend)) ! get the characters beyond ":" @@ -3779,7 +3807,7 @@ function get_final_integer(string) nsign=1 ibeg=1 endif - + read (sub_string(ibeg:iend), '(i10)', iostat=ierror ) ntemp !get integer values if(ierror.gt.0)then !... something wrong with data @@ -3787,13 +3815,13 @@ function get_final_integer(string) write(*,'(a)') sub_string(ibeg:iend) endif ntemp=ntemp*nsign !apply sign to number - + get_final_integer=ntemp !return the integer value - + end function get_final_integer - + !!!############################################################################# - + subroutine get_four_nodes(ne,string) integer, intent(in) :: ne @@ -3812,7 +3840,7 @@ subroutine get_four_nodes(ne,string) ibeg=index(string,":")+1 !get location of first integer in string sub_string = adjustl(string(ibeg:iend)) ! get the characters beyond : and remove the leading blanks i_ss_end=len(sub_string) !get the end location of the sub-string - + ibeg=1 do nn=1,4 iend=index(sub_string," ") !get location of first blank in sub-string @@ -3822,9 +3850,9 @@ subroutine get_four_nodes(ne,string) enddo ! nn call enter_exit(sub_name,2) - + end subroutine get_four_nodes - + !!!############################################################################# subroutine redistribute_mesh_nodes_2d_from_1d @@ -3837,7 +3865,7 @@ subroutine redistribute_mesh_nodes_2d_from_1d character(len=60) :: sub_name ! -------------------------------------------------------------------------- - + sub_name = 'redistribute_mesh_nodes_2d_from_1d' call enter_exit(sub_name,1) @@ -3865,11 +3893,11 @@ subroutine redistribute_mesh_nodes_2d_from_1d point4(1:3) = node_xyz_2d(1,1,1:3,np) ! the location of the crux node ! calculate the distance from the crux (point4) to the plane of first adjacent ring line_length = distance_from_plane_to_point(point1,point2,point3,point4) - + point1(1:3) = node_xyz_2d(1,1,1:3,np-1) ! the location of the 'back' node of bifurcation !! ! calculate the line length from back node to a point on the first ring !! distance_to_crux_last = distance_between_points(point1,point2) - + continue = .true. do while(continue) ! keep going: note that bifurcation will have > 1 version at nodes if(elem_cnct_2d(2,0,ne).eq.0)then ! no adjacent 2d elements in Xi+2 direction @@ -3891,16 +3919,16 @@ subroutine redistribute_mesh_nodes_2d_from_1d node_xyz_2d(1,1,1:3,np_last) vector = unit_vector(vector) nedirection(1:3,num_list-1) = vector(1:3) ! store the direction - ! continue until the next bifurcation is detected (nodes with > 1 version) + ! continue until the next bifurcation is detected (nodes with > 1 version) if(node_versn_2d(np_adjacent).ne.1) continue = .false. endif enddo line_length = line_length/real(num_list) ! this is the length to redistribute rings to - + !!! adjust the location of the nodes in each 'ring' do j = 1,num_list - 1 ! only adjust the rings that are between bifns: last 'ring' is actually the next bifn - + ! first get the list of nodes in the ring ring1_nodes(1) = nplist(j) ne_adjacent = elem_cnct_2d(1,1,nelist(j)) ! get the next element in the +Xi1 direction @@ -3908,10 +3936,10 @@ subroutine redistribute_mesh_nodes_2d_from_1d ring1_nodes(k) = elem_nodes_2d(4,ne_adjacent) ne_adjacent = elem_cnct_2d(1,1,ne_adjacent) ! get the next element in the +Xi1 direction enddo ! k - + ! assume that the direction for adjustment is defined by location of adjacent rings vector(1:3) = nedirection(1:3,j) - + ! calculate the ring displacement = j*line_length - (distance from crux) point1(1:3) = node_xyz_2d(1,1,1:3,ring1_nodes(1)) point2(1:3) = node_xyz_2d(1,1,1:3,ring1_nodes(2)) @@ -3919,7 +3947,7 @@ subroutine redistribute_mesh_nodes_2d_from_1d point4(1:3) = node_xyz_2d(1,1,1:3,np) displace_length = real(j) * line_length - & distance_from_plane_to_point(point1,point2,point3,point4) - + ! update the location of the four nodes in the current ring do k = 1,4 node_xyz_2d(1,1,1:3,ring1_nodes(k)) = & @@ -3931,15 +3959,15 @@ subroutine redistribute_mesh_nodes_2d_from_1d endif np = np + 1 ! increment to check the next node enddo - + call enter_exit(sub_name,2) - + end subroutine redistribute_mesh_nodes_2d_from_1d !!!############################################################################# - + function coord_at_xi(ne,xi,basis) - + integer,intent(in) :: ne real(dp),intent(in) :: xi(:) character(len=*),intent(in) :: basis @@ -3949,7 +3977,7 @@ function coord_at_xi(ne,xi,basis) real(dp) :: coord_at_xi(3) ! -------------------------------------------------------------------------- - + select case (basis) case('linear') forall (nn=1:4) x(1,1:3,nn) = node_xyz_2d(1,1,1:3,elem_nodes_2d(nn,ne)) @@ -3957,10 +3985,10 @@ function coord_at_xi(ne,xi,basis) phi(2) = xi(1)*(1.0_dp - xi(2)) phi(3) = (1.0_dp - xi(1))*xi(2) phi(4) = xi(1)*xi(2) - + coord_at_xi(1:3) = phi(1)*x(1,1:3,1)+phi(2)*x(1,1:3,2)+phi(3)* & x(1,1:3,3)+phi(4)*x(1,1:3,4) - + case('hermite') do nn=1,4 nv = elem_versn_2d(nn,ne) @@ -3991,9 +4019,9 @@ function coord_at_xi(ne,xi,basis) + phi_11(1)*phi_21(2)*x(4,1:3,3) & + phi_21(1)*phi_21(2)*x(4,1:3,4) end select - + end function coord_at_xi - + !!!############################################################################# function get_local_elem(ne_global) @@ -4033,7 +4061,7 @@ end function get_local_elem_1d !!!############################################################################# function where_inlist(item,ilist) - + integer :: item,ilist(:) integer :: n integer :: where_inlist @@ -4041,9 +4069,9 @@ function where_inlist(item,ilist) do n=1,size(ilist) if(item == ilist(n)) where_inlist = n enddo - + end function where_inlist - + !!!########################################################################### subroutine write_elem_geometry_2d(elemfile) @@ -4053,7 +4081,7 @@ subroutine write_elem_geometry_2d(elemfile) integer :: ne,ne_count,nglobal_list(4),np,nv character(len=132) :: writefile character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- sub_name = 'write_elem_geometry_2d' @@ -4061,7 +4089,7 @@ subroutine write_elem_geometry_2d(elemfile) writefile = trim(elemfile)//'.ipelem' open(10, file=writefile, status='replace') - + !.....write the total number of elems write(10,'('' CMISS Version 2.1 ipelem File Version 2'')') write(10,'('' Heading: 2D surface from 1D centreline'')') @@ -4112,15 +4140,15 @@ subroutine write_node_geometry_2d(NODEFILE) integer :: i,np,np_count,nv character(len=132) :: writefile character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'write_node_geometry_2d' call enter_exit(sub_name,1) writefile = trim(nodefile)//'.ipnode' open(10, file=writefile, status='replace') - + !.....write the total number of nodes write(10,'('' CMISS Version 1.21 ipnode File Version 2'')') write(10,'('' Heading: '')') @@ -4146,8 +4174,8 @@ subroutine write_node_geometry_2d(NODEFILE) do i=1,3 write(10,'('' The number of versions for nj='',i1,'' is [1]:'',i2)') i,node_versn_2d(np) do nv=1,node_versn_2d(np) - if(node_versn_2d(np).gt.1) write(10,'('' For version number '',i1,'':'')') nv - !...........coordinate + if(node_versn_2d(np).gt.1) write(10,'('' For version number '',i1,'':'')') nv + !...........coordinate write(10,'('' The Xj('',i1,'') coordinate is [ 0.00000E+00]: '',f12.5)') & i,node_xyz_2d(1,nv,i,np) write(10,'('' The derivative wrt direction 1 is [ 0.00000E+00]: '',f12.5)') & @@ -4163,14 +4191,14 @@ subroutine write_node_geometry_2d(NODEFILE) close(10) call enter_exit(sub_name,2) - + end subroutine write_node_geometry_2d !!!############################################################################# subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & ncount_loop,ncount_spline,np_offset) - + integer :: element_spline(:,:),elem_surfaces(:,:),ifile,ncount_point, & ncount_loop,ncount_spline,np_offset ! Local variables @@ -4180,16 +4208,16 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & real(dp) :: phi_1_0,phi_1_1,phi_2_0,phi_2_1,point_xyz(3),xidivn(3) logical :: repeat character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'write_surface_geo' call enter_exit(sub_name,1) allocate(crux_lines(num_elems,3)) - + forall (i=1:3) xidivn(i) = 0.25_dp * i - + !!! Make a gmsh 'point' at each of the surface mesh nodes write(ifile,'(''/* Points */'')') do np = 1,num_nodes_2d @@ -4197,16 +4225,16 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & write(ifile,'(''Point('',i8,'') = {'',f12.7,'','',f12.7,'','',f12.7,'',lc};'')') & ncount_point,node_xyz_2d(1,1,1:3,np) enddo - + !!! Now work through each 'ring' of four adjoining surface elements. Points are created !!! between adjacent nodes in the Xi1 and Xi2 directions. element_spline = 0 num_crux_lines = 0 ne = 1 - + do while (ne.le.num_elems_2d) - + !!!....make intermediate points, lines, surfaces, at Xi2=0 for model entry ......... if((elem_cnct_2d(-2,0,ne).eq.0) .or. & (node_versn_2d(elem_nodes_2d(1,ne)).eq.6.or.& @@ -4241,7 +4269,7 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & + phi_1_1 * node_xyz_2d(nk,nv1,j,np1) * scale_factors_2d(2,ne+k) & + phi_2_1 * node_xyz_2d(nk,nv2,j,np2) * scale_factors_2d(6,ne+k) enddo - + ncount_point = ncount_point + 1 write(ifile,'(''Point('',i8,'') = {'',f12.7,'','',f12.7,'','',f12.7,'',lc};'')') & ncount_point, point_xyz(1:3) @@ -4260,9 +4288,9 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & endif enddo ! k endif ! elem_cnct etc - + !!!.......make intermediate points, lines, surfaces, at Xi2=1 for each 'ring' ......... - + ! location of points in the Xi+1 direction on the Xi2=1 boundary np_highest = elem_nodes_2d(3,ne) do k = 0,3 @@ -4270,7 +4298,7 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & np2 = elem_nodes_2d(4,ne+k) nv1 = elem_versn_2d(3,ne+k) nv2 = elem_versn_2d(4,ne+k) - nk = 2 + nk = 2 do i = 1,3 phi_1_0 = 1.0_dp - 3.0_dp * xidivn(i)**2 + 2.0_dp * xidivn(i)**3 phi_1_1 = xidivn(i) * (xidivn(i) - 1.0_dp)**2 @@ -4279,8 +4307,8 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & forall (j=1:3) point_xyz(j) = phi_1_0 * node_xyz_2d(1,1,j,np1) & + phi_2_0 * node_xyz_2d(1,1,j,np2) & + phi_1_1 * node_xyz_2d(nk,nv1,j,np1) * scale_factors_2d(10,ne+k) & - + phi_2_1 * node_xyz_2d(nk,nv2,j,np2) * scale_factors_2d(14,ne+k) - + + phi_2_1 * node_xyz_2d(nk,nv2,j,np2) * scale_factors_2d(14,ne+k) + ncount_point = ncount_point + 1 write(ifile,'(''Point('',i8,'') = {'',f12.7,'','',f12.7,'','',f12.7,'',lc};'')') & ncount_point,point_xyz(1:3) @@ -4292,7 +4320,7 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & element_spline(3,ne+k) = ncount_spline if(elem_cnct_2d(2,0,ne+k).gt.0) element_spline(1,elem_cnct_2d(2,1,ne+k)) = ncount_spline enddo ! k - + ! location of points in the Xi+2 direction on the Xi1=0 boundary do k = 0,3 np1 = elem_nodes_2d(1,ne+k) @@ -4309,7 +4337,7 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & + phi_2_0 * node_xyz_2d(1,1,j,np2) & + phi_1_1 * node_xyz_2d(nk,nv1,j,np1) * scale_factors_2d(3,ne+k) & + phi_2_1 * node_xyz_2d(nk,nv2,j,np2) * scale_factors_2d(11,ne+k) - + ncount_point = ncount_point + 1 write(ifile,'(''Point('',i8,'') = {'',f12.7,'','',f12.7,'','',f12.7,'',lc};'')') & ncount_point,point_xyz(1:3) @@ -4321,7 +4349,7 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & element_spline(4,ne+k) = ncount_spline element_spline(2,elem_cnct_2d(-1,1,ne+k)) = ncount_spline enddo ! k - + do k = 0,3 line1 = element_spline(1,ne+k) line2 = element_spline(2,ne+k) @@ -4334,17 +4362,17 @@ subroutine write_surface_geo(element_spline,elem_surfaces,ifile,ncount_point, & write(ifile,'(''Surface('',I8,'') = {'',I8,''};'')') ncount_loop, ncount_loop - 1 elem_surfaces(3,ne+k) = ncount_loop enddo ! k - + ne = ne + 4 - + enddo ! while (ne.le.num_elems_2d) deallocate(crux_lines) - + call enter_exit(sub_name,2) end subroutine write_surface_geo - + !!!############################################################################# subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & @@ -4361,19 +4389,19 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & ncentre(:),ninner(:),nphys_vol(:),node_spoke(:,:),nwall(:) real(dp) :: point_xyz_centre(3), xidivn(3) character(len=60) :: sub_name - + ! -------------------------------------------------------------------------- - + sub_name = 'write_3d_geo' call enter_exit(sub_name,1) - + allocate(centre_points(num_nodes_2d)) allocate(ncap_entry(20)) ! assuming could have multiple inlets - allocate(ncap_exit(num_elems_2d)) - allocate(ninner(num_elems_2d*2)) + allocate(ncap_exit(num_elems_2d)) + allocate(ninner(num_elems_2d*2)) allocate(ncentre(num_elems_2d)) allocate(nphys_vol(num_elems_2d)) - allocate(nwall(num_elems_2d)) + allocate(nwall(num_elems_2d)) allocate(node_spoke(2,num_nodes_2d)) node_spoke = 0 @@ -4384,7 +4412,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & !!!....the following works on four adjacent surface elements !!!......... make intermediate points, lines, surfaces, at Xi2=0 for model entry ......... - + if((elem_cnct_2d(-2,0,ne).eq.0) .or. & (node_versn_2d(elem_nodes_2d(1,ne)).eq.6.or.& node_versn_2d(elem_nodes_2d(2,ne)).eq.6))then @@ -4401,7 +4429,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & ncount_point = ncount_point + 1 write(ifile,'(''Point('',i8,'') = {'',f12.7,'','',f12.7,'','' & &,f12.7,'',lc};'')') ncount_point,point_xyz_centre(1:3) - + ! make a 'spoke' from centre of the ring to each surface node do k = 0,3 np1 = elem_nodes_2d(1,ne+k) @@ -4414,7 +4442,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & ! make surfaces at the entry == a 'cap' of four surfaces do k = 0,3 - line1 = ncount_spline + k - 3 + line1 = ncount_spline + k - 3 line2 = element_spline(1,ne+k) if(k.lt.3)then line3 = -(line1 + 1) @@ -4433,7 +4461,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & enddo ! k endif endif ! elem_cnct etc - + !!!......... make intermediate points, lines, surfaces, at Xi2=1 for each 'ring' ......... ! location of points in the Xi+1 direction on the Xi2=1 boundary @@ -4475,7 +4503,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & if(node_versn_2d(np1).ge.2.or.node_versn_2d(np2).ge.2)then ! only for when there is a crux node np_highest = elem_nodes_2d(2,elem_cnct_2d(1,1,elem_cnct_2d(2,1,ne))) - + if(elems_at_node_2d(np_highest,0).eq.6)then do i = 1,elems_at_node_2d(np_highest,0) ne_next = elems_at_node_2d(np_highest,i) @@ -4516,7 +4544,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & ncount_inner = ncount_inner + 1 ninner(ncount_inner) = ncount_loop enddo ! k - + if(node_versn_2d(np1).ge.2.or.node_versn_2d(np2).ge.2)then ! only for crux node ncount_spline = ncount_spline + 1 write(ifile,'(''Line('',i8,'') = {'',i8,'','',i8,''};'')') & @@ -4557,7 +4585,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & elem_surfaces(1,ne_next) = ncount_loop ne_next = elem_cnct_2d(-2,1,ne_next) elem_surfaces(1,ne_next) = ncount_loop - + if(elems_at_node_2d(np_highest,0).eq.6)then do i = 1,elems_at_node_2d(np_highest,0) ne_next = elems_at_node_2d(np_highest,i) @@ -4580,7 +4608,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & elem_surfaces(1,ne_next) = ncount_loop ne_next = elem_cnct_2d(-2,1,ne_next) elem_surfaces(1,ne_next) = ncount_loop - + ne_next = elem_cnct_2d(1,1,ne_next) np1 = elem_nodes_2d(1,ne_next) np2 = elem_nodes_2d(2,ne_next) @@ -4599,7 +4627,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & elem_surfaces(1,ne_next) = ncount_loop ne_next = elem_cnct_2d(-2,1,ne_next) elem_surfaces(1,ne_next) = ncount_loop - + endif enddo endif @@ -4638,7 +4666,7 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & write(ifile,'(''Surface Loop('',i8,'') = {'',i8,'','' & &,i8,'','',i8,'','',i8,'','',i8,''};'')') & ncount_volume,elem_surfaces(1:5,ne+k) - + ncount_volume = ncount_volume + 1 write(ifile,'(''Volume('',i8,'') = {'',i8,''};'')') & ncount_volume,ncount_volume-1 @@ -4659,28 +4687,28 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & write(ifile,'(i6,'','')', advance = "no") ncap_entry(i) enddo write(ifile,'(i6,''};'')') ncap_entry(ncount_cap_entry) - + write(ifile,'(/''/* Physical surface for exit caps */'')') write(ifile,'(/''Physical Surface(2) = {'')', advance = "no") do i = 1,ncount_cap_exit-1 write(ifile,'(i6,'','')', advance = "no") ncap_exit(i) enddo write(ifile,'(i6,''};'')') ncap_exit(ncount_cap_exit) - + write(ifile,'(/''/* Physical surface for walls */'')') write(ifile,'(/''Physical Surface(3) = {'')', advance = "no") do i = 1,ncount_wall-1 write(ifile,'(i6,'','')', advance = "no") nwall(i) enddo write(ifile,'(i6,''};'')') nwall(ncount_wall) - + write(ifile,'(/''/* Physical surface for centres */'')') write(ifile,'(/''Physical Surface(4) = {'')', advance = "no") do i = 1,ncount_centre-1 write(ifile,'(i6,'','')', advance = "no") ncentre(i) enddo write(ifile,'(i6,''};'')') ncentre(ncount_centre) - + write(ifile,'(/''Physical Volume(1) = {'')', advance = "no") do i = 1,ncount_phys_vol-1 write(ifile,'(i6,'','')', advance = "no") nphys_vol(i) @@ -4704,9 +4732,9 @@ subroutine write_3d_geo(element_spline,elem_surfaces,ifile,ncount_point, & deallocate(node_spoke) call enter_exit(sub_name,2) - + end subroutine write_3d_geo !!!############################################################################# - + end module geometry From dc38b113a75dd34e43558ba43a0ddcf6df9c0bb3 Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Sun, 12 Nov 2023 02:22:28 +1300 Subject: [PATCH 02/13] rigid vessels for occluded ones introduced --- src/lib/geometry.f90 | 7 +- src/lib/pressure_resistance_flow.f90 | 192 ++++++++++++++++++++++++--- 2 files changed, 180 insertions(+), 19 deletions(-) diff --git a/src/lib/geometry.f90 b/src/lib/geometry.f90 index 3897d8af..f398f712 100644 --- a/src/lib/geometry.f90 +++ b/src/lib/geometry.f90 @@ -2762,9 +2762,14 @@ subroutine occlude_vessel(VESSEL_NUMBER, RATIO) sub_name = 'occlude_vessel' call enter_exit(sub_name,1) + write(*,*) "before:", elem_field(ne_radius_in, VESSEL_NUMBER) + ! write(*,*) "ne_radius_in:", elem_field(ne_radius_in,21) elem_field(ne_radius, VESSEL_NUMBER) = RATIO * elem_field(ne_radius, VESSEL_NUMBER) - + elem_field(ne_radius_in, VESSEL_NUMBER) = RATIO * elem_field(ne_radius_in, VESSEL_NUMBER) + elem_field(ne_radius_out, VESSEL_NUMBER) = RATIO * elem_field(ne_radius_out, VESSEL_NUMBER) + write(*,*) "after:", elem_field(ne_radius_in, VESSEL_NUMBER) + ! pause call enter_exit(sub_name,2) end subroutine occlude_vessel diff --git a/src/lib/pressure_resistance_flow.f90 b/src/lib/pressure_resistance_flow.f90 index 583fc487..0347b7aa 100644 --- a/src/lib/pressure_resistance_flow.f90 +++ b/src/lib/pressure_resistance_flow.f90 @@ -976,21 +976,73 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif endif elseif(vessel_type.eq.'elastic_alpha')then - if(Ptm.LT.elasticity_parameters(2))then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - elseif(Ptm.lt.0.0_dp)then - if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - else !ptm>ptmmax - if(nn.eq.1)then - elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) - endif - if(nn.eq.2)then - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + if(Ptm.LT.elasticity_parameters(2))then + if(ne.eq.29)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.44)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.50)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.66)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + else + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + endif + elseif(Ptm.lt.0.0_dp)then + if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 + else !ptm>ptmmax + if(ne.eq.29)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.44)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.50)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.66)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + else + if(nn.eq.1)then + elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + endif + if(nn.eq.2)then + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + endif + endif endif - endif elseif(vessel_type.eq.'elastic_hooke')then h=elasticity_parameters(2)*R0 if(nn.eq.1) elem_field(ne_radius_in,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) @@ -1159,7 +1211,33 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling for this element - elem_field(ne_radius_in,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) + if(ne.eq.29)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.44)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.50)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.66)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + else + elem_field(ne_radius_in,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) + endif else !Pruning elem_field(ne_radius_in,ne) = R0 endif @@ -1174,7 +1252,33 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& elem_field(ne_radius_out,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling - elem_field(ne_radius_out,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) + if(ne.eq.29)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.44)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.50)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.66)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + else + elem_field(ne_radius_out,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) + endif else !Pruning elem_field(ne_radius_out,ne) = R0 endif @@ -1215,7 +1319,33 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& alt_hyp*alt_fib*elasticity_parameters(1)+1.d0) endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + if(ne.eq.29)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.44)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.50)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.66)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + else + elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + endif else elem_field(ne_radius_in,ne)=R0 endif @@ -1233,7 +1363,33 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + if(ne.eq.29)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.44)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.50)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.66)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + else + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + endif else elem_field(ne_radius_out,ne)=R0 endif From 2e6ff1790fe35488c24bfdea9e049012c11975cd Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Sun, 19 Nov 2023 00:24:55 +1300 Subject: [PATCH 03/13] hard coded for a subject --- src/lib/pressure_resistance_flow.f90 | 120 +++++++++++++++++---------- 1 file changed, 78 insertions(+), 42 deletions(-) diff --git a/src/lib/pressure_resistance_flow.f90 b/src/lib/pressure_resistance_flow.f90 index 0347b7aa..0e49bfa4 100644 --- a/src/lib/pressure_resistance_flow.f90 +++ b/src/lib/pressure_resistance_flow.f90 @@ -977,30 +977,36 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(vessel_type.eq.'elastic_alpha')then if(Ptm.LT.elasticity_parameters(2))then - if(ne.eq.29)then + if(ne.eq.43)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.44)then + elseif(ne.eq.45)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.50)then + elseif(ne.eq.51)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then + elseif(ne.eq.61)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then + elseif(ne.eq.63)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then + elseif(ne.eq.64)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) elseif(ne.eq.66)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) @@ -1010,30 +1016,36 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 else !ptm>ptmmax - if(ne.eq.29)then + if(ne.eq.43)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.44)then + elseif(ne.eq.45)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.50)then + elseif(ne.eq.51)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then + elseif(ne.eq.53)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then + elseif(ne.eq.54)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then + elseif(ne.eq.61)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then + elseif(ne.eq.63)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.64)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) elseif(ne.eq.66)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else if(nn.eq.1)then elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) @@ -1211,30 +1223,36 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling for this element - if(ne.eq.29)then + if(ne.eq.43)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.44)then + elseif(ne.eq.45)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.50)then + elseif(ne.eq.51)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then + elseif(ne.eq.53)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then + elseif(ne.eq.54)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then + elseif(ne.eq.61)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then + elseif(ne.eq.63)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.64)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) elseif(ne.eq.66)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_in,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) endif @@ -1252,30 +1270,36 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& elem_field(ne_radius_out,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling - if(ne.eq.29)then + if(ne.eq.43)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.44)then + elseif(ne.eq.45)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.50)then + elseif(ne.eq.51)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then + elseif(ne.eq.53)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.54)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then + elseif(ne.eq.61)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then + elseif(ne.eq.63)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then + elseif(ne.eq.64)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) elseif(ne.eq.66)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_out,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) endif @@ -1319,30 +1343,36 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& alt_hyp*alt_fib*elasticity_parameters(1)+1.d0) endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - if(ne.eq.29)then + if(ne.eq.43)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.44)then + elseif(ne.eq.45)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.50)then + elseif(ne.eq.51)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then + elseif(ne.eq.53)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then + elseif(ne.eq.54)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then + elseif(ne.eq.61)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then + elseif(ne.eq.63)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.64)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) elseif(ne.eq.66)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) endif @@ -1363,30 +1393,36 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - if(ne.eq.29)then + if(ne.eq.43)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.44)then + elseif(ne.eq.45)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.50)then + elseif(ne.eq.51)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then + elseif(ne.eq.53)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then + elseif(ne.eq.54)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then + elseif(ne.eq.61)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then + elseif(ne.eq.63)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.64)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) elseif(ne.eq.66)then if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) endif From 0cc616730f939056bf294cd2e5642e3b8e0b9b06 Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Fri, 8 Dec 2023 16:09:07 +1300 Subject: [PATCH 04/13] subject specific hard-coded --- src/lib/pressure_resistance_flow.f90 | 348 +++++++++++++-------------- 1 file changed, 174 insertions(+), 174 deletions(-) diff --git a/src/lib/pressure_resistance_flow.f90 b/src/lib/pressure_resistance_flow.f90 index 0e49bfa4..090bc524 100644 --- a/src/lib/pressure_resistance_flow.f90 +++ b/src/lib/pressure_resistance_flow.f90 @@ -978,35 +978,35 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& elseif(vessel_type.eq.'elastic_alpha')then if(Ptm.LT.elasticity_parameters(2))then if(ne.eq.43)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.45)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.61)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.63)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.64)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.66)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.45)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.51)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.53)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.54)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.61)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.63)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.64)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.66)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.67)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) @@ -1017,35 +1017,35 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 else !ptm>ptmmax if(ne.eq.43)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.45)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.61)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.63)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.64)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.66)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.45)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.51)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.53)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.54)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.61)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.63)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.64)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.66)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.67)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else if(nn.eq.1)then elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) @@ -1224,35 +1224,35 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling for this element if(ne.eq.43)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.45)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.61)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.63)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.64)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.66)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.45)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.51)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.53)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.54)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.61)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.63)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.64)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.66)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.67)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_in,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) endif @@ -1271,35 +1271,35 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling if(ne.eq.43)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.45)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.61)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.63)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.64)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.66)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.45)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.51)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.53)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.54)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.61)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.63)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.64)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.66)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.67)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_out,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) endif @@ -1344,35 +1344,35 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling if(ne.eq.43)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.45)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.61)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.63)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.64)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.66)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.45)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.51)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.53)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.54)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.61)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.63)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.64)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.66)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.67)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) endif @@ -1394,35 +1394,35 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling if(ne.eq.43)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.45)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.53)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.54)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.61)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.63)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.64)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.66)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.45)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.51)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.53)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.54)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.61)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.63)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.64)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.66)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.67)then + ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) else elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) endif From e40a59bd881d7bbe0b1f80a0e0bc89feebc05d5a Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Fri, 15 Dec 2023 12:29:39 +1300 Subject: [PATCH 05/13] subroutine to make vessels rigid initial commit --- src/bindings/c/pressure_resistance_flow.c | 7 + src/bindings/c/pressure_resistance_flow.f90 | 20 +++ src/bindings/c/pressure_resistance_flow.h | 2 +- src/lib/geometry.f90 | 4 +- src/lib/pressure_resistance_flow.f90 | 168 +++++++++++--------- 5 files changed, 124 insertions(+), 77 deletions(-) diff --git a/src/bindings/c/pressure_resistance_flow.c b/src/bindings/c/pressure_resistance_flow.c index 2a287b20..248d13fa 100644 --- a/src/bindings/c/pressure_resistance_flow.c +++ b/src/bindings/c/pressure_resistance_flow.c @@ -1,8 +1,15 @@ #include "pressure_resistance_flow.h" #include +extern void compliance_list_c(int *elemlist_len, int elemlist[]); + void evaluate_prq_c(const char *mesh_type, int *mesh_type_len, const char *vessel_type, int *vessel_type_len,int *grav_dirn, double *grav_factor, const char *bc_type, int *bc_type_len, double *inlet_bc, double *outlet_bc, double *remodeling_grade); +void compliance_list(int elemlist_len, int elemlist[]) +{ + compliance_list_c(&elemlist_len, elemlist); +} + void evaluate_prq(const char *mesh_type, const char *vessel_type,int grav_dirn, double grav_factor, const char *bc_type, double inlet_bc, double outlet_bc, double remodeling_grade) { int mesh_type_len = strlen(mesh_type); diff --git a/src/bindings/c/pressure_resistance_flow.f90 b/src/bindings/c/pressure_resistance_flow.f90 index 91e0e1b9..7b997826 100644 --- a/src/bindings/c/pressure_resistance_flow.f90 +++ b/src/bindings/c/pressure_resistance_flow.f90 @@ -4,6 +4,26 @@ module pressure_resistance_flow_c contains + ! + !################################################################################### + ! + ! makes the vessels given rigid. + subroutine compliance_list_c(surface_elems_len, surface_elems) bind(C, name="compliance_list_c") + + !use arrays,only: dp + !use iso_c_binding, only: c_ptr + !use utils_c, only: strncpy + !use other_consts, only: MAX_FILENAME_LEN + use pressure_resistance_flow,only: compliance_list + implicit none + + integer,intent(in) :: surface_elems_len + integer,intent(in) :: surface_elems(surface_elems_len) + + call compliance_list(surface_elems) + + end subroutine compliance_list_c + !!!################################################################################### subroutine evaluate_prq_c(mesh_type,mesh_type_len,vessel_type,vessel_type_len,grav_dirn,grav_factor,bc_type,bc_type_len,inlet_bc, & diff --git a/src/bindings/c/pressure_resistance_flow.h b/src/bindings/c/pressure_resistance_flow.h index 729750d0..57c66a03 100644 --- a/src/bindings/c/pressure_resistance_flow.h +++ b/src/bindings/c/pressure_resistance_flow.h @@ -3,7 +3,7 @@ #include "symbol_export.h" - +SHO_PUBLIC void compliance_list(int elemlist_len, int elemlist[]); SHO_PUBLIC void evaluate_prq(const char *mesh_type, const char *vessel_type, int grav_dirn, double grav_factor, const char *bc_type, double inlet_bc, double outlet_bc, double remodeling_grade); diff --git a/src/lib/geometry.f90 b/src/lib/geometry.f90 index f398f712..41d2e161 100644 --- a/src/lib/geometry.f90 +++ b/src/lib/geometry.f90 @@ -2762,13 +2762,13 @@ subroutine occlude_vessel(VESSEL_NUMBER, RATIO) sub_name = 'occlude_vessel' call enter_exit(sub_name,1) - write(*,*) "before:", elem_field(ne_radius_in, VESSEL_NUMBER) + ! write(*,*) "before:", elem_field(ne_radius_in, VESSEL_NUMBER) ! write(*,*) "ne_radius_in:", elem_field(ne_radius_in,21) elem_field(ne_radius, VESSEL_NUMBER) = RATIO * elem_field(ne_radius, VESSEL_NUMBER) elem_field(ne_radius_in, VESSEL_NUMBER) = RATIO * elem_field(ne_radius_in, VESSEL_NUMBER) elem_field(ne_radius_out, VESSEL_NUMBER) = RATIO * elem_field(ne_radius_out, VESSEL_NUMBER) - write(*,*) "after:", elem_field(ne_radius_in, VESSEL_NUMBER) + ! write(*,*) "after:", elem_field(ne_radius_in, VESSEL_NUMBER) ! pause call enter_exit(sub_name,2) diff --git a/src/lib/pressure_resistance_flow.f90 b/src/lib/pressure_resistance_flow.f90 index 090bc524..2e1c1b58 100644 --- a/src/lib/pressure_resistance_flow.f90 +++ b/src/lib/pressure_resistance_flow.f90 @@ -26,7 +26,7 @@ module pressure_resistance_flow !Interfaces private - public evaluate_prq,calculate_ppl + public evaluate_prq,calculate_ppl, compliance_list contains !################################################################################### ! @@ -450,6 +450,26 @@ subroutine boundary_conditions(ADD,FIX,bc_type,grav_vect,density,inletbc,outletb endif call enter_exit(sub_name,2) end subroutine boundary_conditions + +! +!################################################################################### +! + !* compliance_list gets an element list from user which includes the element that were + ! occluded for CTEPH the compliance of these vessels is reduced to zero - basically make these + ! vessels rigid + subroutine compliance_list(elem_list) + + integer,intent(in) :: elem_list(:) ! list of surface elements defining the host region + !local variables + integer :: i + character(len=60) :: sub_name + + sub_name = 'compliance_list' + call enter_exit(sub_name,1) + + + call enter_exit(sub_name,2) + end subroutine compliance_list ! !################################################################################### ! @@ -977,19 +997,19 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(vessel_type.eq.'elastic_alpha')then if(Ptm.LT.elasticity_parameters(2))then - if(ne.eq.43)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.45)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.51)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.53)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.54)then + if(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.68)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! elseif(ne.eq.68)then ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! elseif(ne.eq.61)then @@ -1016,18 +1036,18 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 else !ptm>ptmmax - if(ne.eq.43)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.45)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.51)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.53)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.68)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! elseif(ne.eq.54)then ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) @@ -1223,18 +1243,18 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling for this element - if(ne.eq.43)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.45)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.51)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.53)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.68)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! elseif(ne.eq.54)then ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) @@ -1270,18 +1290,18 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& elem_field(ne_radius_out,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) endif elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling - if(ne.eq.43)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.45)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.51)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.53)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.68)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! elseif(ne.eq.54)then ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) @@ -1343,18 +1363,18 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& alt_hyp*alt_fib*elasticity_parameters(1)+1.d0) endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - if(ne.eq.43)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.45)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.51)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.53)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.68)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! elseif(ne.eq.54)then ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) @@ -1393,18 +1413,18 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - if(ne.eq.43)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.45)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.51)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.53)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(ne.eq.51)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.52)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.67)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + elseif(ne.eq.68)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! elseif(ne.eq.54)then ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) From 4fdb00c52832629dd5e481c2e1378970b2f32a45 Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Thu, 21 Dec 2023 18:22:02 +1300 Subject: [PATCH 06/13] compliance and occlusion list with partial occlusions --- src/bindings/c/pressure_resistance_flow.c | 12 +- src/bindings/c/pressure_resistance_flow.f90 | 21 + src/bindings/c/pressure_resistance_flow.h | 3 +- .../interface/pressure_resistance_flow.i | 49 +- src/lib/pressure_resistance_flow.f90 | 768 +++++++++--------- 5 files changed, 442 insertions(+), 411 deletions(-) diff --git a/src/bindings/c/pressure_resistance_flow.c b/src/bindings/c/pressure_resistance_flow.c index 248d13fa..f44af941 100644 --- a/src/bindings/c/pressure_resistance_flow.c +++ b/src/bindings/c/pressure_resistance_flow.c @@ -1,13 +1,19 @@ #include "pressure_resistance_flow.h" #include -extern void compliance_list_c(int *elemlist_len, int elemlist[]); +extern void compliance_list_c(int *elemlist2_len, int elemlist2[]); +extern void occlusion_list_c(int *elemlist_len, int elemlist[]); void evaluate_prq_c(const char *mesh_type, int *mesh_type_len, const char *vessel_type, int *vessel_type_len,int *grav_dirn, double *grav_factor, const char *bc_type, int *bc_type_len, double *inlet_bc, double *outlet_bc, double *remodeling_grade); -void compliance_list(int elemlist_len, int elemlist[]) +void compliance_list(int elemlist2_len, int elemlist2[]) { - compliance_list_c(&elemlist_len, elemlist); + compliance_list_c(&elemlist2_len, elemlist2); +} + +void occlusion_list(int elemlist_len, int elemlist[]) +{ + occlusion_list_c(&elemlist_len, elemlist); } void evaluate_prq(const char *mesh_type, const char *vessel_type,int grav_dirn, double grav_factor, const char *bc_type, double inlet_bc, double outlet_bc, double remodeling_grade) diff --git a/src/bindings/c/pressure_resistance_flow.f90 b/src/bindings/c/pressure_resistance_flow.f90 index 7b997826..f9c5a920 100644 --- a/src/bindings/c/pressure_resistance_flow.f90 +++ b/src/bindings/c/pressure_resistance_flow.f90 @@ -4,6 +4,27 @@ module pressure_resistance_flow_c contains + + + ! + !################################################################################### + ! + ! the main growing subroutine. Generates a volume-filling tree into a closed surface. + subroutine occlusion_list_c(surface_elems_len, surface_elems) bind(C, name="occlusion_list_c") + + !use arrays,only: dp + !use iso_c_binding, only: c_ptr + !use utils_c, only: strncpy + !use other_consts, only: MAX_FILENAME_LEN + use pressure_resistance_flow,only: occlusion_list + implicit none + + integer,intent(in) :: surface_elems_len + integer,intent(in) :: surface_elems(surface_elems_len) + + call occlusion_list(surface_elems) + + end subroutine occlusion_list_c ! !################################################################################### ! diff --git a/src/bindings/c/pressure_resistance_flow.h b/src/bindings/c/pressure_resistance_flow.h index 57c66a03..2e9864ca 100644 --- a/src/bindings/c/pressure_resistance_flow.h +++ b/src/bindings/c/pressure_resistance_flow.h @@ -3,7 +3,8 @@ #include "symbol_export.h" -SHO_PUBLIC void compliance_list(int elemlist_len, int elemlist[]); +SHO_PUBLIC void occlusion_list(int elemlist_len, int elemlist[]); +SHO_PUBLIC void compliance_list(int elemlist2_len, int elemlist2[]); SHO_PUBLIC void evaluate_prq(const char *mesh_type, const char *vessel_type, int grav_dirn, double grav_factor, const char *bc_type, double inlet_bc, double outlet_bc, double remodeling_grade); diff --git a/src/bindings/interface/pressure_resistance_flow.i b/src/bindings/interface/pressure_resistance_flow.i index faa2dbf4..88736c88 100644 --- a/src/bindings/interface/pressure_resistance_flow.i +++ b/src/bindings/interface/pressure_resistance_flow.i @@ -1,8 +1,55 @@ %module(package="aether") pressure_resistance_flow %include symbol_export.h -%include pressure_resistance_flow.h + +%typemap(in) (int elemlist_len, int elemlist[]) { +int i; +if (!PyList_Check($input)) { + PyErr_SetString(PyExc_ValueError, "Expecting a list"); + SWIG_fail; +} +$1 = PyList_Size($input); +$2 = (int *) malloc(($1)*sizeof(int)); +for (i = 0; i < $1; i++) { + PyObject *o = PyList_GetItem($input, i); + if (!PyInt_Check(o)) { + free($2); + PyErr_SetString(PyExc_ValueError, "List items must be integers"); + SWIG_fail; + } + $2[i] = PyInt_AsLong(o); +} +} + +%typemap(in) (int elemlist2_len, int elemlist2[]) { +int i; +if (!PyList_Check($input)) { + PyErr_SetString(PyExc_ValueError, "Expecting a list"); + SWIG_fail; +} +$1 = PyList_Size($input); +$2 = (int *) malloc(($1)*sizeof(int)); +for (i = 0; i < $1; i++) { + PyObject *o = PyList_GetItem($input, i); + if (!PyInt_Check(o)) { + free($2); + PyErr_SetString(PyExc_ValueError, "List items must be integers"); + SWIG_fail; + } + $2[i] = PyInt_AsLong(o); +} +} + +%typemap(freearg) (int elemlist_len, int elemlist[]) { +if ($2) free($2); +} + +%typemap(freearg) (int elemlist2_len, int elemlist2[]) { +if ($2) free($2); +} %{ #include "pressure_resistance_flow.h" %} + +%include pressure_resistance_flow.h diff --git a/src/lib/pressure_resistance_flow.f90 b/src/lib/pressure_resistance_flow.f90 index 2e1c1b58..93e4c44e 100644 --- a/src/lib/pressure_resistance_flow.f90 +++ b/src/lib/pressure_resistance_flow.f90 @@ -17,6 +17,7 @@ module pressure_resistance_flow use solve, only: BICGSTAB_LinSolv,pmgmres_ilu_cr implicit none + integer,allocatable :: occ_list(:),compl_list(:) !Module parameters @@ -26,7 +27,7 @@ module pressure_resistance_flow !Interfaces private - public evaluate_prq,calculate_ppl, compliance_list + public evaluate_prq,calculate_ppl,occlusion_list,compliance_list contains !################################################################################### ! @@ -453,13 +454,44 @@ end subroutine boundary_conditions ! !################################################################################### +! + !* occlusion_list gets an element list from user which includes the element that were + ! occluded for CTEPH and now the occlusions are removed and we want to make sure there + ! is no remodelling downstream of those elements + subroutine occlusion_list(elem_list) + + integer,intent(in) :: elem_list(:) ! list of surface elements defining the host region + !local variables + integer :: i + character(len=60) :: sub_name + + sub_name = 'occlusion_list' + call enter_exit(sub_name,1) + + if(count(elem_list.ne.0).gt.0)then ! a surface element list is given for converting to + ! create a list of occluded elements + allocate(occ_list(count(elem_list.ne.0))) + !!! get the list of occlusion list from the given list + do i = 1,count(elem_list.ne.0) + occ_list(i) = elem_list(i) + enddo + endif + ! + ! write(*,*) 'occlusion_list:', occ_list + ! pause + + + call enter_exit(sub_name,2) + end subroutine occlusion_list +! +!################################################################################### ! !* compliance_list gets an element list from user which includes the element that were ! occluded for CTEPH the compliance of these vessels is reduced to zero - basically make these ! vessels rigid - subroutine compliance_list(elem_list) + subroutine compliance_list(elem_list2) - integer,intent(in) :: elem_list(:) ! list of surface elements defining the host region + integer,intent(in) :: elem_list2(:) ! list of surface elements defining the host region !local variables integer :: i character(len=60) :: sub_name @@ -467,6 +499,14 @@ subroutine compliance_list(elem_list) sub_name = 'compliance_list' call enter_exit(sub_name,1) + if(count(elem_list2.ne.0).gt.0)then ! a surface element list is given for converting to + ! create a list of occluded elements + allocate(compl_list(count(elem_list2.ne.0))) + !!! get the list of occlusion list from the given list + do i = 1,count(elem_list2.ne.0) + compl_list(i) = elem_list2(i) + enddo + endif call enter_exit(sub_name,2) end subroutine compliance_list @@ -951,10 +991,11 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& real(dp),intent(in) :: elasticity_parameters(3),mechanics_parameters(2) !local variables - integer :: nj,np,ne,ny,nn + integer :: nj,np,ne,ny,nn,k,no_compl_ne real(dp) :: h,Ptm,R0,Pblood,Ppl,counter,cc1,cc2,cc3 real(dp) :: alt_hyp,alt_fib,prox_fib,narrow_rad_one,narrow_rad_two,narrow_factor,prune_rad,prune_fraction,counter1,counter2 integer,allocatable :: templss(:) + logical:: check, FOUND character(len=60) :: sub_name sub_name = 'calc_press_area' @@ -977,109 +1018,45 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& Ptm=Pblood+Ppl ! Pa if(nn.eq.1)R0=elem_field(ne_radius_in0,ne) if(nn.eq.2)R0=elem_field(ne_radius_out0,ne) - if(vessel_type.eq.'elastic_g0_beta')then - if(Ptm.lt.elasticity_parameters(3).and.elasticity_parameters(1).gt.0.0_dp)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) - elseif(Ptm.lt.0.0_dp.or.elasticity_parameters(1).LT.TOLERANCE)then - if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - else !ptm>ptmmax - if(nn.eq.1)then - elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & - **(1.d0/elasticity_parameters(2)) - endif - if(nn.eq.2)then - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & - **(1.d0/elasticity_parameters(2)) + if(vessel_type.eq.'elastic_g0_beta')then + if(Ptm.lt.elasticity_parameters(3).and.elasticity_parameters(1).gt.0.0_dp)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) + elseif(Ptm.lt.0.0_dp.or.elasticity_parameters(1).LT.TOLERANCE)then + if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 + else !ptm>ptmmax + if(nn.eq.1)then + elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & + **(1.d0/elasticity_parameters(2)) + endif + if(nn.eq.2)then + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & + **(1.d0/elasticity_parameters(2)) + endif endif - endif - elseif(vessel_type.eq.'elastic_alpha')then + elseif(vessel_type.eq.'elastic_alpha')then if(Ptm.LT.elasticity_parameters(2))then - if(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.68)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.68)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.61)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.63)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.64)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.66)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.67)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - else - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - endif - elseif(Ptm.lt.0.0_dp)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + elseif(Ptm.lt.0.0_dp)then if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - else !ptm>ptmmax - if(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.68)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.54)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.61)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.63)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.64)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.66)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.67)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - else + else !ptm>ptmmax if(nn.eq.1)then elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) endif if(nn.eq.2)then - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) endif - endif endif - elseif(vessel_type.eq.'elastic_hooke')then - h=elasticity_parameters(2)*R0 - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) - else + elseif(vessel_type.eq.'elastic_hooke')then + h=elasticity_parameters(2)*R0 + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) + else print *, 'no vessel type defined, assuming rigid' if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 @@ -1140,22 +1117,34 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& if(nn.eq.1) R0=elem_field(ne_radius_in0,ne) if(nn.eq.2) R0=elem_field(ne_radius_out0,ne) if(elem_field(ne_group,ne).eq.0.0_dp) then !only applying on arteries - if(nn.eq.1) then - if(R0.lt.prune_rad.and.elem_ordrs(no_sord,ne).eq.1) then - if(counter1/100.le.prune_fraction) then ! pruning the right percentage based on the fraction defined - cc1 = cc1+1.0_dp - R0=0.005_dp ! Setting the radius to a small value - else ! the remaining of the canditates that are not pruned because of the fraction - R0=elem_field(ne_radius_in0,ne) + FOUND = .False. + if (allocated(occ_list))then + do k=1,count(occ_list.ne.0) + check = is_downstream(ne,occ_list(k)) + if(check)then + FOUND = .True. + ! write(*,*) ne,occ_list + ! pause endif - counter1 = counter1 + 1.0_dp ! since a canditate was found, one is added to the counter1 - if(counter1.ge.101.0_dp) counter1=1.0_dp ! now that the fraction out of hundred was blocked set the counter back to start - else ! R0 greater than prune_rad - cc3=cc3+1.0_dp - R0=elem_field(ne_radius_in0,ne) ! treating the artery as normal unstrained radius (no constraints) - endif + end do endif - if(nn.eq.2) then ! same thing as nn=1 + if(.NOT.FOUND)then ! FOUND + if(nn.eq.1) then ! nn.eq.1 + if(R0.lt.prune_rad.and.elem_ordrs(no_sord,ne).eq.1) then + if(counter1/100.le.prune_fraction) then ! pruning the right percentage based on the fraction defined + cc1 = cc1+1.0_dp + R0=0.005_dp ! Setting the radius to a small value + else ! the remaining of the canditates that are not pruned because of the fraction + R0=elem_field(ne_radius_in0,ne) + endif + counter1 = counter1 + 1.0_dp ! since a canditate was found, one is added to the counter1 + if(counter1.ge.101.0_dp) counter1=1.0_dp ! now that the fraction out of hundred was blocked set the counter back to start + else ! R0 greater than prune_rad + cc3=cc3+1.0_dp + R0=elem_field(ne_radius_in0,ne) ! treating the artery as normal unstrained radius (no constraints) + endif + endif ! nn.eq.1 + if(nn.eq.2) then ! same thing as nn=1 if(R0.lt.prune_rad.and.elem_ordrs(no_sord,ne).eq.1) then if(counter2/100.le.prune_fraction) then cc2=cc2+1.0_dp @@ -1168,311 +1157,248 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else R0=elem_field(ne_radius_out0,ne) endif - endif - endif - if(vessel_type.eq.'elastic_g0_beta') then - if(elem_field(ne_group,ne).eq.0.0_dp) then !only applying on arteries - if(Ptm.LT.elasticity_parameters(3).and.elasticity_parameters(1).gt.0.0_dp)then - if(nn.eq.1) then - if((R0.gt.0.015).and.(R0.lt.0.15)) then - elem_field(ne_radius_in,ne)=0.55_dp*R0*((Ptm/(0.16_dp*elasticity_parameters(1)))+1.d0) & - **(1.d0/elasticity_parameters(2)) - else - elem_field(ne_radius_in,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) - endif - endif - if(nn.eq.2) then - if((R0.gt.0.015).and.(R0.lt.0.15)) then - elem_field(ne_radius_out,ne)=0.55_dp*R0*((Ptm/(0.16_dp*elasticity_parameters(1)))+1.d0) & - **(1.d0/elasticity_parameters(2)) - else - elem_field(ne_radius_out,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) - endif - endif - elseif(Ptm.lt.0.0_dp.or.elasticity_parameters(1).LT.TOLERANCE)then - if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - else !ptm>ptmmax - if(nn.eq.1) then - if((R0.gt.0.015).and.(R0.lt.0.15)) then - elem_field(ne_radius_in,ne)=0.55_dp*R0*((elasticity_parameters(3)/(0.16_dp*elasticity_parameters(1)))+1.d0) & - **(1.d0/elasticity_parameters(2)) - else - elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & - **(1.d0/elasticity_parameters(2)) - endif - endif - if(nn.eq.2) then - if((R0.gt.0.015).and.(R0.lt.0.15)) then - elem_field(ne_radius_out,ne)=0.55_dp*R0*((elasticity_parameters(3)/(0.16_dp*elasticity_parameters(1)))+1.d0) & - **(1.d0/elasticity_parameters(2)) - else - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & - **(1.d0/elasticity_parameters(2)) - endif - endif - endif - else !other than arteries - if(Ptm.LT.elasticity_parameters(3).and.elasticity_parameters(1).gt.0.0_dp)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) - elseif(Ptm.lt.0.0_dp.or.elasticity_parameters(1).LT.TOLERANCE)then - if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - else !ptm>ptmmax - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & - **(1.d0/elasticity_parameters(2)) - if(nn.eq.2)then - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & - **(1.d0/elasticity_parameters(2)) - endif - endif - endif - elseif(vessel_type.eq.'elastic_alpha') then - if(elem_field(ne_group,ne).eq.0.0_dp) then !only applying on arteries - if(Ptm.lt.elasticity_parameters(2))then - if(nn.eq.1) then - if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertorphy+narrow factor effect - if(R0.lt.0.05_dp) then ! only Narrow_factor - elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*elasticity_parameters(1))+1.d0) - elseif(R0.gt.narrow_rad_two) then ! only Hypertophy - elem_field(ne_radius_in,ne) = R0*((Ptm*alt_hyp*elasticity_parameters(1))+1.d0) - else ! Both hypertophy and narrowing - elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) + endif ! same thing as nn=1 + else ! treat as healthy + if(nn.eq.1) R0=elem_field(ne_radius_in0,ne) + if(nn.eq.2) R0=elem_field(ne_radius_out0,ne) + endif ! FOUND + if(vessel_type.eq.'elastic_g0_beta') then ! elastic_g0_beta + if(elem_field(ne_group,ne).eq.0.0_dp) then !only applying on arteries + if(Ptm.LT.elasticity_parameters(3).and.elasticity_parameters(1).gt.0.0_dp)then + if(nn.eq.1) then + if((R0.gt.0.015).and.(R0.lt.0.15)) then + elem_field(ne_radius_in,ne)=0.55_dp*R0*((Ptm/(0.16_dp*elasticity_parameters(1)))+1.d0) & + **(1.d0/elasticity_parameters(2)) + else + elem_field(ne_radius_in,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) + endif endif - elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling for this element - if(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.68)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.54)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.61)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.63)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.64)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.66)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.67)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - else - elem_field(ne_radius_in,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) + if(nn.eq.2) then + if((R0.gt.0.015).and.(R0.lt.0.15)) then + elem_field(ne_radius_out,ne)=0.55_dp*R0*((Ptm/(0.16_dp*elasticity_parameters(1)))+1.d0) & + **(1.d0/elasticity_parameters(2)) + else + elem_field(ne_radius_out,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) + endif endif - else !Pruning - elem_field(ne_radius_in,ne) = R0 - endif - endif - if(nn.eq.2) then - if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertorphy+narrow factor effect - if(R0.lt.0.05_dp) then ! only Narrow_factor - elem_field(ne_radius_out,ne) = narrow_factor*R0*((Ptm*elasticity_parameters(1))+1.d0) - elseif(R0.gt.narrow_rad_two) then ! hypertophy only - elem_field(ne_radius_out,ne) = R0*((Ptm*alt_hyp*elasticity_parameters(1))+1.d0) - else ! Both hypertophy and narrowing - elem_field(ne_radius_out,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) - endif - elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling - if(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.68)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.54)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.61)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.63)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.64)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.66)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.67)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - else - elem_field(ne_radius_out,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) - endif - else !Pruning - elem_field(ne_radius_out,ne) = R0 - endif - endif - elseif(Ptm.lt.0.0_dp)then !Ptm - if(Ptm.lt.0) write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl - if(nn.eq.1) then - if((R0.gt.narrow_rad_one).and.(R0.lt.0.5)) then ! Hypertophy+narrowing effect - if(R0.lt.narrow_rad_two) then !only narrowing - elem_field(ne_radius_in,ne)=narrow_factor*R0 - else - elem_field(ne_radius_in,ne)=R0 + elseif(Ptm.lt.0.0_dp.or.elasticity_parameters(1).LT.TOLERANCE)then + if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 + else !ptm>ptmmax + if(nn.eq.1) then + if((R0.gt.0.015).and.(R0.lt.0.15)) then + elem_field(ne_radius_in,ne)=0.55_dp*R0*((elasticity_parameters(3)/(0.16_dp*elasticity_parameters(1)))+1.d0) & + **(1.d0/elasticity_parameters(2)) + else + elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & + **(1.d0/elasticity_parameters(2)) + endif endif - else ! Not within the target range, hence, no remodeling - elem_field(ne_radius_in,ne)=R0 - endif - endif - if(nn.eq.2) then - if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then - if(R0.lt.narrow_rad_two) then - elem_field(ne_radius_out,ne)=narrow_factor*R0 - else - elem_field(ne_radius_out,ne)=R0 + if(nn.eq.2) then + if((R0.gt.0.015).and.(R0.lt.0.15)) then + elem_field(ne_radius_out,ne)=0.55_dp*R0*((elasticity_parameters(3)/(0.16_dp*elasticity_parameters(1)))+1.d0) & + **(1.d0/elasticity_parameters(2)) + else + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & + **(1.d0/elasticity_parameters(2)) + endif endif - else ! Not within the target range, hence, no remodeling - elem_field(ne_radius_out,ne)=R0 endif - endif - else !ptm>ptmmax - if(nn.eq.1) then - if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertophy+narrowing effect - if(R0.lt.0.05_dp) then ! only Narrow_factor - elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) - elseif(R0.gt.narrow_rad_two) then ! hypertophy only - elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*alt_hyp*elasticity_parameters(1))+1.d0) - else ! Both hypertophy and narrowing - elem_field(ne_radius_in,ne)=narrow_factor*R0*(elasticity_parameters(2)* & - alt_hyp*alt_fib*elasticity_parameters(1)+1.d0) - endif - elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - if(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.68)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.54)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.61)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.63)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.64)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.66)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.67)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - else - elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + else !other than arteries + if(Ptm.LT.elasticity_parameters(3).and.elasticity_parameters(1).gt.0.0_dp)then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm/elasticity_parameters(1))+1.d0)**(1.d0/elasticity_parameters(2)) + elseif(Ptm.lt.0.0_dp.or.elasticity_parameters(1).LT.TOLERANCE)then + if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 + else !ptm>ptmmax + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & + **(1.d0/elasticity_parameters(2)) + if(nn.eq.2)then + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(3)/elasticity_parameters(1))+1.d0) & + **(1.d0/elasticity_parameters(2)) endif - else - elem_field(ne_radius_in,ne)=R0 endif - endif - if(nn.eq.2) then - if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertrophy+narrowing effect - if(R0.lt.0.05_dp) then ! only Narrow_factor - elem_field(ne_radius_out,ne)=narrow_factor*R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) - elseif(R0.gt.narrow_rad_two) then ! hypertophy only - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*alt_hyp*elasticity_parameters(1))+1.d0) - else ! Both hypertophy and narrowing - - elem_field(ne_radius_out,ne)=narrow_factor*R0*((elasticity_parameters(2)* & - alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) - - endif - elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling - if(ne.eq.51)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.52)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.67)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - elseif(ne.eq.68)then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.54)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.61)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.63)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.64)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.66)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! elseif(ne.eq.67)then - ! if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - else - elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + endif !artery or vein + elseif(vessel_type.eq.'elastic_alpha') then ! elastic alpha + if(elem_field(ne_group,ne).eq.0.0_dp) then !only applying on arteries + FOUND = .False. + if (allocated(occ_list))then ! occ allocated + do k=1,count(occ_list.ne.0) + check = is_downstream(ne,occ_list(k)) + if(check)then + FOUND = .True. + endif + end do + endif ! occ allocated + if(.NOT.FOUND)then !FOUND + if(Ptm.lt.elasticity_parameters(2))then + if(nn.eq.1) then ! nn.eq.1 + if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertorphy+narrow factor effect + if(R0.lt.0.05_dp) then ! only Narrow_factor + elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*elasticity_parameters(1))+1.d0) + elseif(R0.gt.narrow_rad_two) then ! only Hypertophy + elem_field(ne_radius_in,ne) = R0*((Ptm*alt_hyp*elasticity_parameters(1))+1.d0) + else ! Both hypertophy and narrowing + elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) + endif + elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling for this element + elem_field(ne_radius_in,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) + else !Pruning + elem_field(ne_radius_in,ne) = R0 + endif + if (allocated(compl_list)) then ! compl allocated + do no_compl_ne=1,count(compl_list.ne.0) + !write(*,*) compl_list(no_compl_ne) + !pause + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + end do + endif ! compl allocated + endif ! nn.eq.1 + if(nn.eq.2) then ! nn.eq.2 + if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertorphy+narrow factor effect + if(R0.lt.0.05_dp) then ! only Narrow_factor + elem_field(ne_radius_out,ne) = narrow_factor*R0*((Ptm*elasticity_parameters(1))+1.d0) + elseif(R0.gt.narrow_rad_two) then ! hypertophy only + elem_field(ne_radius_out,ne) = R0*((Ptm*alt_hyp*elasticity_parameters(1))+1.d0) + else ! Both hypertophy and narrowing + elem_field(ne_radius_out,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) + endif + elseif(R0.gt.0.5_dp) then !Not within the range of our target radii, hence, no remodeling + elem_field(ne_radius_out,ne) = R0*((Ptm*elasticity_parameters(1))+1.d0) + else !Pruning + elem_field(ne_radius_out,ne) = R0 + endif + endif ! nn.eq.2 + if (allocated(compl_list)) then ! compl allocated + do no_compl_ne=1,count(compl_list.ne.0) + ! write(*,*) compl_list(no_compl_ne) + ! pause + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + end do + endif ! compl allocated + elseif(Ptm.lt.0.0_dp)then !Ptm + if(Ptm.lt.0) write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) then ! nn.eq.1 + if((R0.gt.narrow_rad_one).and.(R0.lt.0.5)) then ! Hypertophy+narrowing effect + if(R0.lt.narrow_rad_two) then !only narrowing + elem_field(ne_radius_in,ne)=narrow_factor*R0 + else + elem_field(ne_radius_in,ne)=R0 + endif + else ! Not within the target range, hence, no remodeling + elem_field(ne_radius_in,ne)=R0 + endif + endif ! nn.eq.1 + if(nn.eq.2) then ! nn.eq.2 + if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then + if(R0.lt.narrow_rad_two) then + elem_field(ne_radius_out,ne)=narrow_factor*R0 + else + elem_field(ne_radius_out,ne)=R0 + endif + else ! Not within the target range, hence, no remodeling + elem_field(ne_radius_out,ne)=R0 + endif + endif ! nn.eq.2 + else !ptm>ptmmax + if(nn.eq.1) then ! nn.eq.1 + if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertophy+narrowing effect + if(R0.lt.0.05_dp) then ! only Narrow_factor + elem_field(ne_radius_in,ne) = narrow_factor*R0*((Ptm*alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) + elseif(R0.gt.narrow_rad_two) then ! hypertophy only + elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*alt_hyp*elasticity_parameters(1))+1.d0) + else ! Both hypertophy and narrowing + elem_field(ne_radius_in,ne)=narrow_factor*R0*(elasticity_parameters(2)* & + alt_hyp*alt_fib*elasticity_parameters(1)+1.d0) + endif + elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling + elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + else + elem_field(ne_radius_in,ne)=R0 + endif + endif ! nn.eq.1 + if (allocated(compl_list)) then ! compl allocated + do no_compl_ne=1,count(compl_list.ne.0) + !write(*,*) compl_list(no_compl_ne) + !pause + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + end do + endif ! compl allocated + if(nn.eq.2) then ! nn.eq.2 + if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertrophy+narrowing effect + if(R0.lt.0.05_dp) then ! only Narrow_factor + elem_field(ne_radius_out,ne)=narrow_factor*R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + elseif(R0.gt.narrow_rad_two) then ! hypertophy only + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*alt_hyp*elasticity_parameters(1))+1.d0) + else ! Both hypertophy and narrowing + elem_field(ne_radius_out,ne)=narrow_factor*R0*((elasticity_parameters(2)* & + alt_hyp*alt_fib*elasticity_parameters(1))+1.d0) + endif + elseif(R0.gt.0.5_dp) then ! Not within the target range, hence, no remodeling + elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*(elasticity_parameters(1)))+1.d0) + else + elem_field(ne_radius_out,ne)=R0 + endif ! radius criteria + endif ! nn.eq.2 + if (allocated(compl_list)) then ! compl allocated + do no_compl_ne=1,count(compl_list.ne.0) + !write(*,*) compl_list(no_compl_ne) + !pause + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + end do + endif ! compl allocated + endif !ptm + else ! FOUND + if(Ptm.lt.elasticity_parameters(2))then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + elseif(Ptm.lt.0.0_dp)then !Ptm + if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 + else !ptm>ptmmax + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) endif - else - elem_field(ne_radius_out,ne)=R0 + endif ! FOUND + if (allocated(compl_list)) then ! compl allocated + do no_compl_ne=1,count(compl_list.ne.0) + ! write(*,*) compl_list(no_compl_ne) + ! pause + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + end do + endif ! compl allocated + else !other than arteries + if(Ptm.lt.elasticity_parameters(2))then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + elseif(Ptm.lt.0.0_dp)then !Ptm + if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 + else !ptm>ptmmax + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) endif - endif - endif - else !other than arteries - if(Ptm.lt.elasticity_parameters(2))then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - elseif(Ptm.lt.0.0_dp)then !Ptm - if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - else !ptm>ptmmax - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) - endif - endif - elseif(vessel_type.eq.'elastic_hooke')then - h=elasticity_parameters(2)*R0 - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) - else - print *, 'no vessel type defined, assuming rigid' - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - endif + endif !artery or vein + elseif(vessel_type.eq.'elastic_hooke')then + h=elasticity_parameters(2)*R0 + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) !vessel type + else + print *, 'no vessel type defined, assuming rigid' + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 !vessel type + endif !vessel type + endif ! if artery enddo!nn enddo!ne endif @@ -1507,6 +1433,36 @@ subroutine map_solution_to_mesh(prq_solution,depvar_at_elem,depvar_at_node,mesh_ call enter_exit(sub_name,2) end subroutine map_solution_to_mesh +!##############################################################################!############################################################################## +! +!*is_downstream* checks to see if a certain element is downstream of another element +!!!!!!! +! This function is useful for doing regional remodeling where you do not want to +! remodel vessels downstream of an occlusion (needed for post-PEA modelling) +!!!!!!! +recursive function is_downstream(ne,occ_ne) result(FOUND) + + integer, intent(in) :: ne,occ_ne + !local variables + logical :: FOUND + integer :: ne_temp,np + character(len=60) :: sub_name + + FOUND = .False. + np=elem_nodes(1,ne) + + if (ne == occ_ne) then + FOUND = .True. + else if (ne == 1) then + FOUND = .false. + else + ne_temp = elems_at_node(np,1) + FOUND = is_downstream(ne_temp, occ_ne) + end if + + call enter_exit(sub_name,2) +end function is_downstream + !############################################################################## ! !*map_flow_to_terminals* maps the solution array to appropriate nodal and element fields From f37638f414a8cd1348189fa5c2ecbc7b258b4f0a Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Mon, 8 Jan 2024 16:06:09 +1300 Subject: [PATCH 07/13] compliant vessel list fixed --- src/lib/pressure_resistance_flow.f90 | 73 ++++++++++++++++++---------- 1 file changed, 47 insertions(+), 26 deletions(-) diff --git a/src/lib/pressure_resistance_flow.f90 b/src/lib/pressure_resistance_flow.f90 index 93e4c44e..48e9ef25 100644 --- a/src/lib/pressure_resistance_flow.f90 +++ b/src/lib/pressure_resistance_flow.f90 @@ -1249,14 +1249,16 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else !Pruning elem_field(ne_radius_in,ne) = R0 endif - if (allocated(compl_list)) then ! compl allocated - do no_compl_ne=1,count(compl_list.ne.0) - !write(*,*) compl_list(no_compl_ne) - !pause - if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - end do - endif ! compl allocated + ! if (allocated(compl_list)) then ! compl allocated + ! do no_compl_ne=1,count(compl_list.ne.0) + ! !write(*,*) compl_list(no_compl_ne) + ! !pause + ! if(ne.eq.compl_list(no_compl_ne))then + ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! endif + ! end do + ! endif ! compl allocated endif ! nn.eq.1 if(nn.eq.2) then ! nn.eq.2 if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertorphy+narrow factor effect @@ -1272,13 +1274,22 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else !Pruning elem_field(ne_radius_out,ne) = R0 endif + ! if (allocated(compl_list)) then ! compl allocated + ! do no_compl_ne=1,count(compl_list.ne.0) + ! ! write(*,*) compl_list(no_compl_ne) + ! ! pause + ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! end do + ! endif ! compl allocated endif ! nn.eq.2 if (allocated(compl_list)) then ! compl allocated do no_compl_ne=1,count(compl_list.ne.0) - ! write(*,*) compl_list(no_compl_ne) - ! pause - if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + !pause + if(ne.eq.compl_list(no_compl_ne))then + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + endif end do endif ! compl allocated elseif(Ptm.lt.0.0_dp)then !Ptm @@ -1321,15 +1332,15 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else elem_field(ne_radius_in,ne)=R0 endif + ! if (allocated(compl_list)) then ! compl allocated + ! do no_compl_ne=1,count(compl_list.ne.0) + ! !write(*,*) compl_list(no_compl_ne) + ! !pause + ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! end do + ! endif ! compl allocated endif ! nn.eq.1 - if (allocated(compl_list)) then ! compl allocated - do no_compl_ne=1,count(compl_list.ne.0) - !write(*,*) compl_list(no_compl_ne) - !pause - if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - end do - endif ! compl allocated if(nn.eq.2) then ! nn.eq.2 if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertrophy+narrowing effect if(R0.lt.0.05_dp) then ! only Narrow_factor @@ -1345,13 +1356,22 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else elem_field(ne_radius_out,ne)=R0 endif ! radius criteria + ! if (allocated(compl_list)) then ! compl allocated + ! do no_compl_ne=1,count(compl_list.ne.0) + ! !write(*,*) compl_list(no_compl_ne) + ! !pause + ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + ! end do + ! endif ! compl allocated endif ! nn.eq.2 if (allocated(compl_list)) then ! compl allocated do no_compl_ne=1,count(compl_list.ne.0) - !write(*,*) compl_list(no_compl_ne) !pause - if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(ne.eq.compl_list(no_compl_ne))then + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + endif end do endif ! compl allocated endif !ptm @@ -1370,10 +1390,11 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif ! FOUND if (allocated(compl_list)) then ! compl allocated do no_compl_ne=1,count(compl_list.ne.0) - ! write(*,*) compl_list(no_compl_ne) ! pause - if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(ne.eq.compl_list(no_compl_ne))then + if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) + endif end do endif ! compl allocated else !other than arteries From e1fa674e1ba692bdd8f9073506611ba54415f03e Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Fri, 10 May 2024 15:36:04 +1200 Subject: [PATCH 08/13] bug fixed - veins were made rigid --- src/lib/pressure_resistance_flow.f90 | 81 ++++++++-------------------- 1 file changed, 22 insertions(+), 59 deletions(-) diff --git a/src/lib/pressure_resistance_flow.f90 b/src/lib/pressure_resistance_flow.f90 index 48e9ef25..ad301d5e 100644 --- a/src/lib/pressure_resistance_flow.f90 +++ b/src/lib/pressure_resistance_flow.f90 @@ -1123,8 +1123,6 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& check = is_downstream(ne,occ_list(k)) if(check)then FOUND = .True. - ! write(*,*) ne,occ_list - ! pause endif end do endif @@ -1145,18 +1143,18 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif endif ! nn.eq.1 if(nn.eq.2) then ! same thing as nn=1 - if(R0.lt.prune_rad.and.elem_ordrs(no_sord,ne).eq.1) then - if(counter2/100.le.prune_fraction) then - cc2=cc2+1.0_dp - R0=0.005_dp + if(R0.lt.prune_rad.and.elem_ordrs(no_sord,ne).eq.1) then + if(counter2/100.le.prune_fraction) then + cc2=cc2+1.0_dp + R0=0.005_dp + else + R0=elem_field(ne_radius_out0,ne) + endif + counter2 = counter2 + 1.0_dp + if(counter2.ge.101.0_dp) counter2=1.0_dp else R0=elem_field(ne_radius_out0,ne) endif - counter2 = counter2 + 1.0_dp - if(counter2.ge.101.0_dp) counter2=1.0_dp - else - R0=elem_field(ne_radius_out0,ne) - endif endif ! same thing as nn=1 else ! treat as healthy if(nn.eq.1) R0=elem_field(ne_radius_in0,ne) @@ -1223,7 +1221,7 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif endif !artery or vein elseif(vessel_type.eq.'elastic_alpha') then ! elastic alpha - if(elem_field(ne_group,ne).eq.0.0_dp) then !only applying on arteries + !if(elem_field(ne_group,ne).eq.0.0_dp) then !only applying on arteries BEN WAS HERE FOUND = .False. if (allocated(occ_list))then ! occ allocated do k=1,count(occ_list.ne.0) @@ -1249,16 +1247,6 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else !Pruning elem_field(ne_radius_in,ne) = R0 endif - ! if (allocated(compl_list)) then ! compl allocated - ! do no_compl_ne=1,count(compl_list.ne.0) - ! !write(*,*) compl_list(no_compl_ne) - ! !pause - ! if(ne.eq.compl_list(no_compl_ne))then - ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0!*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! endif - ! end do - ! endif ! compl allocated endif ! nn.eq.1 if(nn.eq.2) then ! nn.eq.2 if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertorphy+narrow factor effect @@ -1274,14 +1262,6 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else !Pruning elem_field(ne_radius_out,ne) = R0 endif - ! if (allocated(compl_list)) then ! compl allocated - ! do no_compl_ne=1,count(compl_list.ne.0) - ! ! write(*,*) compl_list(no_compl_ne) - ! ! pause - ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! end do - ! endif ! compl allocated endif ! nn.eq.2 if (allocated(compl_list)) then ! compl allocated do no_compl_ne=1,count(compl_list.ne.0) @@ -1332,14 +1312,6 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else elem_field(ne_radius_in,ne)=R0 endif - ! if (allocated(compl_list)) then ! compl allocated - ! do no_compl_ne=1,count(compl_list.ne.0) - ! !write(*,*) compl_list(no_compl_ne) - ! !pause - ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! end do - ! endif ! compl allocated endif ! nn.eq.1 if(nn.eq.2) then ! nn.eq.2 if((R0.gt.narrow_rad_one).and.(R0.lt.0.5_dp)) then ! Hypertrophy+narrowing effect @@ -1356,14 +1328,6 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& else elem_field(ne_radius_out,ne)=R0 endif ! radius criteria - ! if (allocated(compl_list)) then ! compl allocated - ! do no_compl_ne=1,count(compl_list.ne.0) - ! !write(*,*) compl_list(no_compl_ne) - ! !pause - ! if(nn.eq.1) elem_field(ne_radius_in,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! if(nn.eq.2) elem_field(ne_radius_out,compl_list(no_compl_ne))=R0*((Ptm*elasticity_parameters(1)*0.0)+1.d0) - ! end do - ! endif ! compl allocated endif ! nn.eq.2 if (allocated(compl_list)) then ! compl allocated do no_compl_ne=1,count(compl_list.ne.0) @@ -1397,19 +1361,6 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& endif end do endif ! compl allocated - else !other than arteries - if(Ptm.lt.elasticity_parameters(2))then - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) - elseif(Ptm.lt.0.0_dp)then !Ptm - if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 - else !ptm>ptmmax - if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) - if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) - endif - endif !artery or vein elseif(vessel_type.eq.'elastic_hooke')then h=elasticity_parameters(2)*R0 if(nn.eq.1) elem_field(ne_radius_in,ne)=R0+3.0_dp*R0**2*Ptm/(4.0_dp*elasticity_parameters(1)*h) @@ -1419,6 +1370,18 @@ subroutine calc_press_area(grav_vect,KOUNT,depvar_at_node,prq_solution,& if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 !vessel type endif !vessel type + else !other than arteries + if(Ptm.lt.elasticity_parameters(2))then + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((Ptm*elasticity_parameters(1))+1.d0) + elseif(Ptm.lt.0.0_dp)then !Ptm + if(Ptm.lt.0)write(*,*) 'Transmural pressure < zero',ne,Ptm,Pblood,Ppl + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0 + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0 + else !ptm>ptmmax + if(nn.eq.1) elem_field(ne_radius_in,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + if(nn.eq.2) elem_field(ne_radius_out,ne)=R0*((elasticity_parameters(2)*elasticity_parameters(1))+1.d0) + endif endif ! if artery enddo!nn enddo!ne From c623f2f6c09b1f4a189d49d79a65cd92b6b561f6 Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Thu, 8 Aug 2024 14:10:12 +1200 Subject: [PATCH 09/13] made compatible for proper wave exports for ROM --- src/lib/wave_transmission.f90 | 994 +++++++++++++++++++++++++++++----- 1 file changed, 855 insertions(+), 139 deletions(-) diff --git a/src/lib/wave_transmission.f90 b/src/lib/wave_transmission.f90 index 779bb25d..9acf6346 100644 --- a/src/lib/wave_transmission.f90 +++ b/src/lib/wave_transmission.f90 @@ -85,7 +85,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, character(len=60) :: sub_name logical :: vein_found=.False. integer :: vein_elem=0 - integer, parameter :: num_freq = 11, num_vessels = 17, num_units = 2 + integer, parameter :: num_freq = 101, num_vessels = 17, num_units = 2 integer :: i, j real :: freq(num_freq) character(len=5) :: vessel_names(num_vessels) = ["LUL_A", "LUL_V", "LLL_A", "LLL_V", "RUL_A", "RUL_V", "RLL_A", "RLL_V",& @@ -285,185 +285,754 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, min_art,max_art,tree_direction) endif + !calculate pressure drop through arterial tree (note to do veins too need to implement this concept thro' whole ladder model) + !Also need to implement in reverse for veins + call pressure_flow_factor(no_freq,p_factor,q_factor,reflect,prop_const,char_admit,harmonic_scale,min_art,max_art,bc_type) if(lobe_imped.eq.'ON') then ! export lobe imped ! Open output file open(unit=10, file='lobe_imped.json', status='replace') ! Write header and frequency values + write(*,*) no_freq, num_freq freq(1) = 0 do j = 2, no_freq+1 - freq(j) = (j-1)*harmonic_scale + freq(j) = (j-1)*harmonic_scale/10 + enddo + write(10, *) "{" + write(10, *) " ""frequency"": [", freq(1), ",", (freq(i),",",i=2,num_freq-1), freq(num_freq), "]," + write(10, *) '"vessel_names": ["LUL_A","LUL_V","LLL_A","LLL_V","RUL_A","RUL_V","RLL_A","RLL_V","RML_A","RML_V","MPA_A",& + "LPA_A","RPA_A","RBS_A","RBS_V","LBS_A","LBS_V"],' + ! Write impedance and phase matrices + write(10, *) " ""impedance"":{" + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,11))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+10)))/elem_field(ne_Qdot,11) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,11)) + enddo + write(10, *) " ""LUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+10))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,11) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+10)) + enddo + write(*,*) 'LUL_V:', imped(1), imped(2), imped(3) + pause + write(10, *) " ""LUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,20))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+19)))/elem_field(ne_Qdot,20) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,20)) + enddo + write(10, *) " ""LLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+19))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,20) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+19)) + enddo + write(10, *) " ""LLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,15))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+14)))/elem_field(ne_Qdot,15) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,15)) + enddo + write(10, *) " ""RUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+14))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,15) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+14)) + enddo + write(10, *) " ""RUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,23))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+22)))/elem_field(ne_Qdot,23) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,23)) + enddo + write(10, *) " ""RLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+22))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,23) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+22)) + enddo + write(10, *) " ""RLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,24))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+23)))/elem_field(ne_Qdot,24) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,24)) + enddo + write(10, *) " ""RML_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+23))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,24) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+23)) + enddo + write(10, *) " ""RML_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,1))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,1) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,1)) + enddo + write(10, *) " ""MPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,5))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+4)))/elem_field(ne_Qdot,5) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,5)) + enddo + write(10, *) " ""LPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,8))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+7)))/elem_field(ne_Qdot,8) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,8)) + enddo + write(10, *) " ""RPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,16))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+15)))/elem_field(ne_Qdot,16) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,16)) + enddo + write(10, *) " ""RBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+15))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,16) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+15)) + enddo + write(10, *) " ""RBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,12))-node_field& + (nj_bv_press,elem_nodes(2,min_ven+11)))/elem_field(ne_Qdot,12) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,12)) + enddo + write(10, *) " ""LBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+11))-node_field& + (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,12) + do i = 1, no_freq + imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+11)) + enddo + write(10, *) " ""LBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + + write(10, *) " ""unit"": ""dyne.s/cm5""" + write(10, *) " }," + write(10, *) " ""phase"":{" + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,11)),real(eff_admit(i,11), 8)) ! -1 is to make it impedance phase + enddo + write(10, *) " ""LUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,min_ven+10)),real(eff_admit(i,min_ven+10), 8)) + enddo + write(10, *) " ""LUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,20)),real(eff_admit(i,20), 8)) ! -1 is to make it impedance phase + enddo + write(10, *) " ""LLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,min_ven+19)),real(eff_admit(i,min_ven+19), 8)) + enddo + write(10, *) " ""LLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,15)),real(eff_admit(i,15), 8)) + enddo + write(10, *) " ""RUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,min_ven+14)),real(eff_admit(i,min_ven+14), 8)) + enddo + write(10, *) " ""RUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,23)),real(eff_admit(i,23), 8)) + enddo + write(10, *) " ""RLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,min_ven+22)),real(eff_admit(i,min_ven+22), 8)) + enddo + write(10, *) " ""RLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,24)),real(eff_admit(i,24), 8)) + enddo + write(10, *) " ""RML_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,min_ven+23)),real(eff_admit(i,min_ven+23), 8)) + enddo + write(10, *) " ""RML_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,1)),real(eff_admit(i,1), 8)) + enddo + write(10, *) " ""MPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,5)),real(eff_admit(i,5), 8)) + enddo + write(10, *) " ""LPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,8)),real(eff_admit(i,8), 8)) + enddo + write(10, *) " ""RPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,16)),real(eff_admit(i,16), 8)) + enddo + write(10, *) " ""RBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,min_ven+15)),real(eff_admit(i,min_ven+15), 8)) + enddo + write(10, *) " ""RBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,12)),real(eff_admit(i,12), 8)) + enddo + write(10, *) " ""LBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(eff_admit(i,min_ven+11)),real(eff_admit(i,min_ven+11), 8)) + enddo + write(10, *) " ""LBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + write(10, *) " ""unit"": ""radians""" + write(10, *) " }," + write(10, *) " ""Flow phase"":{" + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,11)),real(q_factor(i,11), 8)) ! -1 is to make it impedance phase + enddo + write(10, *) " ""LUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,min_ven+10)),real(q_factor(i,min_ven+10), 8)) + enddo + write(10, *) " ""LUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,20)),real(q_factor(i,20), 8)) ! -1 is to make it impedance phase + enddo + write(10, *) " ""LLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,min_ven+19)),real(q_factor(i,min_ven+19), 8)) + enddo + write(10, *) " ""LLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,15)),real(q_factor(i,15), 8)) + enddo + write(10, *) " ""RUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,min_ven+14)),real(q_factor(i,min_ven+14), 8)) + enddo + write(10, *) " ""RUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,23)),real(q_factor(i,23), 8)) + enddo + write(10, *) " ""RLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,min_ven+22)),real(q_factor(i,min_ven+22), 8)) + enddo + write(10, *) " ""RLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,24)),real(q_factor(i,24), 8)) + enddo + write(10, *) " ""RML_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,min_ven+23)),real(q_factor(i,min_ven+23), 8)) + enddo + write(10, *) " ""RML_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,1)),real(q_factor(i,1), 8)) + enddo + write(10, *) " ""MPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,5)),real(q_factor(i,5), 8)) + enddo + write(10, *) " ""LPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,8)),real(q_factor(i,8), 8)) + enddo + write(10, *) " ""RPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,16)),real(q_factor(i,16), 8)) + enddo + write(10, *) " ""RBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,min_ven+15)),real(q_factor(i,min_ven+15), 8)) + enddo + write(10, *) " ""RBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,12)),real(q_factor(i,12), 8)) + enddo + write(10, *) " ""LBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(q_factor(i,min_ven+11)),real(q_factor(i,min_ven+11), 8)) + enddo + write(10, *) " ""LBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + write(10, *) " ""unit"": ""radians""" + write(10, *) " }," + write(10, *) " ""Pressure phase"":{" + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,11)),real(p_factor(i,11), 8)) ! -1 is to make it impedance phase + enddo + write(10, *) " ""LUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,min_ven+10)),real(p_factor(i,min_ven+10), 8)) + enddo + write(10, *) " ""LUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,20)),real(p_factor(i,20), 8)) ! -1 is to make it impedance phase + enddo + write(10, *) " ""LLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,min_ven+19)),real(p_factor(i,min_ven+19), 8)) + enddo + write(10, *) " ""LLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,15)),real(p_factor(i,15), 8)) + enddo + write(10, *) " ""RUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,min_ven+14)),real(p_factor(i,min_ven+14), 8)) + enddo + write(10, *) " ""RUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,23)),real(p_factor(i,23), 8)) + enddo + write(10, *) " ""RLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,min_ven+22)),real(p_factor(i,min_ven+22), 8)) + enddo + write(10, *) " ""RLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,24)),real(p_factor(i,24), 8)) + enddo + write(10, *) " ""RML_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,min_ven+23)),real(p_factor(i,min_ven+23), 8)) + enddo + write(10, *) " ""RML_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,1)),real(p_factor(i,1), 8)) enddo - write(10, *) "{" - write(10, *) " ""frequency"": [", freq(1), ",", (freq(i),",",i=2,num_freq-1), freq(num_freq), "]," - write(10, *) '"vessel_names": ["LUL_A","LUL_V","LLL_A","LLL_V","RUL_A","RUL_V","RLL_A","RLL_V","RML_A","RML_V","MPA_A",& - "LPA_A","RPA_A","RBS_A","RBS_V","LBS_A","LBS_V"],' - ! Write impedance and phase matrices - write(10, *) " ""impedance"":{" + write(10, *) " ""MPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,5)),real(p_factor(i,5), 8)) + enddo + write(10, *) " ""LPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,8)),real(p_factor(i,8), 8)) + enddo + write(10, *) " ""RPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,16)),real(p_factor(i,16), 8)) + enddo + write(10, *) " ""RBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,min_ven+15)),real(p_factor(i,min_ven+15), 8)) + enddo + write(10, *) " ""RBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,12)),real(p_factor(i,12), 8)) + enddo + write(10, *) " ""LBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + imped(1) = 0 + do i = 1, no_freq + imped(i+1) = -1*atan2(dimag(p_factor(i,min_ven+11)),real(p_factor(i,min_ven+11), 8)) + enddo + write(10, *) " ""LBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," + write(10, *) " ""unit"": ""radians""" + write(10, *) " }," + write(10, *) " ""Flow amplitude"":{" !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Calculating LUL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,11))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+10)))/elem_field(ne_Qdot,11) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,11)) + imped(i+1) = abs(q_factor(i,11)) ! -1 is to make it impedance phase enddo write(10, *) " ""LUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LUL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+10))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,11) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+10)) + imped(i+1) = abs(q_factor(i,min_ven+10)) enddo write(10, *) " ""LUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LLL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,20))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+19)))/elem_field(ne_Qdot,20) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,20)) + imped(i+1) = abs(q_factor(i,20)) enddo write(10, *) " ""LLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LLL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+19))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,20) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+19)) + imped(i+1) = abs(q_factor(i,min_ven+19)) enddo write(10, *) " ""LLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RUL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,15))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+14)))/elem_field(ne_Qdot,15) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,15)) + imped(i+1) = abs(q_factor(i,15)) enddo write(10, *) " ""RUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RUL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+14))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,15) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+14)) + imped(i+1) = abs(q_factor(i,min_ven+14)) enddo write(10, *) " ""RUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RLL_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,23))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+22)))/elem_field(ne_Qdot,23) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,23)) + imped(i+1) = abs(q_factor(i,23)) enddo write(10, *) " ""RLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RLL_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+22))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,23) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+22)) + imped(i+1) = abs(q_factor(i,min_ven+22)) enddo write(10, *) " ""RLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RML_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,24))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+23)))/elem_field(ne_Qdot,24) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,24)) + imped(i+1) = abs(q_factor(i,24)) enddo write(10, *) " ""RML_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RML_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+23))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,24) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+23)) + imped(i+1) = abs(q_factor(i,min_ven+23)) enddo write(10, *) " ""RML_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating MPA impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,1))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,1) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,1)) + imped(i+1) = abs(q_factor(i, 1)) enddo + + write(*,*) 'q_factor:', imped + pause write(10, *) " ""MPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LPA impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,5))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+4)))/elem_field(ne_Qdot,5) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,5)) + imped(i+1) = abs(q_factor(i,5)) enddo write(10, *) " ""LPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RPA impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,8))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+7)))/elem_field(ne_Qdot,8) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,8)) + imped(i+1) = abs(q_factor(i,8)) enddo write(10, *) " ""RPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RBS_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,16))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+15)))/elem_field(ne_Qdot,16) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,16)) + imped(i+1) = abs(q_factor(i,16)) enddo write(10, *) " ""RBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RBS_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+15))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,16) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+15)) + imped(i+1) = abs(q_factor(i,min_ven+15)) enddo write(10, *) " ""RBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LBS_A impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,12))-node_field& - (nj_bv_press,elem_nodes(2,min_ven+11)))/elem_field(ne_Qdot,12) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,12)) + imped(i+1) = abs(q_factor(i,12)) enddo write(10, *) " ""LBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LBS_V impedances !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - imped(1) = 10000*(node_field(nj_bv_press,elem_nodes(1,min_ven+11))-node_field& - (nj_bv_press,elem_nodes(2,min_ven)))/elem_field(ne_Qdot,12) + imped(1) = 0 do i = 1, no_freq - imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+11)) + imped(i+1) = abs(q_factor(i,min_ven+11)) enddo write(10, *) " ""LBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," - - write(10, *) " ""unit"": ""dyne.s/cm5""" + write(10, *) " ""unit"": ""mm3/s""" write(10, *) " }," - write(10, *) " ""phase"":{" + write(10, *) " ""Pressure amplitude"":{" !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Calculating LUL_A phase !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,11)),real(eff_admit(i,11), 8)) + imped(i+1) = abs(p_factor(i,11)) ! -1 is to make it impedance phase enddo write(10, *) " ""LUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -471,7 +1040,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,min_ven+10)),real(eff_admit(i,min_ven+10), 8)) + imped(i+1) = abs(p_factor(i,min_ven+10)) enddo write(10, *) " ""LUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -479,7 +1048,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,20)),real(eff_admit(i,20), 8)) + imped(i+1) = abs(p_factor(i,20)) enddo write(10, *) " ""LLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -487,7 +1056,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,min_ven+19)),real(eff_admit(i,min_ven+19), 8)) + imped(i+1) = abs(p_factor(i,min_ven+19)) enddo write(10, *) " ""LLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -495,7 +1064,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,15)),real(eff_admit(i,15), 8)) + imped(i+1) = abs(p_factor(i,15)) enddo write(10, *) " ""RUL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -503,7 +1072,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,min_ven+14)),real(eff_admit(i,min_ven+14), 8)) + imped(i+1) = abs(p_factor(i,min_ven+14)) enddo write(10, *) " ""RUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -511,7 +1080,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,23)),real(eff_admit(i,23), 8)) + imped(i+1) = abs(p_factor(i,23)) enddo write(10, *) " ""RLL_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -519,7 +1088,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,min_ven+22)),real(eff_admit(i,min_ven+22), 8)) + imped(i+1) = abs(p_factor(i,min_ven+22)) enddo write(10, *) " ""RLL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -527,7 +1096,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,24)),real(eff_admit(i,24), 8)) + imped(i+1) = abs(p_factor(i,24)) enddo write(10, *) " ""RML_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -535,7 +1104,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,min_ven+23)),real(eff_admit(i,min_ven+23), 8)) + imped(i+1) = abs(p_factor(i,min_ven+23)) enddo write(10, *) " ""RML_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -543,7 +1112,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,1)),real(eff_admit(i,1), 8)) + imped(i+1) = abs(p_factor(i,1)) enddo write(10, *) " ""MPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -551,7 +1120,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,5)),real(eff_admit(i,5), 8)) + imped(i+1) = abs(p_factor(i,5)) enddo write(10, *) " ""LPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -559,7 +1128,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,8)),real(eff_admit(i,8), 8)) + imped(i+1) = abs(p_factor(i,8)) enddo write(10, *) " ""RPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -567,7 +1136,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,16)),real(eff_admit(i,16), 8)) + imped(i+1) = abs(p_factor(i,16)) enddo write(10, *) " ""RBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -575,7 +1144,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,min_ven+15)),real(eff_admit(i,min_ven+15), 8)) + imped(i+1) = abs(p_factor(i,min_ven+15)) enddo write(10, *) " ""RBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -583,7 +1152,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,12)),real(eff_admit(i,12), 8)) + imped(i+1) = abs(p_factor(i,12)) enddo write(10, *) " ""LBS_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -591,10 +1160,10 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! imped(1) = 0 do i = 1, no_freq - imped(i+1) = atan2(dimag(eff_admit(i,min_ven+11)),real(eff_admit(i,min_ven+11), 8)) + imped(i+1) = abs(p_factor(i,min_ven+11)) enddo write(10, *) " ""LBS_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," - write(10, *) " ""unit"": ""radians""" + write(10, *) " ""unit"": ""Pa""" write(10, *) " }," write(10, *) " ""radius"":{" @@ -669,75 +1238,221 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, write(10, *) " ""unit"": ""mm""" write(10, *) " }," + write(10, *) " ""unstrained radius"":{" + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LUL_A"": [", elem_field(ne_radius_out0,11), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LUL_V"": [", elem_field(ne_radius_out0,min_ven+10), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LLL_A"": [", elem_field(ne_radius_out0,20), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LLL_V"": [", elem_field(ne_radius_out0,min_ven+19), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RUL_A"": [", elem_field(ne_radius_out0,15), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RUL_V"": [", elem_field(ne_radius_out0,min_ven+14), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RLL_A"": [", elem_field(ne_radius_out0,23), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RLL_V"": [", elem_field(ne_radius_out0,min_ven+22), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RML_A"": [", elem_field(ne_radius_out0,24), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RML_V"": [", elem_field(ne_radius_out0,min_ven+23), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""MPA_A"": [", elem_field(ne_radius_out0,1), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LPA_A"": [", elem_field(ne_radius_out0,5), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RPA_A"": [", elem_field(ne_radius_out0,8), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RBS_A"": [", elem_field(ne_radius_out0,16), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RBS_V"": [", elem_field(ne_radius_out0,min_ven+15), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LBS_A"": [", elem_field(ne_radius_out0,12), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V unstrained radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LBS_V"": [", elem_field(ne_radius_out0,min_ven+11), "]," + + write(10, *) " ""unit"": ""mm""" + write(10, *) " }," + write(10, *) " ""mean flow"":{" + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LUL_A"": [", elem_field(ne_Qdot,11), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LUL_V"": [", elem_field(ne_Qdot,min_ven+10), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LLL_A"": [", elem_field(ne_Qdot,20), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LLL_V"": [", elem_field(ne_Qdot,min_ven+19), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RUL_A"": [", elem_field(ne_Qdot,15), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RUL_V"": [", elem_field(ne_Qdot,min_ven+14), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RLL_A"": [", elem_field(ne_Qdot,23), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RLL_V"": [", elem_field(ne_Qdot,min_ven+22), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RML_A"": [", elem_field(ne_Qdot,24), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RML_V"": [", elem_field(ne_Qdot,min_ven+23), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""MPA_A"": [", elem_field(ne_Qdot,1), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LPA_A"": [", elem_field(ne_Qdot,5), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RPA_A"": [", elem_field(ne_Qdot,8), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RBS_A"": [", elem_field(ne_Qdot,16), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""RBS_V"": [", elem_field(ne_Qdot,min_ven+15), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LBS_A"": [", elem_field(ne_Qdot,12), "]," + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V mean flow !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + write(10, *) " ""LBS_V"": [", elem_field(ne_Qdot,min_ven+11), "]," + + write(10, *) " ""unit"": ""mm^3/s""" + write(10, *) " }," write(10, *) " ""Length"":{" !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Calculating LUL_A radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Calculating LUL_A Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""LUL_A"": [", elem_field(ne_length,11), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LUL_V radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LUL_V Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""LUL_V"": [", elem_field(ne_length,min_ven+10), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LLL_A radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_A Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""LLL_A"": [", elem_field(ne_length,20), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LLL_V radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LLL_V Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""LLL_V"": [", elem_field(ne_length,min_ven+19), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RUL_A radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_A Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RUL_A"": [", elem_field(ne_length,15), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RUL_V radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RUL_V Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RUL_V"": [", elem_field(ne_length,min_ven+14), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RLL_A radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_A Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RLL_A"": [", elem_field(ne_length,23), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RLL_V radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RLL_V Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RLL_V"": [", elem_field(ne_length,min_ven+22), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RML_A radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_A Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RML_A"": [", elem_field(ne_length,24), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RML_V radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RML_V Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RML_V"": [", elem_field(ne_length,min_ven+23), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating MPA radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating MPA Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""MPA_A"": [", elem_field(ne_length,1)+elem_field(ne_length,2)+elem_field(ne_length,3)& +elem_field(ne_length,4), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LPA radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LPA Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""LPA_A"": [", elem_field(ne_length,5)+elem_field(ne_length,6)+elem_field(ne_length,7), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RPA radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RPA Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RPA_A"": [", elem_field(ne_length,8)+elem_field(ne_length,9)+elem_field(ne_length,10), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RBS_A radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_A Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RBS_A"": [", elem_field(ne_length,16), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating RBS_V radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating RBS_V Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""RBS_V"": [", elem_field(ne_length,min_ven+15), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LBS_A radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_A Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""LBS_A"": [", elem_field(ne_length,12)+elem_field(ne_length,13)+elem_field(ne_length,14), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !Calculating LBS_V radius !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Calculating LBS_V Length !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! write(10, *) " ""LBS_V"": [", elem_field(ne_length,min_ven+11)+elem_field(ne_length,min_ven+12)& +elem_field(ne_length,min_ven+13), "]," @@ -748,13 +1463,10 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, close(10) endif ! export lobe admittance - !calculate pressure drop through arterial tree (note to do veins too need to implement this concept thro' whole ladder model) - !Also need to implement in reverse for veins - call pressure_flow_factor(no_freq,p_factor,q_factor,reflect,prop_const,char_admit,harmonic_scale,min_art,max_art,bc_type) open(fid5, file = 'inputadmittance.txt',action='write') write(fid5,fmt=*) 'input admittance:' do nf=1,no_freq - omega=nf*harmonic_scale + omega=nf*harmonic_scale/10 write(fid5,fmt=*) omega,abs(eff_admit(nf,1)),& atan2(dimag(eff_admit(nf,1)),real(eff_admit(nf,1), 8)) enddo @@ -786,7 +1498,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, if (bc_type.eq.'pressure') then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale + omega=2*pi*nf*harmonic_scale/10 forward_pressure(nt)=forward_pressure(nt)+abs(p_factor(nf,ne))*a(nf)*cos(omega*time+b(nf)+& atan2(dimag(p_factor(nf,ne)),real(p_factor(nf,ne), 8))) forward_pressure_previous(nt)=forward_pressure_previous(nt)+abs(p_factor(nf,ne_previous))*& @@ -824,7 +1536,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, elseif (bc_type.eq.'flow') then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale + omega=2*pi*nf*harmonic_scale/10 forward_pressure(nt)=forward_pressure(nt)+(abs(q_factor(nf,ne))/abs(char_admit(nf,ne)))*a(nf)*& cos(omega*time+b(nf)+atan2(dimag(q_factor(nf,ne)),real(q_factor(nf,ne), 8))-& @@ -916,7 +1628,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, if (bc_type.eq.'pressure')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale + omega=2*pi*nf*harmonic_scale/10 forward_pressure(nt)=forward_pressure(nt)+abs(p_factor(nf,ne))*a(nf)*cos(omega*time+b(nf)+& atan2(dimag(p_factor(nf,ne)),real(p_factor(nf,ne), 8))) @@ -946,7 +1658,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, elseif(bc_type.eq.'flow')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale + omega=2*pi*nf*harmonic_scale/10 forward_pressure(nt)=forward_pressure(nt)+(abs(q_factor(nf,ne))/abs(char_admit(nf,ne)))*a(nf)*& cos(omega*time+b(nf)+atan2(dimag(q_factor(nf,ne)),real(q_factor(nf,ne), 8))-& @@ -1028,7 +1740,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, if (bc_type.eq.'pressure')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale + omega=2*pi*nf*harmonic_scale/10 forward_pressure(nt)=forward_pressure(nt)+abs(p_factor(nf,ne))*a(nf)*cos(omega*time+b(nf)+& atan2(dimag(p_factor(nf,ne)),real(p_factor(nf,ne), 8))) @@ -1058,7 +1770,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, elseif(bc_type.eq.'flow')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale + omega=2*pi*nf*harmonic_scale/10 forward_pressure(nt)=forward_pressure(nt)+(abs(q_factor(nf,ne))/abs(char_admit(nf,ne)))*a(nf)*& cos(omega*time+b(nf)+atan2(dimag(q_factor(nf,ne)),real(q_factor(nf,ne), 8))-& @@ -1164,7 +1876,7 @@ subroutine boundary_admittance(no_freq,eff_admit,char_admit,admit_param,harmonic R1=admit_param%two_parameter%admit_P1 C=admit_param%two_parameter%admit_P2 do nf=1,no_freq !step through frequencies - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 if(mesh_type.eq.'simple_tree')then do nunit=1,num_units ne=units(nunit) @@ -1185,7 +1897,7 @@ subroutine boundary_admittance(no_freq,eff_admit,char_admit,admit_param,harmonic R2=admit_param%three_parameter%admit_P2 C=admit_param%three_parameter%admit_P3 do nf=1,no_freq !step through frequencies - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 if(mesh_type.eq.'simple_tree')then do nunit=1,num_units ne=units(nunit) @@ -1211,7 +1923,7 @@ subroutine boundary_admittance(no_freq,eff_admit,char_admit,admit_param,harmonic length=admit_param%four_parameter%admit_P3 radius=admit_param%four_parameter%admit_P4 do nf=1,no_freq !step through frequencies - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 do nunit=1,num_units ne=units(nunit) !temporarily store in eff_admit, to be added to the char admit @@ -1327,7 +2039,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal G=0.0_dp elseif(admit_param%admittance_type.eq.'duan_zamir')then do nf=1,no_freq !radius needs to be multipled by 1000 to go to mm (units of rest of model) - omega=nf*2*PI*harmonic_scale!q/s + omega=nf*2*PI*harmonic_scale/10!q/s wolmer=(elem_field(ne_radius_out,ne))*sqrt(omega*density/viscosity) call bessel_complex(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp),bessel0,bessel1) f10=2*bessel1/(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp)*bessel0)!no units @@ -1343,7 +2055,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal if(admit_param%admittance_type.eq.'duan_zamir')then else do nf=1,no_freq - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 char_admit(nf,ne)=sqrt(G+cmplx(0.0_dp,1.0_dp,8)*omega*C)/sqrt(R+cmplx(0.0_dp,1.0_dp,8)*omega*L)!mm3/Pa.s prop_const(nf,ne)=sqrt((G+cmplx(0.0_dp,1.0_dp,8)*omega*C)*(R+cmplx(0.0_dp,1.0_dp,8)*omega*L))!1/mm enddo!nf @@ -1463,7 +2175,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal G=0.0_dp elseif(admit_param%admittance_type.eq.'duan_zamir')then do nf=1,no_freq !radius needs to be multipled by 1000 to go to mm (units of rest of model) - omega=nf*2*PI*harmonic_scale!q/s + omega=nf*2*PI*harmonic_scale/10!q/s wolmer=(elem_field(ne_radius_out,ne))*sqrt(omega*density/viscosity) !radii is already affected by a factor call bessel_complex(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp),bessel0,bessel1) f10=2*bessel1/(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp)*bessel0)!no units @@ -1493,7 +2205,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal if(admit_param%admittance_type.eq.'duan_zamir')then else do nf=1,no_freq - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 char_admit(nf,ne)=sqrt(G+cmplx(0.0_dp,1.0_dp,8)*omega*C)/sqrt(R+cmplx(0.0_dp,1.0_dp,8)*omega*L)!mm3/Pa.s prop_const(nf,ne)=sqrt((G+cmplx(0.0_dp,1.0_dp,8)*omega*C)*(R+cmplx(0.0_dp,1.0_dp,8)*omega*L))!1/mm enddo!nf @@ -1530,7 +2242,7 @@ subroutine tree_admittance(no_freq,eff_admit,char_admit,reflect,prop_const,harmo if(tree_direction.eq.'diverging')then do nf=1,no_freq - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 do ne=max_elem,min_elem,-1!step backward through elements daughter_admit=cmplx(0.0_dp,0.0_dp,8)! @@ -1558,7 +2270,7 @@ subroutine tree_admittance(no_freq,eff_admit,char_admit,reflect,prop_const,harmo enddo!nf elseif(tree_direction.eq.'converging')then do nf=1,no_freq - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 do ne=min_elem,max_elem!step forward through elements daughter_admit=cmplx(0.0_dp,0.0_dp,8)! sister_admit=cmplx(0.0_dp,0.0_dp,8)! @@ -1659,7 +2371,7 @@ end subroutine capillary_admittance ! !################################################ ! -!*pressure_factor:* Calculates change in pressure through tree +!*pressure_factor:* Calculates change in pressure and flow through tree subroutine pressure_flow_factor(no_freq,p_factor,q_factor,reflect,prop_const,char_admit,harmonic_scale,ne_min,ne_max,bc_type) integer, intent(in) :: no_freq @@ -1686,7 +2398,7 @@ subroutine pressure_flow_factor(no_freq,p_factor,q_factor,reflect,prop_const,cha q_factor=1.0_dp if (bc_type.eq.'pressure') then do nf=1,no_freq - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 do ne=ne_min,ne_max !look for upstream element if(elem_cnct(-1,0,ne).eq.0)then !no upstream elements, inlet, ignore @@ -1704,19 +2416,23 @@ subroutine pressure_flow_factor(no_freq,p_factor,q_factor,reflect,prop_const,cha enddo!nf elseif (bc_type.eq.'flow') then do nf=1,no_freq - omega=nf*2*PI*harmonic_scale + omega=nf*2*PI*harmonic_scale/10 do ne=ne_min,ne_max !look for upstream element if(elem_cnct(-1,0,ne).eq.0)then !no upstream elements, inlet, ignore ne_up=ne_min q_factor(nf,ne)=(1.0_dp)!* &!assumes input admittance is the same as characteristic admittance for this vessel + p_factor(nf,ne)=q_factor(nf,ne)/char_admit(nf,ne)!(1.0_dp)!* &!assumes input admittance is the same as characteristic admittance for this vessel !exp(-1.0_dp*prop_const(nf,ne)*elem_field(ne_length,ne))!/& !(1+reflect(nf,ne)*exp(-2.0_dp*prop_const(nf,ne)*elem_field(ne_length,ne))) else ne_up=elem_cnct(-1,1,ne) - q_factor(nf,ne)=q_factor(nf,ne_up)*char_admit(nf,ne)*(1+reflect(nf,ne_up))* & - exp(-1.0_dp*elem_field(ne_length,ne_up)*prop_const(nf,ne_up))/& - (char_admit(nf,ne_up)*(1+reflect(nf,ne)*exp(-2.0_dp*elem_field(ne_length,ne)*prop_const(nf,ne)))) + p_factor(nf,ne)=p_factor(nf,ne_up)*(char_admit(nf,ne_up)*(1-reflect(nf,ne_up))* & + exp(-1.0_dp*elem_field(ne_length,ne_up)*prop_const(nf,ne_up)))/& + (2*char_admit(nf,ne)*(1-reflect(nf,ne)*exp(-2.0_dp*elem_field(ne_length,ne)*prop_const(nf,ne)))) + q_factor(nf,ne)=p_factor(nf,ne_up)*char_admit(nf,ne)!(1+reflect(nf,ne_up))* & + !exp(-1.0_dp*elem_field(ne_length,ne_up)*prop_const(nf,ne_up))/& + !(1+reflect(nf,ne)*exp(-2.0_dp*elem_field(ne_length,ne)*prop_const(nf,ne))) endif!neup enddo!ne enddo!nf From 42b28b4335aa2ddba579a5dde8d6a5017a3c0a56 Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Wed, 9 Oct 2024 13:32:45 +1300 Subject: [PATCH 10/13] commented lines delete --- src/lib/wave_transmission.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/lib/wave_transmission.f90 b/src/lib/wave_transmission.f90 index 9acf6346..5b49ddfe 100644 --- a/src/lib/wave_transmission.f90 +++ b/src/lib/wave_transmission.f90 @@ -292,7 +292,6 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, ! Open output file open(unit=10, file='lobe_imped.json', status='replace') ! Write header and frequency values - write(*,*) no_freq, num_freq freq(1) = 0 do j = 2, no_freq+1 freq(j) = (j-1)*harmonic_scale/10 @@ -321,7 +320,6 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, do i = 1, no_freq imped(i+1) = 10000.0/abs(eff_admit(i,min_ven+10)) enddo - write(*,*) 'LUL_V:', imped(1), imped(2), imped(3) pause write(10, *) " ""LUL_V"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -972,7 +970,6 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, imped(i+1) = abs(q_factor(i, 1)) enddo - write(*,*) 'q_factor:', imped pause write(10, *) " ""MPA_A"": [", imped(1), ",", (imped(i),",",i=2,num_freq-1), imped(num_freq), "]," !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From dc61cae3b18c094408e787ffe7d70e0a04dab579 Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Thu, 29 May 2025 17:38:15 +1200 Subject: [PATCH 11/13] Merge branch develop with partial_occlusions --- src/bindings/c/geometry.f90 | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/src/bindings/c/geometry.f90 b/src/bindings/c/geometry.f90 index 31d2d87a..7a44b732 100644 --- a/src/bindings/c/geometry.f90 +++ b/src/bindings/c/geometry.f90 @@ -172,12 +172,6 @@ end subroutine import_ply_triangles_c ! !################################################################################### ! -<<<<<<< HEAD - subroutine make_data_grid_c(surface_elems_len, surface_elems, offset, spacing, & - filename, filename_len, groupname, groupname_len)& - bind(C, name="make_data_grid_c") - -======= subroutine list_tree_statistics_c(filename, filename_len) & bind(C, name="list_tree_statistics_c") @@ -190,7 +184,7 @@ subroutine list_tree_statistics_c(filename, filename_len) & integer,intent(in) :: filename_len type(c_ptr), value, intent(in) :: filename character(len=MAX_FILENAME_LEN) :: filename_f - + call strncpy(filename_f, filename, filename_len) call list_tree_statistics(filename_f) @@ -200,35 +194,34 @@ end subroutine list_tree_statistics_c !################################################################################### ! subroutine internal_mesh_reorder_c() bind(C, name="internal_mesh_reorder_c") - + use geometry,only: internal_mesh_reorder implicit none call internal_mesh_reorder() end subroutine internal_mesh_reorder_c - + ! !################################################################################### ! subroutine make_data_grid_c(surface_elems_len, surface_elems, num_target, offset, spacing)& bind(C, name="make_data_grid_c") - ->>>>>>> prime/develop + use arrays,only: dp use iso_c_binding, only: c_ptr use utils_c, only: strncpy use other_consts, only: MAX_FILENAME_LEN, MAX_STRING_LEN use geometry, only: make_data_grid implicit none - + integer,intent(in) :: surface_elems_len integer,intent(in) :: surface_elems(surface_elems_len) integer,intent(in) :: num_target real(dp),intent(in) :: offset, spacing - + call make_data_grid(surface_elems, num_target, offset, spacing) - + end subroutine make_data_grid_c !!!################################################################################### From 20668ed4aca2c8554f026fdb39fac5be6016e65a Mon Sep 17 00:00:00 2001 From: Behdad Shaarbaf Ebrahimi Date: Fri, 30 May 2025 11:18:41 +1200 Subject: [PATCH 12/13] fixed some conflicts in wave-transmission --- src/lib/wave_transmission.f90 | 38 +++++++++++++++++------------------ 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/lib/wave_transmission.f90 b/src/lib/wave_transmission.f90 index 37e12032..40332ae4 100644 --- a/src/lib/wave_transmission.f90 +++ b/src/lib/wave_transmission.f90 @@ -295,7 +295,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, ! Write header and frequency values freq(1) = 0 do j = 2, no_freq+1 - freq(j) = (j-1)*harmonic_scale/10 + freq(j) = (j-1)*harmonic_scale enddo write(10, *) "{" write(10, *) " ""frequency"": [", freq(1), ",", (freq(i),",",i=2,no_freq), freq(no_freq+1), "]," @@ -1917,7 +1917,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, open(fid5, file = 'inputadmittance.txt',action='write') write(fid5,fmt=*) 'input admittance:' do nf=1,no_freq - omega=nf*harmonic_scale/10 + omega=nf*harmonic_scale write(fid5,fmt=*) omega,abs(eff_admit(nf,1)),& atan2(dimag(eff_admit(nf,1)),real(eff_admit(nf,1), 8)) enddo @@ -1949,7 +1949,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, if (bc_type.eq.'pressure') then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale/10 + omega=2*pi*nf*harmonic_scale forward_pressure(nt)=forward_pressure(nt)+abs(p_factor(nf,ne))*a(nf)*cos(omega*time+b(nf)+& atan2(dimag(p_factor(nf,ne)),real(p_factor(nf,ne), 8))) forward_pressure_previous(nt)=forward_pressure_previous(nt)+abs(p_factor(nf,ne_previous))*& @@ -1987,7 +1987,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, elseif (bc_type.eq.'flow') then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale/10 + omega=2*pi*nf*harmonic_scale forward_pressure(nt)=forward_pressure(nt)+(abs(q_factor(nf,ne))/abs(char_admit(nf,ne)))*a(nf)*& cos(omega*time+b(nf)+atan2(dimag(q_factor(nf,ne)),real(q_factor(nf,ne), 8))-& @@ -2079,7 +2079,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, if (bc_type.eq.'pressure')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale/10 + omega=2*pi*nf*harmonic_scale forward_pressure(nt)=forward_pressure(nt)+abs(p_factor(nf,ne))*a(nf)*cos(omega*time+b(nf)+& atan2(dimag(p_factor(nf,ne)),real(p_factor(nf,ne), 8))) @@ -2109,7 +2109,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, elseif(bc_type.eq.'flow')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale/10 + omega=2*pi*nf*harmonic_scale forward_pressure(nt)=forward_pressure(nt)+(abs(q_factor(nf,ne))/abs(char_admit(nf,ne)))*a(nf)*& cos(omega*time+b(nf)+atan2(dimag(q_factor(nf,ne)),real(q_factor(nf,ne), 8))-& @@ -2166,7 +2166,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, if (bc_type.eq.'pressure')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale/10 + omega=2*pi*nf*harmonic_scale forward_pressure(nt)=forward_pressure(nt)+abs(p_factor(nf,ne))*a(nf)*cos(omega*time+b(nf)+& atan2(dimag(p_factor(nf,ne)),real(p_factor(nf,ne), 8))) @@ -2196,7 +2196,7 @@ subroutine evaluate_wave_transmission(grav_dirn,grav_factor,n_time,heartrate,a0, elseif(bc_type.eq.'flow')then do nt=1,n_time do nf=1,no_freq - omega=2*pi*nf*harmonic_scale/10 + omega=2*pi*nf*harmonic_scale forward_pressure(nt)=forward_pressure(nt)+(abs(q_factor(nf,ne))/abs(char_admit(nf,ne)))*a(nf)*& cos(omega*time+b(nf)+atan2(dimag(q_factor(nf,ne)),real(q_factor(nf,ne), 8))-& @@ -2297,7 +2297,7 @@ subroutine boundary_admittance(no_freq,eff_admit,char_admit,admit_param,harmonic R1=admit_param%two_parameter%admit_P1 C=admit_param%two_parameter%admit_P2 do nf=1,no_freq !step through frequencies - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale if(mesh_type.eq.'simple_tree')then do nunit=1,num_units ne=units(nunit) @@ -2318,7 +2318,7 @@ subroutine boundary_admittance(no_freq,eff_admit,char_admit,admit_param,harmonic R2=admit_param%three_parameter%admit_P2 C=admit_param%three_parameter%admit_P3 do nf=1,no_freq !step through frequencies - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale if(mesh_type.eq.'simple_tree')then do nunit=1,num_units ne=units(nunit) @@ -2344,7 +2344,7 @@ subroutine boundary_admittance(no_freq,eff_admit,char_admit,admit_param,harmonic length=admit_param%four_parameter%admit_P3 radius=admit_param%four_parameter%admit_P4 do nf=1,no_freq !step through frequencies - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale do nunit=1,num_units ne=units(nunit) !temporarily store in eff_admit, to be added to the char admit @@ -2460,7 +2460,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal G=0.0_dp elseif(admit_param%admittance_type.eq.'duan_zamir')then do nf=1,no_freq !radius needs to be multipled by 1000 to go to mm (units of rest of model) - omega=nf*2*PI*harmonic_scale/10!q/s + omega=nf*2*PI*harmonic_scale!q/s wolmer=(elem_field(ne_radius_out,ne))*sqrt(omega*density/viscosity) call bessel_complex(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp),bessel0,bessel1) f10=2*bessel1/(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp)*bessel0)!no units @@ -2476,7 +2476,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal if(admit_param%admittance_type.eq.'duan_zamir')then else do nf=1,no_freq - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale char_admit(nf,ne)=sqrt(G+cmplx(0.0_dp,1.0_dp,8)*omega*C)/sqrt(R+cmplx(0.0_dp,1.0_dp,8)*omega*L)!mm3/Pa.s prop_const(nf,ne)=sqrt((G+cmplx(0.0_dp,1.0_dp,8)*omega*C)*(R+cmplx(0.0_dp,1.0_dp,8)*omega*L))!1/mm enddo!nf @@ -2596,7 +2596,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal G=0.0_dp elseif(admit_param%admittance_type.eq.'duan_zamir')then do nf=1,no_freq !radius needs to be multipled by 1000 to go to mm (units of rest of model) - omega=nf*2*PI*harmonic_scale/10!q/s + omega=nf*2*PI*harmonic_scale!q/s wolmer=(elem_field(ne_radius_out,ne))*sqrt(omega*density/viscosity) !radii is already affected by a factor call bessel_complex(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp),bessel0,bessel1) f10=2*bessel1/(wolmer*cmplx(0.0_dp,1.0_dp,8)**(3.0_dp/2.0_dp)*bessel0)!no units @@ -2626,7 +2626,7 @@ subroutine characteristic_admittance(no_freq,char_admit,prop_const,harmonic_scal if(admit_param%admittance_type.eq.'duan_zamir')then else do nf=1,no_freq - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale char_admit(nf,ne)=sqrt(G+cmplx(0.0_dp,1.0_dp,8)*omega*C)/sqrt(R+cmplx(0.0_dp,1.0_dp,8)*omega*L)!mm3/Pa.s prop_const(nf,ne)=sqrt((G+cmplx(0.0_dp,1.0_dp,8)*omega*C)*(R+cmplx(0.0_dp,1.0_dp,8)*omega*L))!1/mm enddo!nf @@ -2663,7 +2663,7 @@ subroutine tree_admittance(no_freq,eff_admit,char_admit,reflect,prop_const,harmo if(tree_direction.eq.'diverging')then do nf=1,no_freq - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale do ne=max_elem,min_elem,-1!step backward through elements daughter_admit=cmplx(0.0_dp,0.0_dp,8)! @@ -2691,7 +2691,7 @@ subroutine tree_admittance(no_freq,eff_admit,char_admit,reflect,prop_const,harmo enddo!nf elseif(tree_direction.eq.'converging')then do nf=1,no_freq - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale do ne=min_elem,max_elem!step forward through elements daughter_admit=cmplx(0.0_dp,0.0_dp,8)! sister_admit=cmplx(0.0_dp,0.0_dp,8)! @@ -2821,7 +2821,7 @@ subroutine pressure_flow_factor(no_freq,p_factor,q_factor,reflect,prop_const,cha q_factor=1.0_dp if (bc_type.eq.'pressure') then do nf=1,no_freq - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale do ne=ne_min,ne_max !look for upstream element if(elem_cnct(-1,0,ne).eq.0)then !no upstream elements, inlet, ignore @@ -2841,7 +2841,7 @@ subroutine pressure_flow_factor(no_freq,p_factor,q_factor,reflect,prop_const,cha enddo!nf elseif (bc_type.eq.'flow') then ! NEEDS TO BE PROPERLY LOOKED AT. THE MATH ESPECIFICALLY do nf=1,no_freq - omega=nf*2*PI*harmonic_scale/10 + omega=nf*2*PI*harmonic_scale do ne=ne_min,ne_max !look for upstream element if(elem_cnct(-1,0,ne).eq.0)then !no upstream elements, inlet, ignore From 3c80706e5ced8c2b0725f858ac5603805b1b2783 Mon Sep 17 00:00:00 2001 From: Hugh Sorby Date: Tue, 3 Jun 2025 14:38:31 +1200 Subject: [PATCH 13/13] Update build_test.yml --- .github/workflows/build_test.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/build_test.yml b/.github/workflows/build_test.yml index e2349d50..2e4eb2d9 100644 --- a/.github/workflows/build_test.yml +++ b/.github/workflows/build_test.yml @@ -24,15 +24,15 @@ jobs: os: windows-2022, } - { - name: "Ubuntu 20.04", + name: "Ubuntu 24.04", build_type: "Release", - os: ubuntu-20.04, + os: ubuntu-24.04, } - { - name: "Ubuntu 20.04 with SuperLU", + name: "Ubuntu 24.04 with SuperLU", build_type: "Release", super_lu: true, - os: ubuntu-20.04, + os: ubuntu-24.04, } - { name: "macOS Ventura",