SUBROUTINE rd_inp_bc_wall(input_file,sec,nbf,id,bc_temp,bc_conc,bc_vel,bc_stress)
USE class_psblas
USE json_module, ONLY : json_file
USE class_bc_math
USE tools_bc
USE tools_input
IMPLICIT NONE
!
TYPE(json_file) :: nemo_json
CHARACTER(len=*), INTENT(IN) :: input_file
CHARACTER(len=*), INTENT(IN) :: sec
INTEGER, INTENT(IN) :: nbf
INTEGER, INTENT(OUT) :: id(:)
TYPE(bc_math), INTENT(OUT) :: bc_temp
TYPE(bc_math), INTENT(OUT) :: bc_conc
TYPE(bc_math), INTENT(OUT) :: bc_vel(3)
TYPE(bc_math), INTENT(OUT) :: bc_stress(3)
!
LOGICAL, PARAMETER :: debug = .FALSE.
LOGICAL :: found
!
INTEGER :: mypnum, icontxt
INTEGER :: id_sec, inp
REAL(psb_dpk_) :: work(3,5), wtemp
CHARACTER(len=15) :: par
icontxt = icontxt_()
mypnum = mypnum_()
id = -1 ! DEFAULT value
work = 0.d0
IF(mypnum == 0) THEN
CALL open_file(input_file,nemo_json)
WRITE(*,*) '- Reading ', TRIM(sec), ' section: type WALL'
CALL nemo_json%get(trim(sec)//'.temperature.id', id_sec, found)
IF (.NOT.found) THEN
WRITE(*,*) 'Temperature BC not found in RD_INP_BC_WALL'
CALL abort_psblas
ELSE
id(bc_temp_) = id_sec
SELECT CASE(id_sec)
CASE(bc_temp_fixed_) ! Fixed temperature
CALL nemo_json%get(trim(sec)//'.temperature.value', work(1,bc_temp_), found)
CASE(bc_temp_adiabatic_) ! Adiabatic wall
!READ(inp,'()')
CASE(bc_temp_flux_) ! Fixed heat flux
CALL nemo_json%get(trim(sec)//'.temperature.value', work(1,bc_temp_), found)
CASE(bc_temp_convection_) ! Convection
CALL nemo_json%get(trim(sec)//'.temperature.value', work(1,bc_temp_), found)
CALL nemo_json%get(trim(sec)//'.temperature.value2', work(2,bc_temp_), found)
CASE(bc_temp_convection_map_) ! Convection map
!READ(inp,'()') ! To be actually set at the first mapping
CASE DEFAULT
WRITE(*,210)
CALL abort_psblas
END SELECT
END IF
CALL nemo_json%get(trim(sec)//'.concentration.id', id_sec, found)
IF (.NOT.found) THEN
WRITE(*,*) 'Concentration BC not found in RD_INP_BC_WALL'
! CALL abort_psblas
ELSE
id(bc_conc_) = id_sec
SELECT CASE(id_sec)
CASE(bc_conc_fixed_) ! Fixed temperature
CALL nemo_json%get(trim(sec)//'.concetration.value', work(1,bc_conc_), found)
CASE(bc_conc_adiabatic_) ! Adiabatic wall
!READ(inp,'()')
CASE DEFAULT
WRITE(*,210)
CALL abort_psblas
END SELECT
END IF
CALL nemo_json%get(trim(sec)//'.velocity.id', id_sec, found)
IF (.NOT.found) THEN
WRITE(*,*) 'Velocity BC not found in RD_INP_BC_WALL'
ELSE
id(bc_vel_) = id_sec
SELECT CASE(id_sec)
CASE(bc_vel_no_slip_, bc_vel_free_slip_, bc_vel_free_sliding_)
!READ(inp,'()')
CASE(bc_vel_sliding_)
CALL nemo_json%get(trim(sec)//'.velocity.v1', work(1,bc_vel_), found)
CALL nemo_json%get(trim(sec)//'.velocity.v2', work(2,bc_vel_), found)
CALL nemo_json%get(trim(sec)//'.velocity.v3', work(3,bc_vel_), found)
WRITE(0,*) 'rd_inp_bc_wall: Debug: work', work(1:3,bc_vel_)
CASE(bc_vel_moving_)
!READ(inp,'()')
CASE DEFAULT
WRITE(*,220)
CALL abort_psblas
END SELECT
END IF
CALL nemo_json%get(trim(sec)//'.stress.id', id_sec, found)
IF (.NOT.found) THEN
WRITE(*,*) 'Stress BC not found in RD_INP_BC_WALL'
ELSE
id(bc_stress_) = id_sec
SELECT CASE(id_sec)
CASE(bc_stress_free_)
!READ(inp,'()')
CASE(bc_stress_prescribed_)
CALL nemo_json%get(trim(sec)//'.stress.v1', work(1,bc_stress_), found)
CALL nemo_json%get(trim(sec)//'.stress.v2', work(2,bc_stress_), found)
CALL nemo_json%get(trim(sec)//'.stress.v3', work(3,bc_stress_), found)
WRITE(0,*) 'rd_inp_bc_wall: Debug: work', work(1:3,bc_stress_)
CASE DEFAULT
WRITE(*,230)
CALL abort_psblas
END SELECT
END IF
END IF
! Broadcast
CALL psb_bcast(icontxt,id)
CALL psb_bcast(icontxt,work)
! TEMPERATURE section
SELECT CASE(id(bc_temp_))
CASE(bc_temp_fixed_) ! Fixed temperature
CALL bc_temp%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/work(1,bc_temp_)/))
CASE(bc_temp_adiabatic_) ! Adiabatic wall
CALL bc_temp%alloc_bc_math(bc_neumann_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/0.d0/))
CASE(bc_temp_flux_) ! Fixed heat flux
CALL bc_temp%alloc_bc_math(bc_neumann_flux_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/work(1,bc_temp_)/))
CASE(bc_temp_convection_) ! Convection
CALL bc_temp%alloc_bc_math(bc_robin_convection_,nbf,&
& a=(/work(1,bc_temp_)/),b=(/1.d0/),&
& c=(/work(1,bc_temp_)*work(2,bc_temp_)/))
CASE(bc_temp_convection_map_) ! Convection map
CALL bc_temp%alloc_bc_math(bc_robin_map_,nbf,&
& a=(/(0.d0, inp=1,nbf)/),b=(/(1.d0, inp=1,nbf)/),&
& c=(/(0.d0, inp=1,nbf)/))
END SELECT
! VELOCITY section
SELECT CASE(id(bc_vel_))
CASE(bc_vel_no_slip_)
CALL bc_vel(1)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/0.d0/))
CALL bc_vel(2)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/0.d0/))
CALL bc_vel(3)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/0.d0/))
CASE(bc_vel_free_slip_)
CALL bc_vel(1)%alloc_bc_math(bc_neumann_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/0.d0/))
CALL bc_vel(2)%alloc_bc_math(bc_neumann_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/0.d0/))
CALL bc_vel(3)%alloc_bc_math(bc_neumann_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/0.d0/))
CASE(bc_vel_sliding_)
WRITE(0,*) 'rd_inp_bc_wall: Debug: setting', work(1:3,bc_vel_)
CALL bc_vel(1)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/work(1,bc_vel_)/))
CALL bc_vel(2)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/work(2,bc_vel_)/))
CALL bc_vel(3)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/work(3,bc_vel_)/))
WRITE(0,*) 'rd_inp_bc_wall: Debug: set'
CASE(bc_vel_free_sliding_)
CALL bc_vel(1)%alloc_bc_math(bc_dirichlet_map_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/(0.d0, inp=1,nbf)/))
CALL bc_vel(2)%alloc_bc_math(bc_dirichlet_map_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/(0.d0, inp=1,nbf)/))
CALL bc_vel(3)%alloc_bc_math(bc_dirichlet_map_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/(0.d0, inp=1,nbf)/))
CASE(-1)
CASE DEFAULT
WRITE(0,*) 'Fix here unimplemented BC setup !!'
END SELECT
! Stress section
SELECT CASE(id(bc_stress_))
CASE(bc_stress_free_)
CALL bc_stress(1)%alloc_bc_math(bc_neumann_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/0.d0/))
CALL bc_stress(2)%alloc_bc_math(bc_neumann_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/0.d0/))
CALL bc_stress(3)%alloc_bc_math(bc_neumann_,nbf,&
& a=(/0.d0/),b=(/1.d0/),c=(/0.d0/))
CASE(bc_stress_prescribed_)
CALL bc_stress(1)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/work(1,bc_stress_)/))
CALL bc_stress(2)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/work(2,bc_stress_)/))
CALL bc_stress(3)%alloc_bc_math(bc_dirichlet_,nbf,&
& a=(/1.d0/),b=(/0.d0/),c=(/work(3,bc_stress_)/))
CASE DEFAULT
WRITE(0,*) 'Fix here unimplemented BC setup !!', id(bc_stress_)
END SELECT
! ***
! If ID = -1 (Default) the corresponding BC will not be allocated
! ***
IF(debug) THEN
WRITE(*,*)
WRITE(*,400) mypnum
WRITE(*,500) TRIM(sec),' - Type: Wall'
WRITE(*,600) ' * TEMPERATURE Section *'
WRITE(*,700) ' BC%id(bc_temp_) = ', id(bc_temp_)
IF (id(bc_temp_) > 0) CALL bc_temp%debug_bc_math()
WRITE(*,600) ' * VELOCITY Section *'
WRITE(*,700) ' BC%id(bc_vel_) = ', id(bc_vel_)
IF (id(bc_vel_) > 0) THEN
CALL bc_vel(1)%debug_bc_math()
CALL bc_vel(2)%debug_bc_math()
CALL bc_vel(3)%debug_bc_math()
WRITE(*,*)
END IF
END IF
100 FORMAT(a,i1)
210 FORMAT(' ERROR! Unsupported ID(BC_TEMP_) in RD_INP_BC_WALL')
220 FORMAT(' ERROR! Unsupported ID(BC_VEL_) in RD_INP_BC_WALL')
230 FORMAT(' ERROR! Unsupported ID(BC_STRESS_) in RD_INP_BC_WALL')
999 FORMAT(' ERROR! Missing boundary condition in RC_INP_BC_WALL')
400 FORMAT(' ----- Process ID = ',i2,' -----')
500 FORMAT(1x,a,a)
600 FORMAT(1x,a)
700 FORMAT(1x,a,i2)
END SUBROUTINE rd_inp_bc_wall