44 integer(kind=intType) :: sps, nn, mm, ierr
45 real(kind=realtype) :: gm1, ratio
46 real(kind=realtype) :: nuinf, ktmp, uinf2
47 real(kind=realtype) :: vinf, zinf, tmp1(1), tmp2(1)
97 if (
allocated(
winf))
deallocate (
winf)
98 allocate (
winf(
nw), stat=ierr)
208 real(kind=realtype),
intent(in),
dimension(nwf) :: oldwinf
209 real(kind=realtype),
intent(in) :: correctiontol
210 character*(*),
intent(in) :: correctionType
211 integer(kind=intType) :: sps, nn, i, j, k, l
212 real(kind=realtype) :: deltawinf(
nwf)
215 real(kind=realtype),
dimension(3) :: vec1, vec2, vcell
216 real(kind=realtype),
dimension(3, 3) :: rotmat
217 real(kind=realtype) :: mag1, mag2
227 if (
mynorm2(deltawinf) < correctiontol)
then
237 if (correctiontype .eq.
"offset")
then
247 w(i, j, k, l) =
w(i, j, k, l) + deltawinf(l)
256 else if (correctiontype .eq.
"rotate")
then
281 w(i, j, k,
ivx:
ivz) = matmul(rotmat, vcell)
363 integer(kind=intType) :: sps, level, nLevels
390 do level = 2, nlevels
423 integer(kind=intType),
intent(in) :: sps, level
429 integer(kind=intType) :: nn
430 integer(kind=intType) :: il, jl, kl, ie, je, ke, ib, jb, kb
434 domains:
do nn = 1,
ndom
457 allocate (
flowdoms(nn, level, sps)%w(0:ib, 0:jb, 0:kb, 1:
nw), &
460 allocate (
flowdoms(nn, level, sps)%w(0:ib, 0:jb, 0:kb, 1:
nwf), &
465 "Memory allocation failure for w")
468 allocate (
flowdoms(nn, level, sps)%ux(il, jl, kl), stat=ierr)
469 allocate (
flowdoms(nn, level, sps)%uy(il, jl, kl), stat=ierr)
470 allocate (
flowdoms(nn, level, sps)%uz(il, jl, kl), stat=ierr)
472 allocate (
flowdoms(nn, level, sps)%vx(il, jl, kl), stat=ierr)
473 allocate (
flowdoms(nn, level, sps)%vy(il, jl, kl), stat=ierr)
474 allocate (
flowdoms(nn, level, sps)%vz(il, jl, kl), stat=ierr)
476 allocate (
flowdoms(nn, level, sps)%wx(il, jl, kl), stat=ierr)
477 allocate (
flowdoms(nn, level, sps)%wy(il, jl, kl), stat=ierr)
478 allocate (
flowdoms(nn, level, sps)%wz(il, jl, kl), stat=ierr)
480 allocate (
flowdoms(nn, level, sps)%qx(il, jl, kl), stat=ierr)
481 allocate (
flowdoms(nn, level, sps)%qy(il, jl, kl), stat=ierr)
482 allocate (
flowdoms(nn, level, sps)%qz(il, jl, kl), stat=ierr)
485 allocate (
flowdoms(nn, level, sps)%p(0:ib, 0:jb, 0:kb), stat=ierr)
488 "Memory allocation failure for p")
491 allocate (
flowdoms(nn, level, sps)%aa(0:ib, 0:jb, 0:kb), stat=ierr)
494 "Memory allocation failure for p")
503 allocate (
flowdoms(nn, level, sps)%rev(0:ib, 0:jb, 0:kb), &
508 "Memory allocation failure for rev")
513 fineleveltest:
if (level == 1)
then
518 allocate (
flowdoms(nn, level, sps)%gamma(0:ib, 0:jb, 0:kb), &
522 "Memory allocation failure for gamma.")
529 allocate (
flowdoms(nn, level, sps)%rlv(0:ib, 0:jb, 0:kb), &
533 "Memory allocation failure for rlv")
545 "Memory allocation failure for wOld")
560 "Memory allocation failure for wOld")
572 sps1ranstest:
if (sps == 1)
then
588 "Memory allocation failure for bmti1, etc")
625 integer(kind=intType),
intent(in) :: sps, level
631 integer(kind=intType) :: nn, mm
632 integer(kind=intType) :: il, jl, kl, ie, je, ke, ib, jb, kb
636 domains:
do nn = 1,
ndom
655 allocate (
flowdoms(nn, level, sps)%s(ie, je, ke, 3), &
656 flowdoms(nn, level, sps)%sFaceI(0:ie, je, ke), &
657 flowdoms(nn, level, sps)%sFaceJ(ie, 0:je, ke), &
658 flowdoms(nn, level, sps)%sFaceK(ie, je, 0:ke), stat=ierr)
661 "Memory allocation failure for s, &
662 &sFaceI, sFaceJ and sFaceK.")
667 flowdoms(nn, level, sps)%sVeloIALE(0:ie, je, ke, 3), &
668 flowdoms(nn, level, sps)%sVeloJALE(ie, 0:je, ke, 3), &
669 flowdoms(nn, level, sps)%sVeloKALE(ie, je, 0:ke, 3), &
675 "Memory allocation failure for &
676 &sVeloIALE, sVeloJALE and sVeloKALE; &
677 &sFaceIALE, sFaceJALE and sFaceKALE.")
682 fineleveltest:
if (level == 1)
then
687 flowdoms(nn, level, sps)%dw(0:ib, 0:jb, 0:kb, 1:
nw), &
688 flowdoms(nn, level, sps)%fw(0:ib, 0:jb, 0:kb, 1:
nwf), &
689 flowdoms(nn, level, sps)%dtl(1:ie, 1:je, 1:ke), &
690 flowdoms(nn, level, sps)%radI(1:ie, 1:je, 1:ke), &
691 flowdoms(nn, level, sps)%radJ(1:ie, 1:je, 1:ke), &
692 flowdoms(nn, level, sps)%radK(1:ie, 1:je, 1:ke), &
693 flowdoms(nn, level, sps)%scratch(0:ib, 0:jb, 0:kb, 10), &
694 flowdoms(nn, level, sps)%shockSensor(0:ib, 0:jb, 0:kb), &
698 "Memory allocation failure for dw, fw, dwOld, fwOld, &
699 &gamma, dtl and the spectral radii.")
714 "Memory allocation failure for dwALE, fwALE.")
721 allocate (
flowdoms(nn, level, sps)%wn(2:il, 2:jl, 2:kl, 1:
nwf), &
722 flowdoms(nn, level, sps)%pn(2:il, 2:jl, 2:kl), stat=ierr)
725 "Memory allocation failure for wn and pn")
734 allocate (
flowdoms(nn, level, sps)%dwOldRK(mm, il, jl, kl,
nw), &
738 "Memory allocation failure for dwOldRK.")
746 allocate (
flowdoms(nn, level, sps)%p1(1:ie, 1:je, 1:ke), &
747 flowdoms(nn, level, sps)%w1(1:ie, 1:je, 1:ke, 1:
nwf), &
748 flowdoms(nn, level, sps)%wr(2:il, 2:jl, 2:kl, 1:
nwf), &
752 "Memory allocation failure for p1, w1 &
781 integer(kind=intType) :: nFiles
794 "Memory allocation failure for restartFiles")
821 integer(kind=intType) :: sps, spsm1, mm, nn, i, j, k, l
823 real(kind=realtype) :: dt, tnew, told, tmp
824 real(kind=realtype) :: theta, costheta, sintheta
826 real(kind=realtype),
dimension(3) :: rotpoint, uu
827 real(kind=realtype),
dimension(3) :: xt, yt, zt
828 real(kind=realtype),
dimension(3, 3) :: rotmat
830 real(kind=realtype),
dimension(nSections, 3, 3) :: rotmatsec
839 testrotating:
if (
sections(nn)%rotating)
then
845 theta =
two *
pi / real(i, realtype)
846 costheta = cos(theta)
847 sintheta = sin(theta)
859 if (abs(xt(2)) < 0.707107_realtype)
then
871 tmp = xt(1) * yt(1) + xt(2) * yt(2) + xt(3) * yt(3)
872 yt(1) = yt(1) - tmp * xt(1)
873 yt(2) = yt(2) - tmp * xt(2)
874 yt(3) = yt(3) - tmp * xt(3)
878 tmp =
one / sqrt(yt(1)**2 + yt(2)**2 + yt(3)**2)
885 zt(1) = xt(2) * yt(3) - xt(3) * yt(2)
886 zt(2) = xt(3) * yt(1) - xt(1) * yt(3)
887 zt(3) = xt(1) * yt(2) - xt(2) * yt(1)
901 rotmatsec(nn, 1, 1) = xt(1) * xt(1) &
902 + costheta * (yt(1) * yt(1) + zt(1) * zt(1))
903 rotmatsec(nn, 1, 2) = xt(1) * xt(2) &
904 + costheta * (yt(1) * yt(2) + zt(1) * zt(2)) &
905 - sintheta * (yt(1) * zt(2) - yt(2) * zt(1))
906 rotmatsec(nn, 1, 3) = xt(1) * xt(3) &
907 + costheta * (yt(1) * yt(3) + zt(1) * zt(3)) &
908 - sintheta * (yt(1) * zt(3) - yt(3) * zt(1))
910 rotmatsec(nn, 2, 1) = xt(1) * xt(2) &
911 + costheta * (yt(1) * yt(2) + zt(1) * zt(2)) &
912 + sintheta * (yt(1) * zt(2) - yt(2) * zt(1))
913 rotmatsec(nn, 2, 2) = xt(2) * xt(2) &
914 + costheta * (yt(2) * yt(2) + zt(2) * zt(2))
915 rotmatsec(nn, 2, 3) = xt(2) * xt(3) &
916 + costheta * (yt(2) * yt(3) + zt(2) * zt(3)) &
917 - sintheta * (yt(2) * zt(3) - yt(3) * zt(2))
919 rotmatsec(nn, 3, 1) = xt(1) * xt(3) &
920 + costheta * (yt(1) * yt(3) + zt(1) * zt(3)) &
921 + sintheta * (yt(1) * zt(3) - yt(3) * zt(1))
922 rotmatsec(nn, 3, 2) = xt(2) * xt(3) &
923 + costheta * (yt(2) * yt(3) + zt(2) * zt(3)) &
924 + sintheta * (yt(2) * zt(3) - yt(3) * zt(2))
925 rotmatsec(nn, 3, 3) = xt(3) * xt(3) &
926 + costheta * (yt(3) * yt(3) + zt(3) * zt(3))
933 rotmatsec(nn, 1, 1) =
one
934 rotmatsec(nn, 1, 2) =
zero
935 rotmatsec(nn, 1, 3) =
zero
937 rotmatsec(nn, 2, 1) =
zero
938 rotmatsec(nn, 2, 2) =
one
939 rotmatsec(nn, 2, 3) =
zero
941 rotmatsec(nn, 3, 1) =
zero
942 rotmatsec(nn, 3, 2) =
zero
943 rotmatsec(nn, 3, 3) =
one
982 domains:
do nn = 1,
ndom
1000 iovar(nn, sps)%w(i, j, k, l) =
iovar(nn, spsm1)%w(i, j, k, l)
1006 uu(1) = rotmat(1, 1) *
iovar(nn, sps)%w(i, j, k,
ivx) &
1007 + rotmat(1, 2) *
iovar(nn, sps)%w(i, j, k,
ivy) &
1008 + rotmat(1, 3) *
iovar(nn, sps)%w(i, j, k,
ivz)
1010 uu(2) = rotmat(2, 1) *
iovar(nn, sps)%w(i, j, k,
ivx) &
1011 + rotmat(2, 2) *
iovar(nn, sps)%w(i, j, k,
ivy) &
1012 + rotmat(2, 3) *
iovar(nn, sps)%w(i, j, k,
ivz)
1014 uu(3) = rotmat(3, 1) *
iovar(nn, sps)%w(i, j, k,
ivx) &
1015 + rotmat(3, 2) *
iovar(nn, sps)%w(i, j, k,
ivy) &
1016 + rotmat(3, 3) *
iovar(nn, sps)%w(i, j, k,
ivz)
1021 iovar(nn, sps)%w(i, j, k,
ivx) = rotmatsec(mm, 1, 1) * uu(1) &
1022 + rotmatsec(mm, 1, 2) * uu(2) &
1023 + rotmatsec(mm, 1, 3) * uu(3)
1025 iovar(nn, sps)%w(i, j, k,
ivy) = rotmatsec(mm, 2, 1) * uu(1) &
1026 + rotmatsec(mm, 2, 2) * uu(2) &
1027 + rotmatsec(mm, 2, 3) * uu(3)
1029 iovar(nn, sps)%w(i, j, k,
ivz) = rotmatsec(mm, 3, 1) * uu(1) &
1030 + rotmatsec(mm, 3, 2) * uu(2) &
1031 + rotmatsec(mm, 3, 3) * uu(3)
1071 integer(kind=intType) :: ii, nn
1073 character(len=7) :: integerString
1074 character(len=maxStringLen) :: tmpName
1096 call terminate(
"determineSolFileNames", &
1097 "Memory allocation failure for solFiles")
1123 print
"(a)",
"# Warning"
1124 print
"(a)",
"# Not enough data found for a consistent &
1125 &time accurate restart."
1126 print
"(a)",
"# Order is reduced in the first time steps &
1127 &until enough data is available again."
1180 integer(kind=intType) :: nn
1188 call terminate(
"determineSolFileNames", &
1189 "Memory allocation failure for solFiles")
1213 character(len=maxStringLen) :: errorMessage
1214 integer(kind=intType) :: nn
1217 open (unit=21, file=
solfiles(nn), status=
"old", iostat=ierr)
1219 write (errormessage, *)
"Restart file ", trim(
solfiles(nn)), &
1220 " could not be opened for reading"
1221 call terminate(
"checkSolFileNames", errormessage)
1264 logical,
intent(in) :: halosRead
1268 integer(kind=intType) :: nn, mm
1269 real(kind=realtype) :: relaxbleedsor
1271 real(kind=realtype),
dimension(nSections) :: t
1273 logical :: initBleeds
1280 initbleeds = .false.
1302 t(nn) = t(nn) + (mm - 1) *
sections(nn)%timePeriod &
1409 integer(kind=intType) :: ierr
1439 "Deallocation failure for solFiles and IOVar")
1475 integer(kind=intType) :: nn
1524 logical,
intent(in) :: halosRead
1528 integer(kind=intType) :: nn, mm, i, j, k, l
1529 integer(kind=intType) :: jj, kk
1534 domains:
do nn = 1, ndom
1542 testhalosread:
if (halosread)
then
1550 kk = max(1_inttype, min(k,
ke))
1552 jj = max(1_inttype, min(j,
je))
1555 w(0, j, k, l) =
w(1, jj, kk, l)
1556 w(
ib, j, k, l) =
w(
ie, jj, kk, l)
1559 p(0, j, k) =
p(1, jj, kk)
1560 p(
ib, j, k) =
p(
ie, jj, kk)
1569 kk = max(1_inttype, min(k,
ke))
1573 w(i, 0, k, l) =
w(i, 1, kk, l)
1574 w(i,
jb, k, l) =
w(i,
je, kk, l)
1577 p(i, 0, k) =
p(i, 1, kk)
1578 p(i,
jb, k) =
p(i,
je, kk)
1590 w(i, j, 0, l) =
w(i, j, 1, l)
1591 w(i, j,
kb, l) =
w(i, j,
ke, l)
1594 p(i, j, 0) =
p(i, j, 1)
1595 p(i, j,
kb) =
p(i, j,
ke)
1608 kk = max(2_inttype, min(k,
kl))
1610 jj = max(2_inttype, min(j,
jl))
1613 w(0, j, k, l) =
w(2, jj, kk, l)
1614 w(1, j, k, l) =
w(2, jj, kk, l)
1615 w(
ie, j, k, l) =
w(
il, jj, kk, l)
1616 w(
ib, j, k, l) =
w(
il, jj, kk, l)
1619 p(0, j, k) =
p(2, jj, kk)
1620 p(1, j, k) =
p(2, jj, kk)
1621 p(
ie, j, k) =
p(
il, jj, kk)
1622 p(
ib, j, k) =
p(
il, jj, kk)
1631 kk = max(2_inttype, min(k,
kl))
1635 w(i, 0, k, l) =
w(i, 2, kk, l)
1636 w(i, 1, k, l) =
w(i, 2, kk, l)
1637 w(i,
je, k, l) =
w(i,
jl, kk, l)
1638 w(i,
jb, k, l) =
w(i,
jl, kk, l)
1641 p(i, 0, k) =
p(i, 2, kk)
1642 p(i, 1, k) =
p(i, 2, kk)
1643 p(i,
je, k) =
p(i,
jl, kk)
1644 p(i,
jb, k) =
p(i,
jl, kk)
1656 w(i, j, 0, l) =
w(i, j, 2, l)
1657 w(i, j, 1, l) =
w(i, j, 2, l)
1658 w(i, j,
ke, l) =
w(i, j,
kl, l)
1659 w(i, j,
kb, l) =
w(i, j,
kl, l)
1662 p(i, j, 0) =
p(i, j, 2)
1663 p(i, j, 1) =
p(i, j, 2)
1664 p(i, j,
ke) =
p(i, j,
kl)
1665 p(i, j,
kb) =
p(i, j,
kl)
1670 end if testhalosread
1706 integer(kind=intType) :: jj, nn, ll, sps, i, j, k, l
1708 real(kind=realtype) :: t
1710 real(kind=realtype),
dimension(nSolsRead) :: alpscal
1711 real(kind=realtype),
dimension(nSections, nSolsRead, 3, 3) :: alpmat
1730 domains:
do nn = 1, ndom
1738 varloop:
do l = 1,
nw
1742 veltest:
if (l ==
ivx .or. l ==
ivy .or. l ==
ivz)
then
1769 w(i, j, k, l) =
zero
1771 w(i, j, k, l) =
w(i, j, k, l) &
1797 w(i, j, k, l) =
zero
1799 w(i, j, k, l) =
w(i, j, k, l) &
1800 + alpscal(jj) *
iovar(nn, jj)%w(i, j, k, l)
1819 deallocate (
iovar(nn, sps)%w, stat=ierr)
1821 call terminate(
"interpolateSpectralSolution", &
1822 "Deallocation failure for w.")
1845 integer(kind=intType) :: mm, nn, sps, level, nLevels, ii
1849 nlevels = ubound(flowdoms, 2)
1854 levelloop:
do level = 1, nlevels
1856 domainsloop:
do nn = 1, ndom
1865 bocoloop:
do mm = 1,
nbocos
1869 inflowtype:
select case(
bctype(mm))
1880 flowdoms(nn, 1, sps)%BCData(mm)%subsonicInletTreatment
1895 "Deallocation failure for rho, &
1896 &velx, vely and velz")
1899 nullify (
bcdata(mm)%velx)
1900 nullify (
bcdata(mm)%vely)
1901 nullify (
bcdata(mm)%velz)
1911 deallocate (
bcdata(mm)%ptInlet, &
1914 bcdata(mm)%flowXdirInlet, &
1915 bcdata(mm)%flowYdirInlet, &
1916 bcdata(mm)%flowZdirInlet, stat=ierr)
1919 "Deallocation failure for the &
1920 &total conditions.")
1922 nullify (
bcdata(mm)%ptInlet)
1923 nullify (
bcdata(mm)%ttInlet)
1924 nullify (
bcdata(mm)%htInlet)
1925 nullify (
bcdata(mm)%flowXdirInlet)
1926 nullify (
bcdata(mm)%flowYdirInlet)
1927 nullify (
bcdata(mm)%flowZdirInlet)
1931 end select inflowtype
1962 integer(kind=intType) :: nn, mm, il, jl, kl
1969 "Memory allocation failure for solRead")
1983 iovar(nn, 1)%pointerOffset = 0
1998 iovar(nn, 1)%pointerOffset = 0
2002 iovar(nn, mm)%pointerOffset = -1
2003 iovar(nn, mm)%w =>
flowdoms(nn, 1, 1)%wOld(mm - 1, 2:, 2:, 2:, :)
2029 iovar(nn, mm)%pointerOffset = 0
2031 allocate (
iovar(nn, mm)%w(2:il, 2:jl, 2:kl,
nw), stat=ierr)
2034 "Memory allocation failure for w")
2039 else testallocsolread
2047 iovar(nn, mm)%pointerOffset = 0
2052 end if testallocsolread
2076 logical,
intent(in) :: halosRead
2080 integer(kind=intType) :: sps, nn, nHalo
2081 integer(kind=intType) :: i, j, k
2082 integer(kind=intType) :: iBeg, iEnd, jBeg, jEnd, kBeg, kEnd
2088 if (halosread) nhalo = 1
2105 ibeg = 2 - nhalo; jbeg = 2 - nhalo; kbeg = 2 - nhalo
2106 iend =
il + nhalo; jend =
jl + nhalo; kend =
kl + nhalo
2113 p(i, j, k) =
w(i, j, k,
irhoe)
2136 character(len=*),
intent(inout) :: fileName
2137 integer(kind=intType) :: i
2164 integer(kind=intType) :: nn, mm, i, j, k, l
2166 real(kind=realtype) :: tmp
2168 real(kind=realtype),
dimension(3) :: dirloc, dirglob
2172 domains:
do nn = 1, ndom
2183 w(i, j, k, l) =
winf(l)
2233 domainloop1:
do nn = 1, ndom
2251 call mpi_allreduce(dirloc, dirglob, 3, adflow_real, mpi_sum, &
2254 tmp =
one / max(
eps, sqrt(dirglob(1)**2 &
2257 dirglob(1) = tmp * dirglob(1)
2258 dirglob(2) = tmp * dirglob(2)
2259 dirglob(3) = tmp * dirglob(3)
2264 domainsloop2:
do nn = 1, ndom
2273 tmp = sqrt(
w(i, j, k,
ivx)**2 &
2274 +
w(i, j, k,
ivy)**2 &
2275 +
w(i, j, k,
ivz)**2)
2276 w(i, j, k,
ivx) = tmp * dirglob(1)
2277 w(i, j, k,
ivy) = tmp * dirglob(2)
2278 w(i, j, k,
ivz) = tmp * dirglob(3)
2284 end do spectralloopcorr
2286 end if testcorrection
2304 integer(kind=intType),
intent(in) :: mm
2306 real(kind=realtype),
intent(out) :: vmag
2307 real(kind=realtype),
dimension(3),
intent(inout) :: dir
2313 integer(kind=intType) :: i, j
2314 real(kind=realtype) :: vel
2322 if (
associated(
bcdata(mm)%velx) .and. &
2323 associated(
bcdata(mm)%vely) .and. &
2324 associated(
bcdata(mm)%velz))
then
2335 vel = sqrt(
bcdata(mm)%velx(i, j)**2 &
2336 +
bcdata(mm)%vely(i, j)**2 &
2337 +
bcdata(mm)%velz(i, j)**2)
2338 vmag = max(vmag, vel)
2342 vel =
one / max(
eps, vel)
2343 dir(1) = dir(1) + vel *
bcdata(mm)%velx(i, j)
2344 dir(2) = dir(2) + vel *
bcdata(mm)%vely(i, j)
2345 dir(3) = dir(3) + vel *
bcdata(mm)%velz(i, j)
2353 if (
associated(
bcdata(mm)%flowXdirInlet) .and. &
2354 associated(
bcdata(mm)%flowYdirInlet) .and. &
2355 associated(
bcdata(mm)%flowZdirInlet))
then
2364 dir(1) = dir(1) +
bcdata(mm)%flowXdirInlet(i, j)
2365 dir(2) = dir(2) +
bcdata(mm)%flowYdirInlet(i, j)
2366 dir(3) = dir(3) +
bcdata(mm)%flowZdirInlet(i, j)
2375 diagMatCoefSpectral)
2393 real(kind=realtype), &
2394 dimension(nSections, nTimeIntervalsSpectral - 1), &
2395 intent(out) :: coefspectral
2396 real(kind=realtype), &
2397 dimension(nSections, nTimeIntervalsSpectral - 1, 3, 3), &
2398 intent(out) :: matrixcoefspectral
2399 real(kind=realtype),
dimension(nSections, 3, 3), &
2400 intent(out) :: diagmatcoefspectral
2404 integer(kind=intType) :: pp, nn, mm, ii, i, j, ntot
2405 real(kind=realtype) :: coef, dangle, angle, fact, slicesfact
2407 real(kind=realtype),
dimension(3, 3) :: rotmat, tmp
2431 coefspectral(mm, nn) = coef / sin(angle)
2434 coefspectral(mm, nn) = coefspectral(mm, nn) * cos(angle)
2447 dangle =
pi / real(ntot, realtype)
2451 rotmat(1, 1) =
one; rotmat(1, 2) =
zero; rotmat(1, 3) =
zero
2452 rotmat(2, 1) =
zero; rotmat(2, 2) =
one; rotmat(2, 3) =
zero
2453 rotmat(3, 1) =
zero; rotmat(3, 2) =
zero; rotmat(3, 3) =
one
2461 slicesfact =
one / real(
sections(mm)%nSlices, realtype)
2471 coef =
one / sin(angle)
2473 if (mod(ntot, 2_inttype) == 0) &
2474 coef = coef * cos(angle)
2476 coef = coef * fact * slicesfact
2482 matrixcoefspectral(mm, nn, 1, 1) = coef
2483 matrixcoefspectral(mm, nn, 1, 2) =
zero
2484 matrixcoefspectral(mm, nn, 1, 3) =
zero
2486 matrixcoefspectral(mm, nn, 2, 1) =
zero
2487 matrixcoefspectral(mm, nn, 2, 2) = coef
2488 matrixcoefspectral(mm, nn, 2, 3) =
zero
2490 matrixcoefspectral(mm, nn, 3, 1) =
zero
2491 matrixcoefspectral(mm, nn, 3, 2) =
zero
2492 matrixcoefspectral(mm, nn, 3, 3) = coef
2505 diagmatcoefspectral(mm, i, j) =
zero
2514 slicesloop:
do pp = 1, (
sections(mm)%nSlices - 1)
2530 slicesfact =
one / real(
sections(mm)%nSlices, realtype)
2541 slicesfact = fact * slicesfact
2551 angle = (nn + ii) * dangle
2552 coef =
one / sin(angle)
2554 if (mod(ntot, 2_inttype) == 0) &
2555 coef = coef * cos(angle)
2557 coef = coef * fact * slicesfact
2563 matrixcoefspectral(mm, nn, i, j) = &
2564 matrixcoefspectral(mm, nn, i, j) + coef * rotmat(i, j)
2576 coef =
one / sin(angle)
2578 if (mod(ntot, 2_inttype) == 0) &
2579 coef = coef * cos(angle)
2581 coef = coef * slicesfact
2585 diagmatcoefspectral(mm, i, j) = &
2586 diagmatcoefspectral(mm, i, j) - coef * rotmat(i, j)
2599 diagmatcoefspectral(mm, i, j) = &
2600 coef * diagmatcoefspectral(mm, i, j)
2608 matrixcoefspectral(mm, nn, i, j) = &
2609 coef * matrixcoefspectral(mm, nn, i, j)
2641 integer(kind=intType) :: nn, mm, ll, kk, ii
2642 integer(kind=intType) :: i, j
2644 real(kind=realtype),
dimension(3, 3) :: tmpmat
2646 real(kind=realtype),
dimension(:, :),
allocatable :: coefspectral
2647 real(kind=realtype),
dimension(:, :, :, :),
allocatable :: &
2649 real(kind=realtype),
dimension(:, :, :),
allocatable :: &
2671 matrixcoefspectral(
nsections, kk, 3, 3), &
2672 diagmatcoefspectral(
nsections, 3, 3), stat=ierr)
2674 call terminate(
"timeSpectralMatrices", &
2675 "Memory allocation failure for the matrices of &
2676 &the spectral time derivatives.")
2682 diagmatcoefspectral)
2713 dscalar(ii, nn, ll) = coefspectral(ii, mm)
2732 dvector(ii, kk + i, kk + j) = diagmatcoefspectral(ii, i, j)
2756 tmpmat(i, j) = matrixcoefspectral(ii, mm, i, 1) &
2758 + matrixcoefspectral(ii, mm, i, 2) &
2760 + matrixcoefspectral(ii, mm, i, 3) &
2772 tmpmat(i, j) = matrixcoefspectral(ii, mm, i, j)
2784 dvector(ii, kk + i, ll + j) = tmpmat(i, j)
2795 deallocate (coefspectral, matrixcoefspectral, &
2796 diagmatcoefspectral, stat=ierr)
2798 call terminate(
"timeSpectralMatrices", &
2799 "Deallocation failure for the help variables.")
2830 integer :: nzones, celldim, physdim, ierr, nsols
2832 integer(cgsize_t),
dimension(9) :: sizes
2833 integer,
dimension(9) :: rindsizes
2834 integer,
dimension(nSolsRead) :: fileids
2836 integer(kind=intType) :: ii, jj, nn
2837 integer(kind=intType) :: ntypemismatch
2838 integer(kind=intType) :: nhimin, nhjmin, nhkmin
2839 integer(kind=intType) :: nhimax, nhjmax, nhkmax
2841 character(len=7) :: integerstring
2842 character(len=maxCGNSNameLen) :: cgnsname
2843 character(len=2*maxStringLen) :: errormessage
2862 if (ierr /= all_ok)
then
2864 " could not be opened for reading"
2865 call terminate(
"readRestartFile", errormessage)
2874 if (ierr /= all_ok) &
2876 "Something wrong when calling cg_nbases_f")
2879 write (errormessage, *)
"CGNS file ", trim(
solfiles(
solid)), &
2880 " does not contain a base"
2881 call terminate(
"readRestartFile", errormessage)
2894 if (ierr /= all_ok) &
2896 "Something wrong when calling cg_base_read_f")
2901 if (celldim /= 3 .or. physdim /= 3)
then
2902 write (errormessage,
stringint1)
"Both the number of cell and physical dimensions should be 3, not ", &
2903 celldim,
" and ", physdim
2904 call terminate(
"readRestartFile", errormessage)
2936 if (ierr /= all_ok) &
2938 "Something wrong when calling cg_nzones_f")
2942 "Number of blocks in grid file and restart &
2952 domains:
do nn = 1, ndom
2970 write (errormessage, *)
"Zone name ", trim(cgnsname), &
2971 " not found in restart file ", &
2973 call terminate(
"readRestartFile", errormessage)
2984 cgnsname, sizes, ierr)
2985 if (ierr /= all_ok) &
2987 "Something wrong when calling &
2994 "Corresponding zones in restart file and &
2995 &grid file have different dimensions")
3001 if (ierr /= all_ok) &
3003 "Something wrong when calling cg_nsols_f")
3007 "No solution present in restart file")
3013 if ((nsols > 1) .or. nsols > 2) &
3015 "Multiple solutions present in restart file")
3024 if (ierr /= all_ok) &
3026 "Something wrong when calling &
3029 if (trim(cgnsname) /=
"Nodal Blanks")
exit
3036 if (ierr /= all_ok) &
3038 "Something wrong when calling cg_goto_f")
3040 call cg_rind_read_f(rindsizes, ierr)
3041 if (ierr /= all_ok) &
3043 "Something wrong when calling &
3051 if (rindsizes(1) == 0 .or. rindsizes(2) == 0 .or. rindsizes(3) == 0 .or. &
3052 rindsizes(4) == 0 .or. rindsizes(5) == 0 .or. rindsizes(6) == 0) &
3058 nhimin = 0; nhjmin = 0; nhkmin = 0
3059 nhimax = 0; nhjmax = 0; nhkmax = 0
3085 if (rindsizes(1) > 0) nhimin = 1;
if (rindsizes(2) > 0) nhimax = 1
3086 if (rindsizes(3) > 0) nhjmin = 1;
if (rindsizes(4) > 0) nhjmax = 1
3087 if (rindsizes(5) > 0) nhkmin = 1;
if (rindsizes(6) > 0) nhkmax = 1
3118 "Only CellCenter or Vertex data allowed in &
3126 allocate (
buffer(2 - nhimin:
il + nhimax, &
3127 2 - nhjmin:
jl + nhjmax, &
3128 2 - nhkmin:
kl + nhkmax), stat=ierr)
3131 "Memory allocation failure for buffer")
3137 "Memory allocation failure for bufferVertex")
3179 "Deallocation error for buffer, varNames &
3188 "Deallocation error for bufferVertex")
3198 "Deallocation failure for zoneNames &
3203 call cg_close_f(
cgnsind, ierr)
3204 if (ierr /= all_ok) &
3206 "Something wrong when calling cg_close_f")
3215 call mpi_reduce(ntypemismatch, ii, 1, adflow_integer, &
3217 if (
myid == 0 .and. ii > 0)
then
3219 write (integerstring,
"(i6)") ii
3220 integerstring = adjustl(integerstring)
3223 print
"(a)",
"# Warning"
3224 print
strings,
"# ", trim(integerstring),
" type mismatches occured when reading the solution of the blocks"
3253 integer :: zone, zonetype, ncoords, pathlength
3256 integer(kind=cgsize_t),
dimension(9) :: sizesblock
3258 integer(kind=intType) :: nn, ii
3260 character(len=maxStringLen) :: errormessage, linkpath
3261 character(len=maxCGNSNameLen),
dimension(cgnsNdom) :: tmpnames
3263 logical :: namefound
3265 character(len=7) :: int1string, int2string
3271 call terminate(
"getSortedZoneNumbers", &
3272 "Memory allocation failure for zoneNames &
3287 if (ierr /= all_ok) &
3288 call terminate(
"getSortedZoneNumbers", &
3289 "Something wrong when calling cg_zone_type_f")
3291 if (zonetype /= structured)
then
3293 write (int1string,
"(i7)")
cgnsbase
3294 int1string = adjustl(int1string)
3295 write (int2string,
"(i7)") zone
3296 int2string = adjustl(int2string)
3298 write (errormessage,
strings)
"Base ", trim(int1string),
": Zone ", trim(int2string), &
3299 " of the cgns restart file is not structured"
3300 call terminate(
"getSortedZoneNumbers", errormessage)
3307 if (ierr /= all_ok) &
3308 call terminate(
"getSortedZoneNumbers", &
3309 "Something wrong when calling cg_ncoords_f")
3314 if (ncoords == 3)
then
3319 "GridCoordinates_t", 1,
"end")
3320 if (ierr /= all_ok) &
3321 call terminate(
"getSortedZoneNumbers", &
3322 "Something wrong when calling cg_goto_f")
3326 call cg_is_link_f(pathlength, ierr)
3327 if (ierr /= all_ok) &
3328 call terminate(
"getSortedZoneNumbers", &
3329 "Something wrong when calling cg_is_link_f")
3331 if (pathlength > 0)
then
3335 call cg_link_read_f(errormessage, linkpath, ierr)
3336 if (ierr /= all_ok) &
3337 call terminate(
"getSortedZoneNumbers", &
3338 "Something wrong when calling &
3344 pos = index(linkpath,
"/", .true.)
3346 linkpath = linkpath(:pos - 1)
3351 pos = index(linkpath,
"/", .true.)
3352 if (pos > 0) linkpath = linkpath(pos + 1:)
3357 linkpath = adjustl(linkpath)
3367 if (.not. namefound)
then
3370 if (ierr /= all_ok) &
3371 call terminate(
"getSortedZoneNumbers", &
3372 "Something wrong when calling &
3405 call terminate(
"getSortedZoneNumbers", &
3406 "Error occurs only when two identical zone &
3407 &names are present")
3436 integer,
dimension(:),
allocatable :: tmptypes
3438 integer(kind=intType) :: nn, ii
3440 integer(kind=intType),
dimension(:),
allocatable :: varnumbers
3442 character(len=maxCGNSNameLen),
allocatable,
dimension(:) :: &
3449 if (ierr /= all_ok) &
3451 "Something wrong when calling cg_nfield_f")
3459 "Memory allocation failure for varNames, etc.")
3469 "Something wrong when calling cg_field_info_f")
3475 allocate (tmptypes(
nvar), tmpnames(
nvar), stat=ierr)
3478 "Memory allocation failure for tmp variables")
3506 if (varnumbers(ii) /= -1) &
3508 "Error occurs only when two identical &
3509 &variable names are present")
3519 deallocate (varnumbers, tmptypes, tmpnames, stat=ierr)
3522 "Deallocation error for tmp variables")
subroutine setbcdatacoarsegrid
subroutine setbcdatafinegrid(initializationPart)
subroutine applyallbc_block(secondHalo)
subroutine applyallbc(secondHalo)
integer(kind=inttype) ndom
type(blocktype), dimension(:, :, :), allocatable, target flowdoms
integer(kind=inttype) kbegor
real(kind=realtype), dimension(:, :, :), pointer p
real(kind=realtype), dimension(:, :, :, :), pointer w
real(kind=realtype), dimension(:, :, :), pointer d2wall
integer(kind=inttype) nbkglobal
real(kind=realtype), dimension(:, :, :), pointer rlv
integer(kind=inttype) ibegor
integer(kind=inttype) nbocos
integer(kind=inttype) sectionid
integer(kind=inttype) jbegor
real(kind=realtype), dimension(:, :, :), pointer rev
integer(kind=inttype), dimension(:), pointer bctype
real(kind=realtype), dimension(:, :, :, :), pointer dw
real(kind=realtype), dimension(:, :, :, :), pointer fw
type(cgnsblockinfotype), dimension(:), allocatable cgnsdoms
integer(kind=inttype) cgnsndom
integer adflow_comm_world
integer(kind=inttype), parameter spalartallmarasedwards
integer(kind=inttype), parameter spalartallmaras
real(kind=realtype), parameter zero
integer(kind=inttype), parameter coupled
real(kind=realtype), parameter third
real(kind=realtype), parameter pi
real(kind=realtype), parameter eps
integer(kind=inttype), parameter ktau
integer(kind=inttype), parameter md
integer(kind=inttype), parameter komegawilcox
integer(kind=inttype), parameter timespectral
integer(kind=inttype), parameter komegamodified
integer(kind=inttype), parameter unsteady
integer(kind=inttype), parameter bdf
integer(kind=inttype), parameter totalconditions
real(kind=realtype), parameter one
integer, parameter maxstringlen
integer(kind=inttype), parameter steady
real(kind=realtype), parameter two
integer(kind=inttype), parameter explicitrk
integer(kind=inttype), parameter massflow
integer(kind=inttype), parameter mentersst
integer(kind=inttype), parameter subsonicinflow
integer(kind=inttype), parameter ransequations
integer(kind=inttype), parameter internalflow
integer(kind=inttype), parameter v2f
subroutine computelamviscosity(includeHalos)
subroutine adjustinflowangle()
subroutine computeetotblock(iStart, iEnd, jStart, jEnd, kStart, kEnd, correctForK)
subroutine computegamma(T, gamma, mm)
subroutine etot(rho, u, v, w, p, k, etotal, correctForK)
real(kind=realtype) rhoinfdim
real(kind=realtype) muinfdim
real(kind=realtype) gammainf
integer(kind=inttype) nt1
real(kind=realtype) pinfdim
real(kind=realtype) pinfcorr
real(kind=realtype) muref
real(kind=realtype) tinfdim
real(kind=realtype) rhoref
integer(kind=inttype) nwf
real(kind=realtype), dimension(:), allocatable winf
real(kind=realtype) muinf
real(kind=realtype) rhoinf
real(kind=realtype) timeref
integer(kind=inttype) nt2
subroutine whalo2(level, start, end, commPressure, commGamma, commViscous)
subroutine allocmemflovarpart2(sps, level)
subroutine infchangecorrection(oldWinf, correctionTol, correctionType)
subroutine getsortedvarnumbers
subroutine updatebcdataalllevels
subroutine setpressureandcomputeenergy(halosRead)
subroutine allocmemflovarpart1(sps, level)
subroutine determinesolfilenames
subroutine velmagnanddirectionsubface(vmag, dir, BCData, mm)
subroutine setrestartfiles(fileName, i)
subroutine initdepvarandhalos(halosRead)
subroutine setsolfilenames
subroutine interpolatespectralsolution
subroutine copyspectralsolution
subroutine setuniformflow
subroutine checksolfilenames
subroutine getsortedzonenumbers
subroutine timespectralcoef(coefSpectral, matrixCoefSpectral, diagMatCoefSpectral)
subroutine initializehalos(halosRead)
subroutine timespectralmatrices
subroutine referencestate
subroutine releaseextramembcs
subroutine initflowrestart
subroutine allocrestartfiles(nFiles)
subroutine readrestartfile()
type(iotype), dimension(:, :), allocatable iovar
integer(kind=inttype) noldlevels
integer(kind=inttype) currentlevel
integer(kind=inttype) groundlevel
integer(kind=inttype) nalesteps
logical, dimension(:), allocatable oldsolwritten
integer(kind=inttype) noldsolavail
real(kind=realtype) timeunsteadyrestart
integer(kind=inttype) ntimestepsrestart
integer(kind=inttype) nsections
type(sectiontype), dimension(:), allocatable sections
subroutine gridvelocitiescoarselevels(sps)
subroutine slipvelocitiesfinelevel(useOldCoor, t, sps)
subroutine slipvelocitiescoarselevels(sps)
subroutine normalvelocitiesalllevels(sps)
subroutine gridvelocitiesfinelevel(useOldCoor, t, sps)
integer(kind=inttype) function bsearchstrings(key, base)
subroutine qsortstrings(arr, nn)
subroutine bcturbtreatment
subroutine applyallturbbc(secondHalo)
subroutine applyallturbbcthisblock(secondHalo)
real(kind=realtype) function sanuknowneddyratio(eddyRatio, nuLam)
subroutine computeeddyviscosity(includeHalos)
subroutine alloctimearrays(nTimeTot)
subroutine rotmatrixrigidbody(tNew, tOld, rotationMatrix, rotationPoint)
real(kind=realtype) function mynorm2(x)
subroutine spectralinterpolcoef(nsps, t, alpScal, alpMat)
subroutine setpointers(nn, mm, ll)
subroutine allocconvarrays(nIterTot)
subroutine getrotmatrix(vec1, vec2, rotMat)
subroutine terminate(routineName, errorMessage)
real(kind=cgnsrealtype), dimension(:, :, :), allocatable buffer
subroutine readymomentum(nTypeMismatch)
integer(kind=inttype) nsolsread
subroutine readyvelocity(nTypeMismatch)
integer(kind=inttype) solid
subroutine readturbvar(nTypeMismatch)
integer, dimension(:), allocatable vartypes
subroutine readzvelocity(nTypeMismatch)
integer(kind=inttype), dimension(:), allocatable zonenumbers
real(kind=cgnsrealtype), dimension(:, :, :), allocatable buffervertex
subroutine readdensity(nTypeMismatch)
subroutine readzmomentum(nTypeMismatch)
character(len=maxstringlen), dimension(:), allocatable solfiles
subroutine readxvelocity(nTypeMismatch)
subroutine readpressure(nTypeMismatch)
subroutine readenergy(nTypeMismatch)
character(len=maxcgnsnamelen), dimension(:), allocatable zonenames
subroutine readxmomentum(nTypeMismatch)
integer(kind=cgsize_t), dimension(3) rangemax
character(len=maxcgnsnamelen), dimension(:), allocatable varnames
integer(kind=cgsize_t), dimension(3) rangemin
subroutine scalefactors(fileIDs)