diff options
Diffstat (limited to 'Dragon/src/g2s_generateTabSegArc.f90')
| -rw-r--r-- | Dragon/src/g2s_generateTabSegArc.f90 | 145 |
1 files changed, 145 insertions, 0 deletions
diff --git a/Dragon/src/g2s_generateTabSegArc.f90 b/Dragon/src/g2s_generateTabSegArc.f90 new file mode 100644 index 0000000..9684634 --- /dev/null +++ b/Dragon/src/g2s_generateTabSegArc.f90 @@ -0,0 +1,145 @@ +! +!----------------------------------------------------------------------- +! +!Purpose: +! Fill the TabSegArc structure with information recovered in a +! surfacic file. +! +!Copyright: +! Copyright (C) 2001 Ecole Polytechnique de Montreal. +! This library is free software; you can redistribute it and/or +! modify it under the terms of the GNU Lesser General Public +! License as published by the Free Software Foundation; either +! version 2.1 of the License, or (at your option) any later version. +! +!Author(s): +! G. Civario (CS-SI) +! +!----------------------------------------------------------------------- +! +module generTabSegArc + use constUtiles + use segArc + use boundCond + use SALGET_FUNS_MOD + use precision_and_kinds, only : pdb + implicit none + +contains + + subroutine generateTabSegArc(ipSal,sizeSA,nbNode,nbCLP,nbFlux,merg,impx) + integer,intent(inout) :: ipSal + integer,intent(in) :: nbNode,sizeSA,impx + integer,intent(out) :: nbCLP,nbFlux + integer,dimension(nbNode),intent(out) :: merg + + integer, parameter :: n_datain=25, n_datare=20 + integer, dimension (n_datain) :: datain + real, dimension (n_datare) :: datare + real(pdb), dimension (n_datare) :: datade + integer :: type,nber,prec,elem,i,nbMacro,fout0 + integer, parameter, dimension(0:4) :: read_bc_len=(/1,1,2,3,3/) + character(len=12) :: name_geom + ! internal : albedo + ! vacuum surface : albedo + ! specular reflexion : none + ! translation : tx ty (t=translation vector) + ! rotation : cx cy cos(theta) sin(theta) theta + ! (c= center,theta= axis angle) + ! axial symmetry : cx cy cos(theta) sin(theta) theta + ! (c= center,theta= axis angle) + ! central symetry : cx cy (c= center) + integer, allocatable, dimension(:) :: iflux, medium + integer,parameter :: dimTabCelluleBase = 20000 + + fout0=6 + if(impx == 0) fout0=0 + call SALGET(datain,6,ipSal,fout0,'dimensions for geometry') + if(nbNode /= datain(3)) call XABORT('g2s_generateTabSegArc: nbNode error') + if(sizeSA /= datain(4)) call XABORT('g2s_generateTabSegArc: sizeSA error') + typgeo=datain(1) + nbMacro=datain(5) + nbFlux=datain(6) + call SALGET(datain,3,ipSal,fout0,'index kndex prec') + prec=datain(3) + call SALGET(datare,1,ipSal,fout0,'eps') + call SALGET(merg,nbNode,ipSal,fout0,'flux index per node') + call SALGET(name_geom,ipSal,fout0,'names of macros') + allocate(iflux(nbFlux),stat=alloc_ok) + if (alloc_ok /= 0) call XABORT("G2S: generateTabSegArc(1) => allocation pb") + call SALGET(iflux,nbFlux,ipSal,fout0,'macro order number per flux region') + deallocate(iflux) + do elem=1,sizeSA + call SALGET(datain,3,ipSal,fout0,'integer descriptors') + type=datain(1) + tabSegArc(elem)%typ=type + if(type == 1) then + tabSegArc(elem)%noded=datain(2) + tabSegArc(elem)%nodeg=datain(3) + else + tabSegArc(elem)%nodeg=datain(2) + tabSegArc(elem)%noded=datain(3) + endif + select case (type) + case (1) + nber=4 + case (2) + nber=3 + case (3) + nber=5 + case default + write(fout0,'(1x,''==> sal126: unknown type '',i3)')type + call xabort('g2_generateTabSegArc: unknown type') + end select + call SALGET(datade,nber,ipSal,fout0,prec,'real descriptors') + tabSegArc(elem)%x=datade(1) + tabSegArc(elem)%y=datade(2) + select case (type) + case (1) + tabSegArc(elem)%dx=datade(1)+datade(3) + tabSegArc(elem)%dy=datade(2)+datade(4) + case (2) + tabSegArc(elem)%r=datade(3) + tabSegArc(elem)%a=0.0 + tabSegArc(elem)%b=0.0 + case (3) + tabSegArc(elem)%r=datade(3) + tabSegArc(elem)%a=datade(4)/rad2deg + tabSegArc(elem)%b=(datade(4)+datade(5))/rad2deg + end select + enddo + call SALGET(datain,3,ipSal,fout0,'general bc data') + nbCLP=datain(2) + call SALGET(datade(1),ipSal,fout0,prec,'general albedo') + do i=1,nbCLP + call SALGET(datain,2,ipSal,fout0,'specific bc: type nber') + type=datain(1) + nber=datain(2) + SALbCDataTab(i)%SALtype=type + SALbCDataTab(i)%nber=nber + allocate(SALbCDataTab(i)%elemNb(nber),stat=alloc_ok) + if (alloc_ok /= 0) call XABORT("G2S: generateTabSegArc(3) => allocation pb") + call SALGET(SALbCDataTab(i)%elemNb,nber,ipSal,fout0,'bc elements') + ! read bc motion + call SALGET(datade,read_bc_len(type),ipSal,fout0,prec,'data for specific bc condition') + select case(type) + case(0,1) + SALbCDataTab(i)%albedo=real(datade(1)) + case(2) + SALbCDataTab(i)%tx=real(datade(1)) + SALbCDataTab(i)%ty=real(datade(2)) + case(3,4) + SALbCDataTab(i)%cx=real(datade(1)) + SALbCDataTab(i)%cy=real(datade(2)) + SALbCDataTab(i)%angle=real(datade(3)) + end select + enddo + allocate(medium(dimTabCelluleBase)) + call SALGET(medium,nbNode,ipSal,fout0,'media per node') + do i=1,sizeSA + if(tabSegArc(i)%nodeg>0) tabSegArc(i)%neutronicMixg=medium(tabSegArc(i)%nodeg) + if(tabSegArc(i)%noded>0) tabSegArc(i)%neutronicMixd=medium(tabSegArc(i)%noded) + enddo + deallocate(medium) + end subroutine generateTabSegArc +end module generTabSegArc |
