module diagnostics_arrays ! ! (c) Copyright 1991 to 1998 by Michael A. Beer, William D. Dorland, ! P. B. Snyder, Q. P. Liu, and Gregory W. Hammett. ALL RIGHTS RESERVED. ! implicit none save real, dimension(:), allocatable :: timo, gamx, wrhx, wrhy, & fluxe, qfluxe, pcerr, wxsp, wakx, waky, wenx, wlux, & wdpx, wdvx, timf, upol, utor, phirms complex, dimension(:), allocatable :: phih0, uparh0, denh0, & tparh0, tperph0, qparh0, qperph0, veh0, uparph0 real, dimension(:,:), allocatable :: wpfx, fluxi, phisqold real, dimension(:,:,:), allocatable :: grtmx, wkif, wpif, wtif, psp, phisq real, dimension(:,:,:), allocatable :: mgamx ! finite beta variables real, dimension(:), allocatable :: nesq, uesq, asq real :: wenr, wenr1, dtold, drive real :: pwenr=0.0 ! this isn't quite right for restarts ! i.e., a single long run compared with two shorter runs (with a restart) ! may give different answers temporarily at the restart time. But this ! will only affect a few diagnostics, I believe. ! ion particle and heat flux for each mode: real, dimension(:,:,:,:), allocatable :: fluximn, qfluximn ! electron particle and heat flux for each mode: real, dimension(:,:,:), allocatable :: fluxemn, qfluxemn ! correlation function variables real, dimension(:,:), allocatable :: cx, cy, cz, czc, czcn, czn, cznn complex, dimension(:,:), allocatable :: phi00, den00, upar00, tpar00, tperp00 complex, dimension(:,:), allocatable :: n_e00, u_e00, apar00, tpar_e00, tperp_e00 real, dimension(:), allocatable :: ct real, dimension(:,:), allocatable :: drt real, dimension(:,:,:), allocatable :: wenrk, dketa, dkpar, dktor, dktdp, wkups, dktot complex, dimension(:,:,:), allocatable :: utim integer :: mplot2, nplot2 ! (m,n) mode number to make plots for character*30 date contains subroutine alloc_diagnostics(ntz, ncntz) use itg_data, only: nspecies, beta_e, epse use gryffin_layouts use gryffin_grid, only: ld, md, nd integer, intent (in) :: ntz, ncntz ! ! Allocate arrays that have a time index ! allocate (timo(ntz), gamx(ntz), wrhx(ntz), wrhy(ntz), fluxe(ntz), qfluxe(ntz), & pcerr(ntz), wxsp(ntz), wakx(ntz), waky(ntz), wenx(ntz), wlux(ntz), & wdpx(ntz), wdvx(ntz), upol(ntz),utor(ntz),phirms(ntz)) timo = 0.; gamx = 0.; wrhx = 0.; wrhy = 0.; fluxe = 0.; qfluxe = 0. pcerr = 0.; wxsp = 0.; wakx = 0.; waky = 0.; wenx = 0.; wlux = 0. wdpx = 0.; wdvx = 0.; upol = 0.; utor = 0.; phirms = 0. allocate (phih0(ntz),uparh0(ntz),denh0(ntz),tparh0(ntz),tperph0(ntz), & qparh0(ntz),qperph0(ntz),veh0(ntz),uparph0(ntz)) phih0 = 0.; uparh0 = 0.; denh0 = 0.; tparh0 = 0.; tperph0 = 0. qparh0 = 0.; qperph0 = 0.; veh0 = 0.; uparph0 = 0. allocate (wpfx(ntz, nspecies), fluxi(ntz, nspecies)) wpfx = 0.; fluxi = 0. allocate (grtmx(ntz, m_low:m_alloc, n_low:n_alloc), & wkif(ntz, m_low:m_alloc, n_low:n_alloc), & wpif(ntz, m_low:m_alloc, n_low:n_alloc), & wtif(ntz, m_low:m_alloc, n_low:n_alloc), & psp(ntz, m_low:m_alloc, n_low:n_alloc), & phisq(ntz, m_low:m_alloc, n_low:n_alloc), & phisqold(m_low:m_alloc, n_low:n_alloc)) grtmx = 0.; wkif = 0.; wpif = 0. wtif = 0.; psp = 0.; phisq = 0.; phisqold = 0. allocate (mgamx(m_low:m_alloc, n_low:n_alloc, ntz)) mgamx = 0. allocate (fluximn(ntz, m_low:m_alloc, n_low:n_alloc, nspecies), & qfluximn(ntz, m_low:m_alloc, n_low:n_alloc, nspecies)) fluximn = 0.; qfluximn = 0. if(epse > 0 .or. beta_e > 0.) then allocate (fluxemn(ntz, m_low:m_alloc, n_low:n_alloc), & qfluxemn(ntz, m_low:m_alloc, n_low:n_alloc)) fluxemn = 0.; qfluxemn = 0. endif if (beta_e > 0.) then allocate (nesq(ntz)) allocate (uesq(ntz)) allocate (asq(ntz)) nesq = 0.; uesq = 0.; asq = 0. endif allocate (n_e00(ntz, nd)) allocate (u_e00(ntz, nd)) allocate (apar00(ntz, nd)) allocate (tpar_e00(ntz, nd)) allocate (tperp_e00(ntz, nd)) n_e00 = 0. u_e00 = 0. apar00 = 0. tpar_e00 = 0. tperp_e00 = 0. ! Correlation functions not actually calculated in parallel code yet. allocate (cx(ntz, 4*nd), cy(ntz, 4*md), cz(ntz, ld), czc(ntz, ld), czcn(ntz, ld), & czn(ntz, ld), cznn(ntz, ld)) cx = 0.; cy = 0.; cz = 0.; czc = 0.; czcn = 0.; czn = 0.; cznn = 0. allocate (phi00(ntz, nd), den00(ntz, nd), upar00(ntz, nd), tpar00(ntz, nd), tperp00(ntz, nd)) phi00 = 0.; den00 = 0.; upar00 = 0.; tpar00 = 0.; tperp00 = 0. allocate (ct(ntz)) ct = 0. allocate (drt(14, ntz)) drt = 0. allocate (wenrk(ntz, m_low:m_alloc, n_low:n_alloc), & dketa(ntz, m_low:m_alloc, n_low:n_alloc), & dkpar(ntz, m_low:m_alloc, n_low:n_alloc), & dktor(ntz, m_low:m_alloc, n_low:n_alloc), & dktdp(ntz, m_low:m_alloc, n_low:n_alloc), & wkups(ntz, m_low:m_alloc, n_low:n_alloc), & dktot(ntz, m_low:m_alloc, n_low:n_alloc)) wenrk = 0.; dketa = 0.; dkpar = 0.; dktor = 0.; dktdp = 0.; wkups = 0.; dktot = 0. allocate (timf(ncntz), utim(ncntz, m_low:m_alloc, n_low:n_alloc)) timf = 0.; utim = .0 end subroutine alloc_diagnostics end module diagnostics_arrays