programmer's documentation
 All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Macros Groups Pages
Extract a 1D profile

Extract a 1D profile

This is an example of cs_user_extra_operations which performs 1D profile.

Local variables to be added

integer iel
integer iel1
integer impout
integer ii , irangv , irang1 , npoint
integer iun
double precision xyz(3), xabs, xu, xv, xw, xk, xeps

Body

We seek here to extract the profile of U, V, W, k and epsilon on an arbitrary 1D curve based on a curvilear abscissa. The profile is described in the 'profile.dat' file (do not forget to define it as user data in the run script).

Here is the corresponding code:

if (ntcabs.eq.ntmabs) then
! Only process of rank 0 (parallel) or -1 (scalar) writes to this file.
! We use 'user' Fortran units.
impout = impusr(1)
if (irangp.le.0) then
open(impout,file='profile.dat')
write(impout,*) &
'# z(m) U(m/s) V(m/s) W(m/s) k(m2/s2) eps(m2/s3)'
endif
npoint = 200
iel1 = -999
irang1 = -999
do ii = 1, npoint
xyz(1) = 0.d0
xyz(2) = float(ii-1)/float(npoint-1)*0.1d0
xyz(3) = 0.d0
call findpt(ncelet, ncel, xyzcen, xyz(1), xyz(2), xyz(3), iel, irangv)
!==========
if ((iel.ne.iel1).or.(irangv.ne.irang1)) then
iel1 = iel
irang1 = irangv
! Set temporary variables xu, xv, ... for the process containing
! the point and then send it to other processes.
if (irangp.eq.irangv) then
xabs = xyzcen(2,iel)
xu = rtp(iel,iu)
xv = rtp(iel,iv)
xw = rtp(iel,iw)
xk = 0.d0
xeps = 0.d0
if ( itytur.eq.2 .or. iturb.eq.50 &
.or. iturb.eq.60) then
xk = rtp(iel,ik)
elseif (itytur.eq.3) then
xk = ( rtp(iel,ir11) + rtp(iel,ir22) &
+ rtp(iel,ir33)) / 2.d0
endif
if ( itytur.eq.2 .or. itytur.eq.3 &
.or. iturb.eq.50) then
xeps = rtp(iel,iep)
elseif (iturb.eq.60) then
xeps = cmu*rtp(iel,ik)*rtp(iel,iomg)
endif
else
xabs = 0.d0
xu = 0.d0
xv = 0.d0
xw = 0.d0
xk = 0.d0
xeps = 0.d0
endif
! Broadcast to other ranks in parallel
if (irangp.ge.0) then
iun = 1
call parbcr(irangv, iun, xabs)
call parbcr(irangv, iun, xu)
call parbcr(irangv, iun, xv)
call parbcr(irangv, iun, xw)
call parbcr(irangv, iun, xk)
call parbcr(irangv, iun, xeps)
endif
if (irangp.le.0) write(impout,99) xabs, xu, xv, xw, xk, xeps
99 format(6g17.9)
endif
enddo
if (irangp.le.0) close(impout)
endif