diff --git a/src/convert/b2co_movies_cdf.F b/src/convert/b2co_movies_cdf.F index 3004d0ac0..c65631954 100644 --- a/src/convert/b2co_movies_cdf.F +++ b/src/convert/b2co_movies_cdf.F @@ -33,6 +33,7 @@ subroutine b2co_movies_cdf(nx, ny, ns, natm, nmol, ntri, tim) integer, save :: write_b25_state_variables = 1 integer, save :: write_b25_fluxes = 0 integer, save :: write_b25_sources = 0 + integer, save :: write_b25_transport = 0 integer, save :: write_eirene_state_variables = 0 integer, save :: write_eirene_fluxes = 0 integer, save :: write_eirene_sources = 0 @@ -43,6 +44,7 @@ subroutine b2co_movies_cdf(nx, ny, ns, natm, nmol, ntri, tim) 1 write_b25_state_variables) call ipgeti ('cdfmovie_b25_fluxes', write_b25_fluxes) call ipgeti ('cdfmovie_b25_sources', write_b25_sources) + call ipgeti ('cdfmovie_b25_transport', write_b25_transport) call ipgeti ('cdfmovie_eirene_state_variables', 1 write_eirene_state_variables) call ipgeti ('cdfmovie_eirene_fluxes', write_eirene_fluxes) @@ -167,6 +169,8 @@ subroutine b2co_movies_cdf(nx, ny, ns, natm, nmol, ntri, tim) 1 'Ion density', 'm^-3') call create_cdf_field2(ncid2, 'ne', 1 'Electron density', 'm^-3') + call create_cdf_field3(ncid2, 'ua', 1, + 1 'Ion parallel velocity', 'm s^-1') call create_cdf_field2(ncid2, 'te', 1 'Electron temperature', 'eV') call create_cdf_field2(ncid2, 'ti', @@ -221,6 +225,22 @@ subroutine b2co_movies_cdf(nx, ny, ns, natm, nmol, ntri, tim) 1 'Volumetric line radiation rate', 'W m^-3') call create_cdf_field2(ncid2, 'rqradsum', 1 'Total volumetric line radiation rate', 'W m^-3') + endif + if (write_b25_transport.ge.1) then + call create_cdf_field3(ncid2, 'dna', 1, + 1 'Particle density-driven diffusivity', 'm^-2 s^-1') + call create_cdf_field3(ncid2, 'dpa', 1, + 1 'Particle pressure-driven diffusivity', 'm^-2 s^-1') + call create_cdf_field2(ncid2, 'hci', + 1 'Ion thermal anomalous diffusivity', 'm^-2 s^-1') + call create_cdf_field2(ncid2, 'hce', + 1 'Electron thermal anomalous diffusivity', 'm^-2 s^-1') + call create_cdf_field3(ncid2, 'vlax', 1, + 1 'Poloidal anomalous pinch velocity', 'm s^-1') + call create_cdf_field3(ncid2, 'vlay', 1, + 1 'Radial anomalous pinch velocity', 'm s^-1') + call create_cdf_field3(ncid2, 'vsa', 1, + 1 'Anomalous viscosity', 'm kg^-1 s^-1') endif if (write_eirene_state_variables.ge.1) then if(natm.gt.0) then diff --git a/src/convert/b2co_time_cdf.F b/src/convert/b2co_time_cdf.F index 58dcf1ded..b508126cb 100644 --- a/src/convert/b2co_time_cdf.F +++ b/src/convert/b2co_time_cdf.F @@ -1,4 +1,5 @@ - subroutine b2co_time_cdf(nx, ny, ns, tim, batch_only) + subroutine b2co_time_cdf(nx, ny, ns, nnatmi, nnmoli, tim, + . batch_only) use b2mod_types use b2mod_geo use b2mod_mwti @@ -9,7 +10,7 @@ subroutine b2co_time_cdf(nx, ny, ns, tim, batch_only) #ifndef NO_CDF # include #endif - integer nx, ny, ns + integer :: nx, ny, ns, nnatmi, nnmoli real (kind=R8) :: tim logical :: batch_only integer :: jxi, jxa, jsep @@ -33,6 +34,8 @@ subroutine b2co_time_cdf(nx, ny, ns, tim, batch_only) 3 start(NF_MAX_VAR_DIMS), count(NF_MAX_VAR_DIMS) real (kind=R8) :: scale real (kind=R8), allocatable :: data1(:), data2(:,:), data3(:,:,:) + real (kind=R8) :: dsl(-1:ny), dsi(-1:ny), dsa(-1:ny), + 1 dsr(-1:ny), dstl(-1:ny), dstr(-1:ny) character*(NF_MAX_NAME) :: varname, dimname, attname character :: units*(24) character*4 :: extension @@ -49,10 +52,12 @@ subroutine b2co_time_cdf(nx, ny, ns, tim, batch_only) call ipgeti ('b2mwti_2dwrite', write_2d) call ipgeti ('b2mndt_av_ntim_batch', ntim_batch) call ipgeti ('b2mwti_target_offset', target_offset) - call output_ds(ny, -1,+target_offset,jsep,iylstrt,iylend,'dsl') - call output_ds(ny,jxi,0,jsep,iyistrt,iyiend,'dsi') - call output_ds(ny,jxa,0,jsep,iyastrt,iyaend,'dsa') - call output_ds(ny, nx,-target_offset,jsep,iyrstrt,iyrend,'dsr') + call output_ds(ny, -1,+target_offset,jsep,iylstrt,iylend, + . 'dsl',dsl) + call output_ds(ny,jxi,0,jsep,iyistrt,iyiend,'dsi',dsi) + call output_ds(ny,jxa,0,jsep,iyastrt,iyaend,'dsa',dsa) + call output_ds(ny, nx,-target_offset,jsep,iyrstrt,iyrend, + . 'dsr',dsr) call xertst (0.lt.ns, 'faulty argument ns') #ifndef NO_CDF if (nnreg(0).ge.7) then @@ -67,9 +72,9 @@ subroutine b2co_time_cdf(nx, ny, ns, tim, batch_only) ixtr=ixtr+1 enddo call output_ds(ny,ixtl,-target_offset,jsep, - . iytlstrt,iytlend,'dstl') + . iytlstrt,iytlend,'dstl',dstl) call output_ds(ny,ixtr,+target_offset,jsep, - . iytrstrt,iytrend,'dstr') + . iytrstrt,iytrend,'dstr',dstr) nytl = iytlend - iytlstrt + 1 nytr = iytrend - iytrstrt + 1 else @@ -222,8 +227,8 @@ subroutine b2co_time_cdf(nx, ny, ns, tim, batch_only) status=nf_create(trim(filename),NF_NOCLOBBER,ncid2) call check_cdf_status(status) call b2crtimecdf(filename, nx, ny, nybl, nytl, nytr, nybr, - . nya, nyi, nc, ns, write_2d, ncid2, - . batch_only, iret) + . nya, nyi, nc, ns, nnatmi, nnmoli, write_2d, + . ncid2, batch_only, iret) status=nf_open(trim(filename),NF_WRITE,ncid2) call check_cdf_status(status) diff --git a/src/documentation/b2input.xml b/src/documentation/b2input.xml index e68770243..62446474e 100644 --- a/src/documentation/b2input.xml +++ b/src/documentation/b2input.xml @@ -2821,14 +2821,93 @@ 3 integer - ..set the contribution ic in NEOART - 0 --- classical particle flux - 1 --- banana plateau contribution - 2 --- Pfirsch-Schlueter contribution - 3 --- both banana and PS - 4 --- all contributions - mind that B2.5 already calculates the classical transport ! - avoid double transport, 0+4 for cross-checks only ! + This switch controls the type of neoclassical component calculated by NEOART and added to the B2.5 transport coefficients, if b2tqna_user_transport.eq.8. + If neoclassical_ic.eq.0, then only the classical component of the neoclassical transport coefficients is added. + If neoclassical_ic.eq.1, then only the banana-plateau component of the neoclassical transport coefficients is added. + If neoclassical_ic.eq.2, then only the Pfirsch-Schlueter component of the neoclassical transport coefficients is added. + If neoclassical_ic.eq.3, then both banana-plateau and Pfirsch-Schlueter components of the neoclassical transport coefficients are added. + If neoclassical_ic.eq.4, then all components of the neoclassical transport coefficients are added. + B2.5 already consistently calculates the classical transport components, therefore the options 0 and 4 should only used for testing or cross-checks. Additionally, if facdrift.eq.1, also the Pfirsch-Schlueter fluxes are already self-consistently calculated, therefore using the options 2 and 3 should be avoided as well. + + + + b2tqna_neoclassical_time_steps + 1 + integer + + Specifies the number of timesteps between successive recalculations of the neoclassical transport coefficients by NEOART, if b2tqna_user_transport.eq.8. + + + + b2tqna_neoclassical_iystart + See description (integer) + integer + + Radial cell index, on the basis mesh, defining the first poloidal ring of the region in which the neoclassical coefficients are added to the B2.5 transport coefficients, if b2tqna_user_transport.eq.8. By default equal to -1. In any case the neoclassical coefficients are only added if the poloidal ring belongs to the closed flux region. + + + + b2tqna_neoclassical_iyend + See description (integer) + integer + + Radial cell index, on the basis mesh, defining the last poloidal ring of the region in which the neoclassical coefficients are added to the B2.5 transport coefficients, if b2tqna_user_transport.eq.8. By default equal to jsep. In any case the neoclassical coefficients are only added if the poloidal ring belongs to the closed flux region. + + + + b2tqna_neoclassical_dna + 1 + integer + + If neoclassical_dna.eq.1 the neoclassical transport component calculated by NEOART is added to the particle diffusivity, if b2tqna_user_transport.eq.8. + + + + b2tqna_neoclassical_vla + 1 + integer + + If neoclassical_vla.eq.1 the neoclassical transport component calculated by NEOART is added to the radial convective velocity, if b2tqna_user_transport.eq.8. + + + + b2tqna_neoclassical_hci + 1 + integer + + If neoclassical_hci.eq.1 the neoclassical transport component calculated by NEOART is added to the ion thermal conductivity, if b2tqna_user_transport.eq.8. + + + + b2tqna_neoclassical_hvi + 1 + integer + + If neoclassical_hvi.eq.1 the neoclassical transport component calculated by NEOART is added to the radial ion thermal strange velocity, if b2tqna_user_transport.eq.8. + + + + b2tqna_neoclassical_hce + 1 + integer + + If neoclassical_hce.eq.1 the neoclassical transport component calculated by NEOART is added to the electron thermal conductivity, if b2tqna_user_transport.eq.8. + + + + b2tqna_neoclassical_hve + 1 + integer + + If neoclassical_hve.eq.1 the neoclassical transport component calculated by NEOART is added to the radial electron thermal strange velocity, if b2tqna_user_transport.eq.8. + + + + b2tqna_neoclassical_output + 0 + integer + + If neoclassical_output.eq.1 the neoclassical transport coefficients calculated by NEOART at all time steps at which it is called are outputted to the b2neo.nc file, if b2tqna_user_transport.eq.8. @@ -2929,6 +3008,14 @@ Controls the quantities outputted to b2movies.nc. If cdfmovie_b25_sources.ge.1 then the sources calculated by B2.5 (i.e. by atomic processes, electron cooling and line radiation) over the B2.5 grid are outputted. + + cdfmovie_b25_transport + 0 + integer + + Controls the quantities outputted to b2movies.nc. If cdfmovie_b25_transport.ge.1 then the anomalous transport coefficients over the B2.5 grid are outputted. + + cdfmovie_eirene_state_variables 0 @@ -7263,28 +7350,109 @@ - ELM_TIME_BEGIN + ELM_TIME_PERIOD 0.0 real - Time (in seconds) modulo ELM_TIME_PERIOD at which the ELM phase begins and the ELM data must be used. + Indicates the real period (in seconds) of simulated ELMs. If zero, no ELM profiles are used. + + + + ELM_DYNAMICS_MULTIPLE + .false. + logical + + If .true., different dynamics for the ELM phases to each of the 9 types of transport coefficients. + + + + ELM_TIME_BEGIN + 0.0 + real array of size 9 + + Times (in seconds) modulo ELM_TIME_PERIOD at which the overall ELM phase begins (i.e. the transport coefficients + start to ramp up from the TDATA(2,ir,ik,is) values to the TDATA(3,ir,ik,is) values). + If ELM_DYNAMICS_MULTIPLE is .false. then the first value is applied to all the 9 types of transport coefficients. + If ELM_DYNAMICS_MULTIPLE is .true. then different values are applied to the 9 types of transport coefficients. + + + + ELM_TIME_PLATEAU + 0.0 + real array of size 9 + + Times (in seconds) modulo ELM_TIME_PERIOD at which the ELM phase reaches its plateau (i.e. the transport coefficients + start keeping constant values equal to the TDATA(3,ir,ik,is)). + If ELM_DYNAMICS_MULTIPLE is .false. then the first value is applied to all the 9 types of transport coefficients. + If ELM_DYNAMICS_MULTIPLE is .true. then different values are applied to the 9 types of transport coefficients. + + + + ELM_TIME_RECOVERY + 0.0 + real array of size 9 + + Times (in seconds) modulo ELM_TIME_PERIOD at which the ELM plateau phase ends (i.e. the transport coefficients + start to ramp down from the TDATA(3,ir,ik,is) values to the TDATA(2,ir,ik,is) values). + If ELM_DYNAMICS_MULTIPLE is .false. then the first value is applied to all the 9 types of transport coefficients. + If ELM_DYNAMICS_MULTIPLE is .true. then different values are applied to the 9 types of transport coefficients. ELM_TIME_END 0.0 - real + real array of size 9 - Time (in seconds) modulo ELM_TIME_PERIOD at which the ELM phase ends and the ELM data is no longer used. + Times (in seconds) modulo ELM_TIME_PERIOD at which the overall ELM phase ends (i.e. the transport coefficients + start again keeping costant values equal to the TDATA(2,ir,ik,is)). + If ELM_DYNAMICS_MULTIPLE is .false. then the first value is applied to all the 9 types of transport coefficients. + If ELM_DYNAMICS_MULTIPLE is .true. then different values are applied to the 9 types of transport coefficients. - ELM_TIME_PERIOD + ELM_CRASH_FACTOR + 1.0E-10 + real array of size 9 + + Factor describing the logarithmic increase of the transport coefficients from the TDATA(2,ir,ik,is) values + to the TDATA(3,ir,ik,is) values during the ELM crash phase. By default (very low values) the increase is linear in time. + For higher values, the increase is faster at the beginning and slower towards the end of the crash phase. + If ELM_DYNAMICS_MULTIPLE is .false. then the first value is applied to all the 9 types of transport coefficients. + If ELM_DYNAMICS_MULTIPLE is .true. then different values are applied to the 9 types of transport coefficients. + + + + ELM_RECOVERY_FACTOR + 1.0E-10 + real array of size 9 + + Factor describing the exponential decrease of the transport coefficients from the TDATA(3,ir,ik,is) values + to the TDATA(2,ir,ik,is) values during the ELM recovery phase. By default (very low values) the decrease is linear in time. + For higher values, the decrease is faster at the beginning and slower towards the end of the recovery phase. + If ELM_DYNAMICS_MULTIPLE is .false. then the first value is applied to all the 9 types of transport coefficients. + If ELM_DYNAMICS_MULTIPLE is .true. then different values are applied to the 9 types of transport coefficients. + + + + ELM_BALLOONING_EXP 0.0 - real + real array of size 9 - Indicates the real frequency of simulated ELMs. See above for usage. - If zero, no ELM profiles are used. + Exponent of a ballooning-type cosine distribution describing a poloidal dependence of the ELM profiles, with + peaking at the poloidal location with index ELM_IXREF to the TDATA(3,ir,ik,is) values. + Higher values mean stronger peaking. If equal to 0.0, then the ELM profiles are poloidally constant, in the region + limited by ELM_IX_BEGIN and ELM_IX_END, and given by the TDATA(3,ir,ik,is) values. + If ELM_DYNAMICS_MULTIPLE is .false. then the first value is applied to all the 9 types of transport coefficients. + If ELM_DYNAMICS_MULTIPLE is .true. then different values are applied to the 9 types of transport coefficients. + + + + ELM_IXREF + jxa + integer + + Poloidal index of the location where the ELM profiles peak to the TDATA(3,ir,ik,is) values, according to a + ballooning-type cosine distribution with exponent ELM_BALLOONING_EXP. @@ -8297,6 +8465,23 @@ + + + NEOCLASSICAL_TRANSPORT + + Read if 'b2tqna_user_transport' is set to 8. + Used to set the calculation of neoclassical transport coefficients for specific species. + + + + NEO_NS_SET + .true. + logical array of size(0:NS-1) + + Specifies whether the neoclassical contribution is applied to particle diffusivity and radial convective velocity for the species (is). + + + GRID diff --git a/src/driver/b2co.F b/src/driver/b2co.F index 4288354dc..5b5b1b4d3 100644 --- a/src/driver/b2co.F +++ b/src/driver/b2co.F @@ -407,7 +407,7 @@ program b2co call find_file(filename,file_exists) if(file_exists) then write(*,*) 'Truncating ', trim(filename) - call b2co_time_cdf(nx, ny, ns, tim, .false.) + call b2co_time_cdf(nx, ny, ns, nnatmi, nnmoli, tim, .false.) write(*,*) 'Returned from b2co_time_cdf' else write(*,*) 'Skipped calling b2co_time_cdf because '// @@ -419,7 +419,7 @@ program b2co call find_file(filename,file_exists) if(file_exists) then write(*,*) 'Truncating ', trim(filename) - call b2co_time_cdf(nx, ny, ns, tim, .true.) + call b2co_time_cdf(nx, ny, ns, nnatmi, nnmoli, tim, .true.) write(*,*) 'Returned from b2co_time_cdf' else write(*,*) 'Skipped calling b2co_time_cdf because '// @@ -474,7 +474,7 @@ program b2co write(*,*) 'Returned from b2co_movies_cdf' else write(*,*) 'Skipped calling b2co_movies_cdf because '// - . 'no b2movies.nc file found' + . 'no b2movies.nc found' end if end if * ..close other files diff --git a/src/modules/b2mod_input_profile.F b/src/modules/b2mod_input_profile.F index a21aa8d11..5a74643e3 100644 --- a/src/modules/b2mod_input_profile.F +++ b/src/modules/b2mod_input_profile.F @@ -466,6 +466,7 @@ subroutine sources_profile(kind_data,ndat,r,ndim,pr,nx,ny,ifa, integer:: i,nx,ny,ifa integer:: nfitanf,nfitend,ndim,ndat,kind_data real(kind=R8) :: pra(1:ny+2),prdsa(1:ny+2),r(nrr),pr(nrr),prtmp + real (kind=R8) :: dsp(-1:ny) integer jxi, jxa, jsep, iyastrt, iyaend, ncall, nya integer ixref, iyref character*256 filename @@ -502,7 +503,7 @@ subroutine sources_profile(kind_data,ndat,r,ndim,pr,nx,ny,ifa, 1 'faulty argument for sources profile ixref') call xertst (-1.le.iyref.and.iyref.le.ny, 1 'faulty argument for sources profile iyref') - call output_ds(ny,ixref,0,iyref,iyastrt,iyaend,'dsp') + call output_ds(ny,ixref,0,iyref,iyastrt,iyaend,'dsp',dsp) endif filename='dsp' @@ -675,11 +676,12 @@ subroutine transport_input(nx, ny, ns, rza, na, ne, te, ti, hcib, use b2mod_constants use b2mod_indirect use b2mod_b2cmpa + use b2mod_geo IMPLICIT NONE integer :: nx,ny,ns integer :: iy,ix,i,ifail,spec,nspec,iiy,iir, & nfitanf,ndim,is,nsp(1:ns+1),iloop,ncall,ifa,ndat, - & kind_coeff,kind_data,isc + & kind_coeff,kind_data,isc,idy integer :: ixwidth(nscale), ixmean(nscale) real(kind=R8), dimension(-1:nx,-1:ny,0:ns-1) :: @@ -690,19 +692,29 @@ subroutine transport_input(nx, ny, ns, rza, na, ne, te, ti, hcib, real(kind=R8), save :: scaling_width(nscale) real(kind=R8), save :: scaling_strength(nscale) real(kind=R8) :: f(nrr),r(nrr),pr(nrr),pf(nrr),d(nrr), - & pelm(nrr),felm(nrr),delm(nrr),prof(nrr), - & vla0(-1:nx,-1:ny,0:1,0:ns-1),hcib(-1:nx,-1:ny,0:ns-1) + & pelm(nrr),felm(nrr),delm(nrr),prof(-1:nx,nrr), + & vla0(-1:nx,-1:ny,0:1,0:ns-1),hcib(-1:nx,-1:ny,0:ns-1), + & pelm_rescaled(-1:nx,nrr) character*256, save :: transport_filename real (kind=R8), save :: transport_time_mod real (kind=R8), save :: transport_time_switch - real (kind=R8), save :: elm_time_begin, elm_time_end + real (kind=R8), save :: elm_time_begin(nkind_coeff), + 1 elm_time_plateau(nkind_coeff), elm_time_recovery(nkind_coeff), + 2 elm_time_end(nkind_coeff), elm_crash_factor(nkind_coeff), + 3 elm_recovery_factor(nkind_coeff), elm_ballooning_exp(nkind_coeff) real (kind=R8), save :: elm_time_period + real (kind=R8) :: frac_elm real (kind=R8) :: poloidal_scale_factor + real (kind=R8) :: elm_poloidal_scaling_factor(-1:nx,nkind_coeff) + real (kind=R8) :: thet, ilp(-1:ny), ilpb, hxface, hxpface, hxnface + real (kind=R8) :: theta(-1:nx,-1:ny) integer, save :: scaling_ix_begin(nscale), scaling_ix_end(nscale) - integer, save :: elm_ix_begin, elm_ix_end + integer, save :: elm_ix_begin, elm_ix_end, elm_ixref logical, save :: region_flags(NNREGMAX,nkind_coeff), no_pflux, - 1 poloidal_scaling(nscale), elm_time, elm_region, elm_data, - 2 no_div + 1 no_div, poloidal_scaling(nscale), elm_crash_time(nkind_coeff), + 2 elm_plateau_time(nkind_coeff), elm_recovery_time(nkind_coeff), + 3 elm_crash_region, elm_plateau_region, elm_recovery_region, + 4 elm_data, elm_dynamics_multiple character*260 filename character*26 hlp_frm integer, save :: elm_count @@ -712,9 +724,11 @@ subroutine transport_input(nx, ny, ns, rza, na, ne, te, ti, hcib, namelist /transport/ ndata, tdata, addspec, 1 transport_filename, transport_time_mod, transport_time_switch, 2 scaling_ix_begin, scaling_ix_end, scaling_strength, - 3 region_flags, no_pflux, poloidal_scaling, scaling_width, - 4 elm_time_begin, elm_time_end, elm_time_period, - 5 elm_ix_begin, elm_ix_end, no_div + 3 region_flags, poloidal_scaling, scaling_width, + 4 elm_time_begin, elm_time_plateau, elm_time_recovery, + 5 elm_time_end, elm_time_period, elm_ix_begin, elm_ix_end, + 6 elm_ixref, elm_crash_factor, elm_recovery_factor, + 7 elm_ballooning_exp, elm_dynamics_multiple, no_pflux, no_div data transport_filename/'b2.transport.inputfile'/, 1 transport_time_mod/0.0_R8/, transport_time_switch/0.0_R8/ @@ -791,13 +805,162 @@ subroutine transport_input(nx, ny, ns, rza, na, ne, te, ti, hcib, . sqrt((ixwidth(isc)+1.0_R8)*(ixwidth(isc)-1.0_R8)/3.0_R8) enddo if (elm_time_period.gt.0.) then - elm_time=mod(tim,elm_time_period).ge.elm_time_begin.and. - & mod(tim,elm_time_period).le.elm_time_end + if (elm_dynamics_multiple) then + do kind_coeff=1,nkind_coeff + if (elm_time_plateau(kind_coeff).gt.0. .and. + 1 elm_time_recovery(kind_coeff).gt.0.) then + if (elm_time_begin(kind_coeff).eq. + 1 elm_time_plateau(kind_coeff)) then + elm_crash_time(kind_coeff)=.false. + else + elm_crash_time(kind_coeff)=mod(tim,elm_time_period).ge. + & elm_time_begin(kind_coeff).and. + & mod(tim,elm_time_period).le. + & elm_time_plateau(kind_coeff) + endif + elm_plateau_time(kind_coeff)=mod(tim,elm_time_period).ge. + & elm_time_plateau(kind_coeff).and. + & mod(tim,elm_time_period).le. + & elm_time_recovery(kind_coeff) + if (elm_time_recovery(kind_coeff).eq. + 1 elm_time_end(kind_coeff)) then + elm_recovery_time(kind_coeff)=.false. + else + elm_recovery_time(kind_coeff)=mod(tim,elm_time_period) + & .ge.elm_time_recovery(kind_coeff).and. + & mod(tim,elm_time_period).le. + & elm_time_end(kind_coeff) + endif + else + elm_crash_time(kind_coeff)=.false. + elm_plateau_time(kind_coeff)=mod(tim,elm_time_period).ge. + & elm_time_begin(kind_coeff) + & .and.mod(tim,elm_time_period) + & .le.elm_time_end(kind_coeff) + elm_recovery_time(kind_coeff)=.false. + endif + enddo + else + if (elm_time_plateau(1).gt.0. .and. + 1 elm_time_recovery(1).gt.0.) then + if (elm_time_begin(1).eq.elm_time_plateau(1)) then + elm_crash_time(1)=.false. + else + elm_crash_time(1)=mod(tim,elm_time_period) + & .ge.elm_time_begin(1).and. + & mod(tim,elm_time_period).le.elm_time_plateau(1) + endif + elm_plateau_time(1)=mod(tim,elm_time_period) + & .ge.elm_time_plateau(1).and. + & mod(tim,elm_time_period).le.elm_time_recovery(1) + if (elm_time_recovery(1).eq.elm_time_end(1)) then + elm_recovery_time(1)=.false. + else + elm_recovery_time(1)=mod(tim,elm_time_period).ge. + & elm_time_recovery(1).and. + & mod(tim,elm_time_period).le.elm_time_end(1) + endif + else + elm_crash_time(1)=.false. + elm_plateau_time(1)=mod(tim,elm_time_period).ge. + & elm_time_begin(1).and.mod(tim,elm_time_period) + & .le.elm_time_end(1) + elm_recovery_time(1)=.false. + endif + endif else - elm_time=.false. + if (elm_dynamics_multiple) then + do kind_coeff=1,nkind_coeff + elm_crash_time(kind_coeff)=.false. + elm_plateau_time(kind_coeff)=.false. + elm_recovery_time(kind_coeff)=.false. + enddo + else + elm_crash_time(1)=.false. + elm_plateau_time(1)=.false. + elm_recovery_time(1)=.false. + endif endif elm_data = maxval(tdata(3,:,:,:)).gt.0.0_R8 +c Calculate poloidal angle theta (same code used in b2tqna.F) + do iy=-1,ny + do ix=-1,nx + theta(ix,iy)=-1.0_R8 + enddo + enddo + do iy=0,ny + thet=0._R8 + ilp(iy)=0._R8 + do ix=elm_ixref,-1,-1 + if (on_closed_surface(ix,iy)) then + theta(ix,iy)=thet + hxface=(vol(ix,iy)*hx(bottomix(ix,iy),bottomiy(ix,iy))+ + & vol(bottomix(ix,iy),bottomiy(ix,iy))*hx(ix,iy))/ + & (vol(bottomix(ix,iy),bottomiy(ix,iy))+vol(ix,iy)) + hxpface=(vol(leftix(ix,iy),leftiy(ix,iy))* + & hx(bottomix(leftix(ix,iy),leftiy(ix,iy)), + & bottomiy(leftix(ix,iy),leftiy(ix,iy)))+ + & vol(bottomix(leftix(ix,iy),leftiy(ix,iy)), + & bottomiy(leftix(ix,iy),leftiy(ix,iy)))* + & hx(leftix(ix,iy),leftiy(ix,iy)))/ + & (vol(bottomix(leftix(ix,iy),leftiy(ix,iy)), + & bottomiy(leftix(ix,iy),leftiy(ix,iy)))+ + & vol(leftix(ix,iy),leftiy(ix,iy))) + hxnface=(vol(rightix(ix,iy),rightiy(ix,iy))* + & hx(bottomix(rightix(ix,iy),rightiy(ix,iy)), + & bottomiy(rightix(ix,iy),rightiy(ix,iy)))+ + & vol(bottomix(rightix(ix,iy),rightiy(ix,iy)), + & bottomiy(rightix(ix,iy),rightiy(ix,iy)))* + & hx(rightix(ix,iy),rightiy(ix,iy)))/ + & (vol(bottomix(rightix(ix,iy),rightiy(ix,iy)), + & bottomiy(rightix(ix,iy),rightiy(ix,iy)))+ + & vol(rightix(ix,iy),rightiy(ix,iy))) + thet=thet+0.5_R8*bb(ix,iy,3)/bb(ix,iy,0)* + & ((hxpface+hxnface)/2._R8+hxface) + ilp(iy)=ilp(iy)+0.5_R8*((hxpface+hxnface)/2._R8+hxface)/ + & bb(ix,iy,0) + endif + enddo + do ix=nx,elm_ixref+1,-1 + if (on_closed_surface(ix,iy)) then + theta(ix,iy)=thet + hxface=(vol(ix,iy)*hx(bottomix(ix,iy),bottomiy(ix,iy))+ + & vol(bottomix(ix,iy),bottomiy(ix,iy))*hx(ix,iy))/ + & (vol(bottomix(ix,iy),bottomiy(ix,iy))+vol(ix,iy)) + hxpface=(vol(leftix(ix,iy),leftiy(ix,iy))* + & hx(bottomix(leftix(ix,iy),leftiy(ix,iy)), + & bottomiy(leftix(ix,iy),leftiy(ix,iy)))+ + & vol(bottomix(leftix(ix,iy),leftiy(ix,iy)), + & bottomiy(leftix(ix,iy),leftiy(ix,iy)))* + & hx(leftix(ix,iy),leftiy(ix,iy)))/ + & (vol(bottomix(leftix(ix,iy),leftiy(ix,iy)), + & bottomiy(leftix(ix,iy),leftiy(ix,iy)))+ + & vol(leftix(ix,iy),leftiy(ix,iy))) + hxnface=(vol(rightix(ix,iy),rightiy(ix,iy))* + & hx(bottomix(rightix(ix,iy),rightiy(ix,iy)), + & bottomiy(rightix(ix,iy),rightiy(ix,iy)))+ + & vol(bottomix(rightix(ix,iy),rightiy(ix,iy)), + & bottomiy(rightix(ix,iy),rightiy(ix,iy)))* + & hx(rightix(ix,iy),rightiy(ix,iy)))/ + & (vol(bottomix(rightix(ix,iy),rightiy(ix,iy)), + & bottomiy(rightix(ix,iy),rightiy(ix,iy)))+ + & vol(rightix(ix,iy),rightiy(ix,iy))) + thet=thet+0.5_R8*bb(ix,iy,3)/bb(ix,iy,0)* + & ((hxpface+hxnface)/2._R8+hxface) + ilp(iy)=ilp(iy)+0.5_R8*((hxpface+hxnface)/2._R8+hxface)/ + & bb(ix,iy,0) + endif + enddo + theta(elm_ixref,iy)=thet + ilpb=thet + do ix=-1,nx + if (on_closed_surface(ix,iy)) then + theta(ix,iy)=2.0_R8*pi*theta(ix,iy)/ilpb + endif + enddo + enddo + ! write (*,*) 'vor loop' iloop=0 do kind_coeff=1,nkind_coeff @@ -902,61 +1065,153 @@ subroutine transport_input(nx, ny, ns, rza, na, ne, te, ti, hcib, $ (2.0_R8*scaling_width(isc)**2))) endif enddo - elm_region=elm_time.and.elm_data.and. - & ix.ge.elm_ix_begin.and.ix.le.elm_ix_end + + if (elm_dynamics_multiple) then + elm_crash_region= + & elm_crash_time(kind_coeff).and.elm_data + & .and.ix.ge.elm_ix_begin.and.ix.le.elm_ix_end + elm_plateau_region= + & elm_plateau_time(kind_coeff).and.elm_data + & .and.ix.ge.elm_ix_begin.and.ix.le.elm_ix_end + elm_recovery_region= + & elm_recovery_time(kind_coeff).and.elm_data + & .and.ix.ge.elm_ix_begin.and.ix.le.elm_ix_end + else + elm_crash_region= + & elm_crash_time(1).and.elm_data + & .and.ix.ge.elm_ix_begin.and.ix.le.elm_ix_end + elm_plateau_region= + & elm_plateau_time(1).and.elm_data + & .and.ix.ge.elm_ix_begin.and.ix.le.elm_ix_end + elm_recovery_region= + & elm_recovery_time(1).and.elm_data + & .and.ix.ge.elm_ix_begin.and.ix.le.elm_ix_end + endif + + if (theta(ix,0).eq.-1.0_R8.and. + $ elm_ballooning_exp(kind_coeff).ne.0.0_R8) then + elm_poloidal_scaling_factor(ix,kind_coeff) = 0.0_R8 + else + elm_poloidal_scaling_factor(ix,kind_coeff) = + & abs(cos((theta(ix,0)-2.0_R8*acos(-1.0_R8)) + & /2.0_R8))**elm_ballooning_exp(kind_coeff) + endif + + if (elm_poloidal_scaling_factor(ix,kind_coeff) + $ .lt.1.0e-10_R8) then + elm_poloidal_scaling_factor(ix,kind_coeff)=0.0_R8 + endif + + do idy=1,ndim + pelm_rescaled(ix,idy)= + & pf(idy)*(1.0_R8- + & elm_poloidal_scaling_factor(ix,kind_coeff))+ + & pelm(idy)* + & elm_poloidal_scaling_factor(ix,kind_coeff) + enddo if(.not. 1 (.not.region_flags(iir,kind_coeff).or. 1 (lpflux.and.no_pflux).or. 1 (ldiv.and.no_div))) then - if (elm_region) then - prof(1:ndim)=pelm(1:ndim) + if (elm_crash_region) then + if (elm_dynamics_multiple) then + frac_elm = + & log(1.0_R8+elm_crash_factor(kind_coeff)* + & ((mod(tim,elm_time_period)- + & elm_time_begin(kind_coeff))/ + & (elm_time_plateau(kind_coeff)- + & elm_time_begin(kind_coeff))))/ + & log(1.0_R8+elm_crash_factor(kind_coeff)) + else + frac_elm = + & log(1.0_R8+elm_crash_factor(1)* + & ((mod(tim,elm_time_period)- + & elm_time_begin(1))/ + & (elm_time_plateau(1)- + & elm_time_begin(1))))/ + & log(1.0_R8+elm_crash_factor(1)) + endif + do idy=1,ndim + prof(ix,idy)= + & pf(idy)+(frac_elm)* + & (pelm_rescaled(ix,idy)-pf(idy)) + enddo + elseif (elm_plateau_region) then + prof(ix,1:ndim)=pelm_rescaled(ix,1:ndim) + elseif (elm_recovery_region) then + if (elm_dynamics_multiple) then + frac_elm = + & (exp(-elm_recovery_factor(kind_coeff)* + & ((mod(tim,elm_time_period)- + & elm_time_recovery(kind_coeff)) + & /(elm_time_end(kind_coeff)- + & elm_time_recovery(kind_coeff))))- + & exp(-elm_recovery_factor(kind_coeff)))/ + & (1.0_R8- + & exp(-elm_recovery_factor(kind_coeff))) + else + frac_elm = + & (exp(-elm_recovery_factor(1)* + & ((mod(tim,elm_time_period)- + & elm_time_recovery(1)) + & /(elm_time_end(1)- + & elm_time_recovery(1))))- + & exp(-elm_recovery_factor(1)))/ + & (1.0_R8- + & exp(-elm_recovery_factor(1))) + endif + do idy=1,ndim + prof(ix,idy)= + & pf(idy)+(frac_elm)* + & (pelm_rescaled(ix,idy)-pf(idy)) + enddo else - prof(1:ndim)=pf(1:ndim) + prof(ix,1:ndim)=pf(1:ndim) endif if (kind_coeff.eq.1) then dna0(ix,iiy,nsp(is))= - 1 prof(iy)*poloidal_scale_factor + 1 prof(ix,iy)*poloidal_scale_factor elseif (kind_coeff.eq.2) then dpa0(ix,iiy,nsp(is))= - 1 prof(iy)*poloidal_scale_factor/ + 1 prof(ix,iy)*poloidal_scale_factor/ & (rza(ix,iiy,nsp(is))*te(ix,iiy)+ti(ix,iiy)) elseif (kind_coeff.eq.3) then hcib(ix,iiy,nsp(is))=poloidal_scale_factor* - & prof(iy)*na(ix,iiy,nsp(is)) + & prof(ix,iy)*na(ix,iiy,nsp(is)) elseif (kind_coeff.eq.4) then - hce0(ix,iiy)=prof(iy)*ne(ix,iiy)* + hce0(ix,iiy)=prof(ix,iy)*ne(ix,iiy)* 1 poloidal_scale_factor elseif (kind_coeff.eq.5) then vla0(ix,iiy,0,nsp(is))= - 1 prof(iy)*poloidal_scale_factor + 1 prof(ix,iy)*poloidal_scale_factor elseif (kind_coeff.eq.6) then vla0(ix,iiy,1,nsp(is))= - 1 prof(iy)*poloidal_scale_factor + 1 prof(ix,iy)*poloidal_scale_factor elseif (kind_coeff.eq.7) then vsa0(ix,iiy,nsp(is))=poloidal_scale_factor* - 1 prof(iy)*mp*am(nsp(is))*na(ix,iiy,nsp(is)) + 1 prof(ix,iy)*mp*am(nsp(is))*na(ix,iiy,nsp(is)) elseif (kind_coeff.eq.8) then if (csig_an_style.eq.0) then - sig0(ix,iiy)=prof(iy)*qe*ne(ix,iiy)* + sig0(ix,iiy)=prof(ix,iy)*qe*ne(ix,iiy)* 1 poloidal_scale_factor elseif(csig_an_style.eq.1) then - sig0(ix,iiy)=prof(iy)*qe*ne(nmdpl,-1)* + sig0(ix,iiy)=prof(ix,iy)*qe*ne(nmdpl,-1)* 1 poloidal_scale_factor endif elseif (kind_coeff.eq.9) then alf0(ix,iiy)=poloidal_scale_factor* - 1 prof(iy)*ne(ix,iiy)* + 1 prof(ix,iy)*ne(ix,iiy)* 2 sqrt(qe/te(ix,iiy)) else @@ -1062,6 +1317,7 @@ subroutine transport_input(nx, ny, ns, rza, na, ne, te, ti, hcib, subroutine read_transport_input implicit none + integer jxa, jxi, jsep logical file_ok c*** Clear data to forget previous profiles @@ -1076,11 +1332,19 @@ subroutine read_transport_input scaling_width=0.0_R8 scaling_ix_begin=-2 scaling_ix_end=-2 - elm_time_begin=0.0_R8 - elm_time_end=0.0_R8 + elm_dynamics_multiple=.false. + elm_time_begin(:)=0.0_R8 + elm_time_plateau(:)=0.0_R8 + elm_time_recovery(:)=0.0_R8 + elm_time_end(:)=0.0_R8 elm_time_period=0.0_R8 elm_ix_begin=-2 elm_ix_end=-2 + call get_jsep(nx,ny,jxi,jxa,jsep) + elm_ixref = jxa + elm_crash_factor(:)=1.0e-10_R8 + elm_recovery_factor(:)=1.0e-10_R8 + elm_ballooning_exp(:)=0.0_R8 transport_time_mod=0.0_R8 transport_time_switch=0.0_R8 call find_file(filename,file_ok) @@ -1117,6 +1381,7 @@ subroutine transport_profile(kind_data,ndat,r,ndim,pr,nx,ny,ifa, integer:: i,nx,ny,ifa integer:: nfitanf,nfitend,ndim,ndat,kind_data real(kind=R8) :: pra(1:ny+2),prdsa(1:ny+2),r(nrr),pr(nrr),prtmp + real (kind=R8) :: dsp(-1:ny) integer jxi, jxa, jsep, iyastrt, iyaend, ncall, nya integer ixref, iyref character*256 filename @@ -1142,7 +1407,7 @@ subroutine transport_profile(kind_data,ndat,r,ndim,pr,nx,ny,ifa, call ipgeti ('set_transport_iyref', iyref) call xertst (-1.le.iyref.and.iyref.le.ny, 1 'faulty argument set_transport_iyref') - call output_ds(ny,ixref,0,iyref,iyastrt,iyaend,'dsp') + call output_ds(ny,ixref,0,iyref,iyastrt,iyaend,'dsp',dsp) call ipgeti ('b2trno_csig_an_style', csig_an_style) endif diff --git a/src/modules/b2mod_mwti.F90 b/src/modules/b2mod_mwti.F90 index 2b990bbd3..80c33019e 100644 --- a/src/modules/b2mod_mwti.F90 +++ b/src/modules/b2mod_mwti.F90 @@ -8,22 +8,28 @@ module b2mod_mwti public :: b2mwti, dealloc_b2mod_mwti #endif real (kind=R8), allocatable, save, public :: & - nesepi_av(:), tesepi_av(:), tisepi_av(:), & - nesepm_av(:), tesepm_av(:), tisepm_av(:), & - nesepa_av(:), tesepa_av(:), tisepa_av(:), & + nasepi_av(:,:), nesepi_av(:), tesepi_av(:), tisepi_av(:), & + dabsepi_av(:,:), dmbsepi_av(:,:), tabsepi_av(:,:), tmbsepi_av(:,:), & + nasepm_av(:,:), nesepm_av(:), tesepm_av(:), tisepm_av(:), & + dabsepm_av(:,:), dmbsepm_av(:,:), tabsepm_av(:,:), tmbsepm_av(:,:), & + nasepa_av(:,:), nesepa_av(:), tesepa_av(:), tisepa_av(:), & + dabsepa_av(:,:), dmbsepa_av(:,:), tabsepa_av(:,:), tmbsepa_av(:,:), & posepi_av(:), posepm_av(:), posepa_av(:) real (kind=R8), allocatable, save, public :: & - nemxip_av(:), temxip_av(:), timxip_av(:), & - nemxap_av(:), temxap_av(:), timxap_av(:), & + namxip_av(:,:), nemxip_av(:), temxip_av(:), timxip_av(:), & + namxap_av(:,:), nemxap_av(:), temxap_av(:), timxap_av(:), & pomxip_av(:), pomxap_av(:) real (kind=R8), allocatable, save, public :: & - nesepi_std(:), tesepi_std(:), tisepi_std(:), & - nesepm_std(:), tesepm_std(:), tisepm_std(:), & - nesepa_std(:), tesepa_std(:), tisepa_std(:), & + nasepi_std(:,:), nesepi_std(:), tesepi_std(:), tisepi_std(:), & + dabsepi_std(:,:), dmbsepi_std(:,:), tabsepi_std(:,:), tmbsepi_std(:,:), & + nasepm_std(:,:), nesepm_std(:), tesepm_std(:), tisepm_std(:), & + dabsepm_std(:,:), dmbsepm_std(:,:), tabsepm_std(:,:), tmbsepm_std(:,:), & + nasepa_std(:,:), nesepa_std(:), tesepa_std(:), tisepa_std(:), & + dabsepa_std(:,:), dmbsepa_std(:,:), tabsepa_std(:,:), tmbsepa_std(:,:), & posepi_std(:), posepm_std(:), posepa_std(:) real (kind=R8), allocatable, save, public :: & - nemxip_std(:), temxip_std(:), timxip_std(:), & - nemxap_std(:), temxap_std(:), timxap_std(:), & + namxip_std(:,:), nemxip_std(:), temxip_std(:), timxip_std(:), & + namxap_std(:,:), nemxap_std(:), temxap_std(:), timxap_std(:), & pomxip_std(:), pomxap_std(:) #ifndef NO_CDF @@ -65,6 +71,7 @@ subroutine b2mwti (itim, tim, & #endif implicit none ! ..input arguments (unchanged on exit) + integer :: is integer, intent(in) :: itim, nx, ny, ns, ismain, ismain0 real (kind=R8), intent(in) :: tim, BoRiS logical, intent(in) :: lwti, lwav, luav @@ -138,23 +145,43 @@ subroutine b2mwti (itim, tim, & #ifndef NO_CDF integer, save :: ncid, nbatch integer, save :: nya, nyi, nybl, nybr, nytl, nytr - integer imap(maxvdims), iret, iatm + integer imap(maxvdims), iret, iatm, imol integer nvars, natts, ndims, unlimid real (kind=R8) :: fac real (kind=R8) :: & - nesepi(nncutmax), tesepi(nncutmax), tisepi(nncutmax), & - nesepm(nncutmax), tesepm(nncutmax), tisepm(nncutmax), & - nesepa(nncutmax), tesepa(nncutmax), tisepa(nncutmax), & + nasepi(ns,nncutmax), nesepi(nncutmax), tesepi(nncutmax), tisepi(nncutmax), & + dabsepi(nnatmi,nncutmax), dmbsepi(nnmoli,nncutmax), tabsepi(nnatmi,nncutmax), tmbsepi(nnmoli,nncutmax), & + nasepm(ns,nncutmax), nesepm(nncutmax), tesepm(nncutmax), tisepm(nncutmax), & + dabsepm(nnatmi,nncutmax), dmbsepm(nnmoli,nncutmax), tabsepm(nnatmi,nncutmax), tmbsepm(nnmoli,nncutmax), & + nasepa(ns,nncutmax), nesepa(nncutmax), tesepa(nncutmax), tisepa(nncutmax), & + dabsepa(nnatmi,nncutmax), dmbsepa(nnmoli,nncutmax), tabsepa(nnatmi,nncutmax), tmbsepa(nnmoli,nncutmax), & posepi(nncutmax), posepm(nncutmax), posepa(nncutmax), & dnsepm(nncutmax), dpsepm(nncutmax), kesepm(nncutmax), & kisepm(nncutmax), vxsepm(nncutmax), vysepm(nncutmax), & - vssepm(nncutmax), tpsepi(nncutmax), tpsepa(nncutmax) + vssepm(nncutmax), tpsepi(nncutmax), tpsepa(nncutmax), & + namxip(ns,nncutmax), namxap(ns,nncutmax) + real (kind=R8), allocatable :: & + na3dl(:,:), na3di(:,:), na3da(:,:), na3dr(:,:), na3dtl(:,:), na3dtr(:,:), & + fn3dl(:,:), fn3dr(:,:), fn3dtl(:,:), fn3dtr(:,:), & + dab3dl(:,:), dmb3dl(:,:), tab3dl(:,:), tmb3dl(:,:), & + dab3di(:,:), dmb3di(:,:), tab3di(:,:), tmb3di(:,:), & + dab3da(:,:), dmb3da(:,:), tab3da(:,:), tmb3da(:,:), & + dab3dr(:,:), dmb3dr(:,:), tab3dr(:,:), tmb3dr(:,:), & + dab3dtl(:,:), dmb3dtl(:,:), tab3dtl(:,:), tmb3dtl(:,:), & + dab3dtr(:,:), dmb3dtr(:,:), tab3dtr(:,:), tmb3dtr(:,:), & + dn3di(:,:), dn3da(:,:), dp3di(:,:), dp3da(:,:), & + vs3di(:,:), vs3da(:,:), vx3di(:,:), vx3da(:,:), vy3di(:,:), vy3da(:,:) real (kind=R8) :: & - tmhacore(1), tmhasol(1), tmhadiv(1), slice(-1:ny), tstepn(1) + tmhacore(1), tmhasol(1), tmhadiv(1), slice(-1:ny), tstepn(1), & + jxan(1), jxin(1), jsepn(1) real (kind=R8) :: & timesa(1), batchsa(1) + real(kind=R8), allocatable, save :: dsl(:), dsi(:), dsa(:), dsr(:), dstl(:), dstr(:) + real(kind=R8), allocatable, save :: dsLT(:), dsRT(:), dsTLT(:), dsTRT(:) + real(kind=R8), allocatable, save :: dsLP(:), dsRP(:), dsTLP(:), dsTRP(:) real (kind=R8), save :: stim = 0.0_R8 logical ex + logical :: file_exists character*5 rw character*256, save :: filename, filename_av real(kind=R8) :: rratio @@ -190,10 +217,15 @@ subroutine b2mwti (itim, tim, & call ipgeti ('b2mwti_target_offset',target_offset) call xertst (0.le.target_offset.and.target_offset.le.1,'faulty internal parameter target_offset') write(*,*) 'target_offset ', target_offset - call output_ds(ny, -1,+target_offset,jsep,iylstrt,iylend,'dsl') - call output_ds(ny,jxi,0,jsep,iyistrt,iyiend,'dsi') - call output_ds(ny,jxa,0,jsep,iyastrt,iyaend,'dsa') - call output_ds(ny, nx,-target_offset,jsep,iyrstrt,iyrend,'dsr') + if (.not. allocated(dsl)) then + allocate(dsl(-1:ny), dsi(-1:ny), dsa(-1:ny), dsr(-1:ny), dstl(-1:ny), dstr(-1:ny), & + dsLT(-1:ny), dsRT(-1:ny), dsTLT(-1:ny), dsTRT(-1:ny), & + dsLP(-1:ny), dsRP(-1:ny), dsTLP(-1:ny), dsTRP(-1:ny)) + end if + call output_ds(ny, -1,+target_offset,jsep,iylstrt,iylend,'dsl',dsl) + call output_ds(ny,jxi,0,jsep,iyistrt,iyiend,'dsi',dsi) + call output_ds(ny,jxa,0,jsep,iyastrt,iyaend,'dsa',dsa) + call output_ds(ny, nx,-target_offset,jsep,iyrstrt,iyrend,'dsr',dsr) if (nnreg(0).ge.7) then ixtl = 0 do while (rightix(ixtl,max(topcut(1),topcut(2))).ne.nx+1.and.ixtl.lt.nx) @@ -203,8 +235,8 @@ subroutine b2mwti (itim, tim, & do while (leftix(ixtr,max(topcut(1),topcut(2))).ne.-2 .and. ixtr.lt.nx) ixtr=ixtr+1 enddo - call output_ds(ny,ixtl,-target_offset,jsep,iytlstrt,iytlend,'dstl') - call output_ds(ny,ixtr,+target_offset,jsep,iytrstrt,iytrend,'dstr') + call output_ds(ny,ixtl,-target_offset,jsep,iytlstrt,iytlend,'dstl',dstl) + call output_ds(ny,ixtr,+target_offset,jsep,iytrstrt,iytrend,'dstr',dstr) #ifndef NO_CDF nytl = iytlend - iytlstrt + 1 nytr = iytrend - iytrstrt + 1 @@ -221,48 +253,84 @@ subroutine b2mwti (itim, tim, & #endif nc = max(nncut,1) ! Target areas - open(99,file='dsL') + inquire(file='dsL', exist=file_exists) + if (file_exists) then + open(99,file='dsLT') + else + open(99,file='dsL') + end if do iy=-1,ny - if(region(-1,iy,0).ne.0) write(99,*) gs(rightix(-1,iy),rightiy(-1,iy),0) + if(region(-1,iy,0).ne.0) then + write(99,*) gs(rightix(-1,iy),rightiy(-1,iy),0) + dsLT(iy) = gs(rightix(-1,iy),rightiy(-1,iy),0) + endif enddo close(99) - open(99,file='dsR') + inquire(file='dsR', exist=file_exists) + if (file_exists) then + open(99,file='dsRT') + else + open(99,file='dsR') + end if do iy=-1,ny - if(region(nx,iy,0).ne.0) write(99,*) gs(nx,iy,0) + if(region(nx,iy,0).ne.0) then + write(99,*) gs(nx,iy,0) + dsRT(iy) = gs(nx,iy,0) + endif enddo close(99) if (nnreg(0).ge.7) then - open(99,file='dsTL') + inquire(file='dsTL', exist=file_exists) + if (file_exists) then + open(99,file='dsTLT') + else + open(99,file='dsTL') + end if do iy=iytlstrt,iytlend write(99,*) gs(ixtl,iy,0) + dsTLT(iy) = gs(ixtl,iy,0) enddo close(99) - open(99,file='dsTR') + inquire(file='dsTR', exist=file_exists) + if (file_exists) then + open(99,file='dsTRT') + else + open(99,file='dsTR') + end if do iy=iytrstrt,iytrend write(99,*) gs(rightix(ixtr,iy),rightiy(ixtr,iy),0) + dsTRT(iy) = gs(rightix(ixtr,iy),rightiy(ixtr,iy),0) enddo close(99) endif ! Poloidal contact areas open(99,file='dsLP') do iy=-1,ny - if(region(-1,iy,0).ne.0) write(99,*) gs(rightix(-1,iy),rightiy(-1,iy),0)*qc(rightix(-1,iy),rightiy(-1,iy)) + if(region(-1,iy,0).ne.0) then + write(99,*) gs(rightix(-1,iy),rightiy(-1,iy),0)*qc(rightix(-1,iy),rightiy(-1,iy)) + dsLP(iy) = gs(rightix(-1,iy),rightiy(-1,iy),0)*qc(rightix(-1,iy),rightiy(-1,iy)) + endif enddo close(99) open(99,file='dsRP') do iy=-1,ny - if(region(nx,iy,0).ne.0) write(99,*) gs(nx,iy,0)*qc(nx,iy) + if(region(nx,iy,0).ne.0) then + write(99,*) gs(nx,iy,0)*qc(nx,iy) + dsRP(iy) = gs(nx,iy,0)*qc(nx,iy) + endif enddo close(99) if (nnreg(0).ge.7) then open(99,file='dsTLP') do iy=iytlstrt,iytlend write(99,*) gs(ixtl,iy,0)*qc(ixtl,iy) + dsTLP(iy) = gs(ixtl,iy,0)*qc(ixtl,iy) enddo close(99) open(99,file='dsTRP') do iy=iytrstrt,iytrend write(99,*) gs(rightix(ixtr,iy),rightiy(ixtr,iy),0)*qc(rightix(ixtr,iy),rightiy(ixtr,iy)) + dsTRP(iy) = gs(rightix(ixtr,iy),rightiy(ixtr,iy),0)*qc(rightix(ixtr,iy),rightiy(ixtr,iy)) enddo close(99) endif @@ -275,7 +343,7 @@ subroutine b2mwti (itim, tim, & ntstep = 0 write(6,'(a)') trim(filename)//' will be created' call b2crtimecdf(filename, & - nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, write_2d, & + nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, nnatmi, nnmoli, write_2d, & ncid, .false., iret) call check_cdf_status(iret) iret = nf_open(trim(filename),or(NF_WRITE,NF_SHARE),ncid) @@ -298,7 +366,7 @@ subroutine b2mwti (itim, tim, & ntstep = 0 write(6,'(a)') trim(filename)//' will be replaced' call b2crtimecdf(filename, & - nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, & + nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, nnatmi, nnmoli, & write_2d, ncid, .false., iret) call check_cdf_status(iret) iret = nf_open(trim(filename),or(NF_WRITE,NF_SHARE),ncid) @@ -324,7 +392,7 @@ subroutine b2mwti (itim, tim, & nastep = 0 write(6,'(a)') trim(filename_av)//' will be created' call b2crtimecdf(filename_av, & - nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, write_2d, & + nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, nnatmi, nnmoli, write_2d, & ncid, .true., iret) call check_cdf_status(iret) iret = nf_open(trim(filename_av),or(NF_WRITE,NF_SHARE),ncid) @@ -357,7 +425,7 @@ subroutine b2mwti (itim, tim, & iret = nf_close(ncid) call check_cdf_status(iret) call b2crtimecdf(filename_av, & - nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, & + nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, nnatmi, nnmoli, & write_2d, ncid, .true., iret) endif iret = nf_open(trim(filename_av),or(NF_WRITE,NF_SHARE),ncid) @@ -366,7 +434,7 @@ subroutine b2mwti (itim, tim, & nastep = 0 write(6,'(a)') trim(filename_av)//' will be replaced' call b2crtimecdf(filename_av, & - nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, & + nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, nnatmi, nnmoli, & write_2d, ncid, .true., iret) call check_cdf_status(iret) iret = nf_open(trim(filename_av),or(NF_WRITE,NF_SHARE),ncid) @@ -386,82 +454,150 @@ subroutine b2mwti (itim, tim, & end if end if #endif + allocate (nasepm_av(1:ns,1:nncutmax)) allocate (nesepm_av(1:nncutmax)) allocate (tesepm_av(1:nncutmax)) allocate (tisepm_av(1:nncutmax)) + allocate (dabsepm_av(1:nnatmi,1:nncutmax)) + allocate (dmbsepm_av(1:nnmoli,1:nncutmax)) + allocate (tabsepm_av(1:nnatmi,1:nncutmax)) + allocate (tmbsepm_av(1:nnmoli,1:nncutmax)) allocate (posepm_av(1:nncutmax)) + allocate (nasepi_av(1:ns,1:nncutmax)) allocate (nesepi_av(1:nncutmax)) allocate (tesepi_av(1:nncutmax)) allocate (tisepi_av(1:nncutmax)) + allocate (dabsepi_av(1:nnatmi,1:nncutmax)) + allocate (dmbsepi_av(1:nnmoli,1:nncutmax)) + allocate (tabsepi_av(1:nnatmi,1:nncutmax)) + allocate (tmbsepi_av(1:nnmoli,1:nncutmax)) allocate (posepi_av(1:nncutmax)) + allocate (nasepa_av(1:ns,1:nncutmax)) allocate (nesepa_av(1:nncutmax)) allocate (tesepa_av(1:nncutmax)) allocate (tisepa_av(1:nncutmax)) + allocate (dabsepa_av(1:nnatmi,1:nncutmax)) + allocate (dmbsepa_av(1:nnmoli,1:nncutmax)) + allocate (tabsepa_av(1:nnatmi,1:nncutmax)) + allocate (tmbsepa_av(1:nnmoli,1:nncutmax)) allocate (posepa_av(1:nncutmax)) + allocate (namxip_av(1:ns,1:nncutmax)) allocate (nemxip_av(1:nncutmax)) allocate (temxip_av(1:nncutmax)) allocate (timxip_av(1:nncutmax)) allocate (pomxip_av(1:nncutmax)) + allocate (namxap_av(1:ns,1:nncutmax)) allocate (nemxap_av(1:nncutmax)) allocate (temxap_av(1:nncutmax)) allocate (timxap_av(1:nncutmax)) allocate (pomxap_av(1:nncutmax)) + allocate (nasepm_std(1:ns,1:nncutmax)) allocate (nesepm_std(1:nncutmax)) allocate (tesepm_std(1:nncutmax)) allocate (tisepm_std(1:nncutmax)) + allocate (dabsepm_std(1:nnatmi,1:nncutmax)) + allocate (dmbsepm_std(1:nnmoli,1:nncutmax)) + allocate (tabsepm_std(1:nnatmi,1:nncutmax)) + allocate (tmbsepm_std(1:nnmoli,1:nncutmax)) allocate (posepm_std(1:nncutmax)) + allocate (nasepi_std(1:ns,1:nncutmax)) allocate (nesepi_std(1:nncutmax)) allocate (tesepi_std(1:nncutmax)) allocate (tisepi_std(1:nncutmax)) + allocate (dabsepi_std(1:nnatmi,1:nncutmax)) + allocate (dmbsepi_std(1:nnmoli,1:nncutmax)) + allocate (tabsepi_std(1:nnatmi,1:nncutmax)) + allocate (tmbsepi_std(1:nnmoli,1:nncutmax)) allocate (posepi_std(1:nncutmax)) + allocate (nasepa_std(1:ns,1:nncutmax)) allocate (nesepa_std(1:nncutmax)) allocate (tesepa_std(1:nncutmax)) allocate (tisepa_std(1:nncutmax)) + allocate (dabsepa_std(1:nnatmi,1:nncutmax)) + allocate (dmbsepa_std(1:nnmoli,1:nncutmax)) + allocate (tabsepa_std(1:nnatmi,1:nncutmax)) + allocate (tmbsepa_std(1:nnmoli,1:nncutmax)) allocate (posepa_std(1:nncutmax)) + allocate (namxip_std(1:ns,1:nncutmax)) allocate (nemxip_std(1:nncutmax)) allocate (temxip_std(1:nncutmax)) allocate (timxip_std(1:nncutmax)) allocate (pomxip_std(1:nncutmax)) + allocate (namxap_std(1:ns,1:nncutmax)) allocate (nemxap_std(1:nncutmax)) allocate (temxap_std(1:nncutmax)) allocate (timxap_std(1:nncutmax)) allocate (pomxap_std(1:nncutmax)) + nasepm_av = 0.0_R8 nesepm_av = 0.0_R8 tesepm_av = 0.0_R8 tisepm_av = 0.0_R8 + dabsepm_av = 0.0_R8 + dmbsepm_av = 0.0_R8 + tabsepm_av = 0.0_R8 + tmbsepm_av = 0.0_R8 posepm_av = 0.0_R8 + nasepi_av = 0.0_R8 nesepi_av = 0.0_R8 tesepi_av = 0.0_R8 tisepi_av = 0.0_R8 + dabsepi_av = 0.0_R8 + dmbsepi_av = 0.0_R8 + tabsepi_av = 0.0_R8 + tmbsepi_av = 0.0_R8 posepi_av = 0.0_R8 + nasepa_av = 0.0_R8 nesepa_av = 0.0_R8 tesepa_av = 0.0_R8 tisepa_av = 0.0_R8 + dabsepa_av = 0.0_R8 + dmbsepa_av = 0.0_R8 + tabsepa_av = 0.0_R8 + tmbsepa_av = 0.0_R8 posepa_av = 0.0_R8 + namxip_av = 0.0_R8 nemxip_av = 0.0_R8 temxip_av = 0.0_R8 timxip_av = 0.0_R8 pomxip_av = 0.0_R8 + namxap_av = 0.0_R8 nemxap_av = 0.0_R8 temxap_av = 0.0_R8 timxap_av = 0.0_R8 pomxap_av = 0.0_R8 + nasepm_std = 0.0_R8 nesepm_std = 0.0_R8 tesepm_std = 0.0_R8 tisepm_std = 0.0_R8 + dabsepm_std = 0.0_R8 + dmbsepm_std = 0.0_R8 + tabsepm_std = 0.0_R8 + tmbsepm_std = 0.0_R8 posepm_std = 0.0_R8 + nasepi_std = 0.0_R8 nesepi_std = 0.0_R8 tesepi_std = 0.0_R8 tisepi_std = 0.0_R8 + dabsepi_std = 0.0_R8 + dmbsepi_std = 0.0_R8 + tabsepi_std = 0.0_R8 + tmbsepi_std = 0.0_R8 posepi_std = 0.0_R8 + nasepa_std = 0.0_R8 nesepa_std = 0.0_R8 tesepa_std = 0.0_R8 tisepa_std = 0.0_R8 + dabsepa_std = 0.0_R8 + dmbsepa_std = 0.0_R8 + tabsepa_std = 0.0_R8 + tmbsepa_std = 0.0_R8 posepa_std = 0.0_R8 + namxip_std = 0.0_R8 nemxip_std = 0.0_R8 temxip_std = 0.0_R8 timxip_std = 0.0_R8 pomxip_std = 0.0_R8 + namxap_std = 0.0_R8 nemxap_std = 0.0_R8 temxap_std = 0.0_R8 timxap_std = 0.0_R8 @@ -496,7 +632,7 @@ subroutine b2mwti (itim, tim, & ! fnixip = 0.0_R8; feexip = 0.0_R8; feixip = 0.0_R8; fchxip = 0.0_R8; fetxip = 0.0_R8 - nemxip = 0.0_R8; temxip = 0.0_R8; timxip = 0.0_R8; pomxip = 0.0_R8; pwmxip = 0.0_R8; tpmxip = 0.0_R8 + namxip = 0.0_R8; nemxip = 0.0_R8; temxip = 0.0_R8; timxip = 0.0_R8; pomxip = 0.0_R8; pwmxip = 0.0_R8; tpmxip = 0.0_R8 ix = -1 ! 1 ix_off = ix + target_offset do iy = iylstrt,iylend @@ -506,6 +642,9 @@ subroutine b2mwti (itim, tim, & feixip(1) = feixip(1) + feitmp fchxip(1) = fchxip(1) + fchtmp fetxip(1) = fetxip(1) + fettmp + do is = 0, ns-1 + namxip(is+1,1) = max(namxip(is+1,1), na(ix_off,iy,is)) + end do nemxip(1) = max(nemxip(1), ne(ix_off,iy)) temxip(1) = max(temxip(1), te(ix_off,iy)) timxip(1) = max(timxip(1), ti(ix_off,iy)) @@ -517,7 +656,7 @@ subroutine b2mwti (itim, tim, & enddo fnixap = 0.0_R8; feexap = 0.0_R8; feixap = 0.0_R8; fchxap = 0.0_R8; fetxap = 0.0_R8 - nemxap = 0.0_R8; temxap = 0.0_R8; timxap = 0.0_R8; pomxap = 0.0_R8; pwmxap = 0.0_R8; tpmxap = 0.0_R8 + namxap = 0.0_R8; nemxap = 0.0_R8; temxap = 0.0_R8; timxap = 0.0_R8; pomxap = 0.0_R8; pwmxap = 0.0_R8; tpmxap = 0.0_R8 ix = nx ! 2 ix_off = ix - target_offset do iy = iyrstrt,iyrend @@ -527,6 +666,9 @@ subroutine b2mwti (itim, tim, & feixap(1) = feixap(1) + feitmp fchxap(1) = fchxap(1) + fchtmp fetxap(1) = fetxap(1) + fettmp + do is = 0, ns-1 + namxap(is+1,1) = max(namxap(is+1,1), na(ix_off,iy,is)) + end do nemxap(1) = max(nemxap(1), ne(ix_off,iy)) temxap(1) = max(temxap(1), te(ix_off,iy)) timxap(1) = max(timxap(1), ti(ix_off,iy)) @@ -547,6 +689,9 @@ subroutine b2mwti (itim, tim, & feixap(2) = feixap(2) + feitmp fchxap(2) = fchxap(2) + fchtmp fetxap(2) = fetxap(2) + fettmp + do is = 0, ns-1 + namxap(is+1,2) = max(namxap(is+1,2), na(ix_off,iy,is)) + end do nemxap(2) = max(nemxap(2), ne(ix_off,iy)) temxap(2) = max(temxap(2), te(ix_off,iy)) timxap(2) = max(timxap(2), ti(ix_off,iy)) @@ -566,6 +711,9 @@ subroutine b2mwti (itim, tim, & feixip(2) = feixip(2) + feitmp fchxip(2) = fchxip(2) + fchtmp fetxip(2) = fetxip(2) + fettmp + do is = 0, ns-1 + namxip(is+1,2) = max(namxip(is+1,2), na(ix_off,iy,is)) + end do nemxip(2) = max(nemxip(2), ne(ix_off,iy)) temxip(2) = max(temxip(2), te(ix_off,iy)) timxip(2) = max(timxip(2), ti(ix_off,iy)) @@ -749,9 +897,29 @@ subroutine b2mwti (itim, tim, & ! #ifndef NO_CDF if(nnreg(0).ne.2) then + do is = 0, ns-1 + nasepi(is+1,1) = 0.5_R8 * (na(-1+target_offset,jsep,is) + na(topix(-1+target_offset,jsep), topiy(-1+target_offset,jsep), & + is)) + end do nesepi(1) = 0.5_R8 * (ne(-1+target_offset,jsep)+ne(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep))) tesepi(1) = 0.5_R8/ev * (te(-1+target_offset,jsep) + te(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep))) tisepi(1) = 0.5_R8/ev * (ti(-1+target_offset,jsep) + ti(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep))) + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepi(iatm,1) = 0.5_R8 * (dab2(target_offset,jsep+1,iatm,1) + dab2(topix(target_offset,jsep+1), & + topiy(target_offset,jsep+1), iatm, 1)) + tabsepi(iatm,1) = 0.5_R8/ev * (tab2(target_offset,jsep+1,iatm,1) + tab2(topix(target_offset,jsep+1), & + topiy(target_offset,jsep+1), iatm, 1)) + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepi(imol,1) = 0.5_R8 * (dmb2(target_offset,jsep+1,iatm,1) + dmb2(topix(target_offset,jsep+1), & + topiy(target_offset,jsep+1), imol, 1)) + tmbsepi(imol,1) = 0.5_R8/ev * (tmb2(target_offset,jsep+1,iatm,1) + tmb2(topix(target_offset,jsep+1), & + topiy(target_offset,jsep+1), imol, 1)) + end do + endif if(xymap(-1,jsep).gt.0 .and. xymap(topix(-1,jsep),topiy(-1,jsep)).gt.0) then tpsepi(1) = 0.5_R8 * (target_temp(xymap(-1,jsep),1) + target_temp(xymap(topix(-1,jsep),topiy(-1,jsep)),1)) else @@ -759,9 +927,24 @@ subroutine b2mwti (itim, tim, & endif posepi(1) = 0.5_R8 * (po(-1+target_offset,jsep) + po(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep))) else + do is = 0, ns-1 + nasepi(is+1,1) = na(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep),is) + end do nesepi(1) = ne(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep)) tesepi(1) = 1.0_R8/ev * te(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep)) tisepi(1) = 1.0_R8/ev * ti(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep)) + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepi(iatm,1) = dab2(topix(target_offset,jsep+1),topiy(target_offset,jsep+1),iatm,1) + tabsepi(iatm,1) = 1.0_R8/ev * tab2(topix(target_offset,jsep+1),topiy(target_offset,jsep+1),iatm,1) + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepi(imol,1) = dmb2(topix(target_offset,jsep+1),topiy(target_offset,jsep+1),iatm,1) + tmbsepi(imol,1) = 1.0_R8/ev * tmb2(topix(target_offset,jsep+1),topiy(target_offset,jsep+1),iatm,1) + end do + endif if(xymap(topix(-1,jsep),topiy(-1,jsep)).gt.0) then tpsepi(1) = target_temp(xymap(topix(-1,jsep),topiy(-1,jsep)),1) else @@ -769,9 +952,24 @@ subroutine b2mwti (itim, tim, & endif posepi(1) = po(topix(-1+target_offset,jsep),topiy(-1+target_offset,jsep)) endif + do is = 0, ns-1 + nasepm(is+1,1) = 0.5_R8 * (na(jxa,jsep,is)+ na(topix(jxa,jsep),topiy(jxa,jsep),is)) + end do nesepm(1) = 0.5_R8 * (ne(jxa,jsep)+ ne(topix(jxa,jsep),topiy(jxa,jsep))) tesepm(1) = 0.5_R8 * (te(jxa,jsep)+ te(topix(jxa,jsep),topiy(jxa,jsep)))/ev tisepm(1) = 0.5_R8 * (ti(jxa,jsep)+ ti(topix(jxa,jsep),topiy(jxa,jsep)))/ev + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepm(iatm,1) = 0.5_R8 * (dab2(jxa+1,jsep+1,iatm,1)+ dab2(topix(jxa+1,jsep+1),topiy(jxa+1,jsep+1),iatm,1)) + tabsepm(iatm,1) = 0.5_R8 * (tab2(jxa+1,jsep+1,iatm,1)+ tab2(topix(jxa+1,jsep+1),topiy(jxa+1,jsep+1),iatm,1))/ev + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepm(imol,1) = 0.5_R8 * (dmb2(jxa+1,jsep+1,imol,1)+ dmb2(topix(jxa+1,jsep+1),topiy(jxa+1,jsep+1),imol,1)) + tmbsepm(imol,1) = 0.5_R8 * (tmb2(jxa+1,jsep+1,imol,1)+ tmb2(topix(jxa+1,jsep+1),topiy(jxa+1,jsep+1),imol,1))/ev + end do + endif posepm(1) = 0.5_R8 * (po(jxa,jsep)+ po(topix(jxa,jsep),topiy(jxa,jsep))) dnsepm(1) = 0.5_R8 * (dna0(jxa,jsep,ismain)+ dna0(topix(jxa,jsep),topiy(jxa,jsep),ismain)) dpsepm(1) = 0.5_R8 * ( & @@ -792,9 +990,28 @@ subroutine b2mwti (itim, tim, & vsa0(topix(jxa,jsep),topiy(jxa,jsep),ismain)/ & (mp*am(ismain)*na(topix(jxa,jsep),topiy(jxa,jsep),ismain))) if(nnreg(0).ne.2) then + do is = 0, ns-1 + nasepa(is+1,1) = 0.5_R8 * (na(nx-target_offset,jsep,is)+ na(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep),is)) + end do nesepa(1) = 0.5_R8 * (ne(nx-target_offset,jsep)+ ne(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep))) tesepa(1) = 0.5_R8/ev * (te(nx-target_offset,jsep)+ te(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep))) tisepa(1) = 0.5_R8/ev * (ti(nx-target_offset,jsep)+ ti(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep))) + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepa(iatm,1) = 0.5_R8 * (dab2(nx-target_offset+1,jsep+1,iatm,1) + dab2(topix(nx-target_offset+1,jsep+1), & + topiy(nx-target_offset+1,jsep+1), iatm, 1)) + tabsepa(iatm,1) = 0.5_R8/ev * (tab2(nx-target_offset+1,jsep+1,iatm,1) + tab2(topix(nx-target_offset+1,jsep+1), & + topiy(nx-target_offset+1,jsep+1), iatm, 1)) + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepa(imol,1) = 0.5_R8 * (dmb2(nx-target_offset+1,jsep+1,iatm,1) + dmb2(topix(nx-target_offset+1,jsep+1), & + topiy(nx-target_offset+1,jsep+1), imol, 1)) + tmbsepa(imol,1) = 0.5_R8/ev * (tmb2(nx-target_offset+1,jsep+1,iatm,1) + tmb2(topix(nx-target_offset+1,jsep+1), & + topiy(nx-target_offset+1,jsep+1), imol, 1)) + end do + endif if(xymap(nx,jsep).gt.0 .and. xymap(topix(nx,jsep),topiy(nx,jsep)).ge.0) then tpsepa(1) = 0.5_R8 * (target_temp(xymap(nx,jsep),1)+ target_temp(xymap(topix(nx,jsep),topiy(nx,jsep)),1)) else @@ -802,9 +1019,24 @@ subroutine b2mwti (itim, tim, & endif posepa(1) = 0.5_R8 *(po(nx-target_offset,jsep)+po(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep))) else + do is = 0, ns-1 + nasepa(is+1,1) = na(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep),is) + end do nesepa(1) = ne(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep)) tesepa(1) = 1.0_R8/ev*te(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep)) tisepa(1) = 1.0_R8/ev*ti(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep)) + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepa(iatm,1) = dab2(topix(nx-target_offset+1,jsep+1),topiy(nx-target_offset+1,jsep+1),iatm,1) + tabsepa(iatm,1) = 1.0_R8/ev*tab2(topix(nx-target_offset+1,jsep+1),topiy(nx-target_offset+1,jsep+1),iatm,1) + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepa(imol,1) = dmb2(topix(nx-target_offset+1,jsep+1),topiy(nx-target_offset+1,jsep+1),iatm,1) + tmbsepa(imol,1) = 1.0_R8/ev*tmb2(topix(nx-target_offset+1,jsep+1),topiy(nx-target_offset+1,jsep+1),iatm,1) + end do + endif if(xymap(topix(nx,jsep),topiy(nx,jsep)).gt.0) then tpsepa(1) = target_temp(xymap(topix(nx,jsep),topiy(nx,jsep)),1) else @@ -813,18 +1045,53 @@ subroutine b2mwti (itim, tim, & posepa(1) = po(topix(nx-target_offset,jsep),topiy(nx-target_offset,jsep)) endif if(nncut.eq.2) then + do is = 0, ns-1 + nasepa(is+1,2) = 0.5_R8 * (na(ixtr+target_offset,jsep,is)+na(topix(ixtr+target_offset,jsep),& + topiy(ixtr+target_offset,jsep),is)) + end do nesepa(2) = 0.5_R8 * (ne(ixtr+target_offset,jsep)+ne(topix(ixtr+target_offset,jsep),topiy(ixtr+target_offset,jsep))) tesepa(2) = 0.5_R8 * (te(ixtr+target_offset,jsep)+te(topix(ixtr+target_offset,jsep),topiy(ixtr+target_offset,jsep)))/ev tisepa(2) = 0.5_R8 * (ti(ixtr+target_offset,jsep)+ti(topix(ixtr+target_offset,jsep),topiy(ixtr+target_offset,jsep)))/ev + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepa(iatm,2) = 0.5_R8 * (dab2(ixtr+target_offset+1,jsep+1,iatm,1) + dab2(topix(ixtr+target_offset+1,jsep+1), & + topiy(ixtr+target_offset+1,jsep+1), iatm, 1)) + tabsepa(iatm,2) = 0.5_R8 * (tab2(ixtr+target_offset+1,jsep+1,iatm,1) + tab2(topix(ixtr+target_offset+1,jsep+1), & + topiy(ixtr+target_offset+1,jsep+1), iatm, 1))/ev + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepa(imol,2) = 0.5_R8 * (dmb2(ixtr+target_offset+1,jsep+1,iatm,1) + dmb2(topix(ixtr+target_offset+1,jsep+1), & + topiy(ixtr+target_offset+1,jsep+1), imol, 1)) + tmbsepa(imol,2) = 0.5_R8 * (tmb2(ixtr+target_offset+1,jsep+1,iatm,1) + tmb2(topix(ixtr+target_offset+1,jsep+1), & + topiy(ixtr+target_offset+1,jsep+1), imol, 1))/ev + end do + endif if(xymap(ixtr,jsep).gt.0 .and. xymap(topix(ixtr,jsep),topiy(ixtr,jsep)).gt.0) then tpsepa(2) = 0.5_R8 *(target_temp(xymap(ixtr,jsep),1)+target_temp(xymap(topix(ixtr,jsep),topiy(ixtr,jsep)),1)) else tpsepa(2) = 0.0_R8 endif posepa(2) = 0.5_R8 * (po(ixtr+target_offset,jsep)+ po(topix(ixtr+target_offset,jsep),topiy(ixtr+target_offset,jsep))) + do is = 0, ns-1 + nasepm(is+1,2) = 0.5_R8 * (na(jxi,jsep,is)+ na(topix(jxi,jsep),topiy(jxi,jsep),is)) + end do nesepm(2) = 0.5_R8 * (ne(jxi,jsep)+ ne(topix(jxi,jsep),topiy(jxi,jsep))) tesepm(2) = 0.5_R8 * (te(jxi,jsep)+ te(topix(jxi,jsep),topiy(jxi,jsep)))/ev tisepm(2) = 0.5_R8 * (ti(jxi,jsep)+ ti(topix(jxi,jsep),topiy(jxi,jsep)))/ev + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepm(iatm,2) = 0.5_R8 * (dab2(jxi+1,jsep+1,iatm,1)+ dab2(topix(jxi+1,jsep+1),topiy(jxi+1,jsep+1),iatm,1)) + tabsepm(iatm,2) = 0.5_R8 * (tab2(jxi+1,jsep+1,iatm,1)+ tab2(topix(jxi+1,jsep+1),topiy(jxi+1,jsep+1),iatm,1))/ev + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepm(imol,2) = 0.5_R8 * (dmb2(jxi+1,jsep+1,imol,1)+ dmb2(topix(jxi+1,jsep+1),topiy(jxi+1,jsep+1),imol,1)) + tmbsepm(imol,2) = 0.5_R8 * (tmb2(jxi+1,jsep+1,imol,1)+ tmb2(topix(jxi+1,jsep+1),topiy(jxi+1,jsep+1),imol,1))/ev + end do + endif posepm(2) = 0.5_R8 * (po(jxi,jsep)+ po(topix(jxi,jsep),topiy(jxi,jsep))) dnsepm(2) = 0.5_R8 * (dna0(jxi,jsep,ismain)+ dna0(topix(jxi,jsep),topiy(jxi,jsep),ismain)) dpsepm(2) = 0.5_R8 * ( & @@ -842,9 +1109,29 @@ subroutine b2mwti (itim, tim, & vssepm(2) = 0.5_R8 * ( & vsa0(jxi,jsep,ismain)/(mp*am(ismain)*na(jxi,jsep,ismain)) + vsa0(topix(jxi,jsep),topiy(jxi,jsep),ismain)/ & (mp*am(ismain)*na(topix(jxi,jsep),topiy(jxi,jsep),ismain))) + do is = 0, ns-1 + nasepi(is+1,2) = 0.5_R8 * (na(ixtl-target_offset,jsep,is)+ na(topix(ixtl-target_offset,jsep), & + topiy(ixtl-target_offset,jsep),is)) + end do nesepi(2) = 0.5_R8 * (ne(ixtl-target_offset,jsep)+ ne(topix(ixtl-target_offset,jsep), topiy(ixtl-target_offset,jsep))) tesepi(2) = 0.5_R8 * (te(ixtl-target_offset,jsep)+ te(topix(ixtl-target_offset,jsep), topiy(ixtl-target_offset,jsep)))/ev tisepi(2) = 0.5_R8 * (ti(ixtl-target_offset,jsep)+ ti(topix(ixtl-target_offset,jsep), topiy(ixtl-target_offset,jsep)))/ev + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepi(iatm,2) = 0.5_R8 * (dab2(ixtl-target_offset+1,jsep+1,iatm,1) + dab2(topix(ixtl-target_offset+1,jsep+1), & + topiy(ixtl-target_offset+1,jsep+1), iatm, 1)) + tabsepi(iatm,2) = 0.5_R8 * (tab2(ixtl-target_offset+1,jsep+1,iatm,1) + tab2(topix(ixtl-target_offset+1,jsep+1), & + topiy(ixtl-target_offset+1,jsep+1), iatm, 1))/ev + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepi(imol,2) = 0.5_R8 * (dmb2(ixtl-target_offset+1,jsep+1,iatm,1) + dmb2(topix(ixtl-target_offset+1,jsep+1), & + topiy(ixtl-target_offset+1,jsep+1), imol, 1)) + tmbsepi(imol,2) = 0.5_R8 * (tmb2(ixtl-target_offset+1,jsep+1,iatm,1) + tmb2(topix(ixtl-target_offset+1,jsep+1), & + topiy(ixtl-target_offset+1,jsep+1), imol, 1))/ev + end do + endif if(xymap(ixtl,jsep).gt.0 .and. xymap(topix(ixtl,jsep),topiy(ixtl,jsep)).gt.0) then tpsepi(2) = 0.5_R8 * (target_temp(xymap(ixtl,jsep),1)+ target_temp(xymap(topix(ixtl,jsep),topiy(ixtl,jsep)),1)) else @@ -852,14 +1139,44 @@ subroutine b2mwti (itim, tim, & endif posepi(2) = 0.5_R8 * (po(ixtl-target_offset,jsep) + po(topix(ixtl-target_offset,jsep),topiy(ixtl-target_offset,jsep))) endif + do is = 0, ns-1 + nasepa(is+1,nc+1:nncutmax) = 0.0_R8 + end do nesepa(nc+1:nncutmax) = 0.0_R8 tesepa(nc+1:nncutmax) = 0.0_R8 tisepa(nc+1:nncutmax) = 0.0_R8 + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepa(iatm,nc+1:nncutmax) = 0.0_R8 + tabsepa(iatm,nc+1:nncutmax) = 0.0_R8 + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepa(imol,nc+1:nncutmax) = 0.0_R8 + tmbsepa(imol,nc+1:nncutmax) = 0.0_R8 + end do + endif tpsepa(nc+1:nncutmax) = 0.0_R8 posepa(nc+1:nncutmax) = 0.0_R8 + do is = 0, ns-1 + nasepm(is+1,nc+1:nncutmax) = 0.0_R8 + end do nesepm(nc+1:nncutmax) = 0.0_R8 tesepm(nc+1:nncutmax) = 0.0_R8 tisepm(nc+1:nncutmax) = 0.0_R8 + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepm(iatm,nc+1:nncutmax) = 0.0_R8 + tabsepm(iatm,nc+1:nncutmax) = 0.0_R8 + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepm(imol,nc+1:nncutmax) = 0.0_R8 + tmbsepm(imol,nc+1:nncutmax) = 0.0_R8 + end do + endif posepm(nc+1:nncutmax) = 0.0_R8 dnsepm(nc+1:nncutmax) = 0.0_R8 dpsepm(nc+1:nncutmax) = 0.0_R8 @@ -868,10 +1185,25 @@ subroutine b2mwti (itim, tim, & vxsepm(nc+1:nncutmax) = 0.0_R8 vysepm(nc+1:nncutmax) = 0.0_R8 vssepm(nc+1:nncutmax) = 0.0_R8 + do is = 0, ns-1 + nasepi(is+1,nc+1:nncutmax) = 0.0_R8 + end do nesepi(nc+1:nncutmax) = 0.0_R8 tesepi(nc+1:nncutmax) = 0.0_R8 tisepi(nc+1:nncutmax) = 0.0_R8 tpsepi(nc+1:nncutmax) = 0.0_R8 + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepi(iatm,nc+1:nncutmax) = 0.0_R8 + tabsepi(iatm,nc+1:nncutmax) = 0.0_R8 + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepi(imol,nc+1:nncutmax) = 0.0_R8 + tmbsepi(imol,nc+1:nncutmax) = 0.0_R8 + end do + endif posepi(nc+1:nncutmax) = 0.0_R8 #endif ! @@ -923,45 +1255,177 @@ subroutine b2mwti (itim, tim, & enddo #endif + allocate(na3dl(nybl, ns)) + allocate(na3di(nyi, ns)) + allocate(na3da(nya, ns)) + allocate(na3dr(nybr, ns)) + allocate(dn3di(nyi, ns)) + allocate(dn3da(nya, ns)) + allocate(dp3di(nyi, ns)) + allocate(dp3da(nya, ns)) + allocate(vx3di(nyi, ns)) + allocate(vx3da(nya, ns)) + allocate(vy3di(nyi, ns)) + allocate(vy3da(nya, ns)) + allocate(vs3di(nyi, ns)) + allocate(vs3da(nya, ns)) + allocate(fn3dl(nybl, ns)) + allocate(fn3dr(nybr, ns)) + + na3dl=0.0_R8 + na3di=0.0_R8 + na3da=0.0_R8 + na3dr=0.0_R8 + dn3di=0.0_R8 + dn3da=0.0_R8 + dp3di=0.0_R8 + dp3da=0.0_R8 + vx3di=0.0_R8 + vx3da=0.0_R8 + vy3di=0.0_R8 + vy3da=0.0_R8 + vs3di=0.0_R8 + vs3da=0.0_R8 + fn3dl=0.0_R8 + fn3dr=0.0_R8 + + do is = 0, ns-1 + na3dl(:, is+1) = na(-1+target_offset,iylstrt:iylend,is) + na3di(:, is+1) = na(jxi,iyistrt:iyiend,is) + na3da(:, is+1) = na(jxa,iyastrt:iyaend,is) + na3dr(:, is+1) = na(nx-target_offset,iyrstrt:iyrend,is) + dn3di(:, is+1) = dna0(jxi,iyistrt:iyiend,is) + dn3da(:, is+1) = dna0(jxa,iyastrt:iyaend,is) + dp3di(:, is+1) = dpa0(jxi,iyistrt:iyiend,is)*(rza(jxi,iyistrt:iyiend,is)*te(jxi,iyistrt:iyiend)+ti(jxi,iyistrt:iyiend)) + dp3da(:, is+1) = dpa0(jxa,iyastrt:iyaend,is)*(rza(jxa,iyastrt:iyaend,is)*te(jxa,iyastrt:iyaend)+ti(jxa,iyastrt:iyaend)) + vx3di(:, is+1) = vla0(jxi,iyistrt:iyiend,0,is) + vx3da(:, is+1) = vla0(jxa,iyastrt:iyaend,0,is) + vy3di(:, is+1) = vla0(jxi,iyistrt:iyiend,1,is) + vy3da(:, is+1) = vla0(jxa,iyastrt:iyaend,1,is) + vs3di(:, is+1) = vsa0(jxi,iyistrt:iyiend,is)/(mp*am(is)*na(jxi,iyistrt:iyiend,is)) + vs3da(:, is+1) = vsa0(jxa,iyastrt:iyaend,is)/(mp*am(is)*na(jxa,iyastrt:iyaend,is)) + fn3dl(:, is+1) = fna(0,iylstrt:iylend,0,is) + fn3dr(:, is+1) = fna(nx,iyrstrt:iyrend,0,is) + end do + + if (nnreg(0).ge.7) then + + allocate(na3dtl(nytl, ns)) + allocate(na3dtr(nytr, ns)) + allocate(fn3dtl(nytl, ns)) + allocate(fn3dtr(nytr, ns)) + + na3dtl=0.0_R8 + na3dtr=0.0_R8 + fn3dtl=0.0_R8 + fn3dtr=0.0_R8 + + do is = 0, ns-1 + na3dtl(:, is+1) = na(ixtl-target_offset,iytlstrt:iytlend,is) + na3dtr(:, is+1) = na(ixtr+target_offset,iytrstrt:iytrend,is) + fn3dtl(:, is+1) = fna(ixtl,iytlstrt:iytlend,0,is) + fn3dtr(:, is+1) = fna(ixtr+1,iytrstrt:iytrend,0,is) + end do + + endif + !wdk update batch averages if (luav) then if (ntim_batch .gt. 0 ) then + call batch_average(nncutmax*ns,nasepm,nasepm_av,itim,ntim_batch) call batch_average(nncutmax,nesepm,nesepm_av,itim,ntim_batch) call batch_average(nncutmax,tesepm,tesepm_av,itim,ntim_batch) call batch_average(nncutmax,tisepm,tisepm_av,itim,ntim_batch) + if (nnatmi.gt.0) then + call batch_average(nncutmax*nnatmi,dabsepm,dabsepm_av,itim,ntim_batch) + call batch_average(nncutmax*nnatmi,tabsepm,tabsepm_av,itim,ntim_batch) + endif + if (nnmoli.gt.0) then + call batch_average(nncutmax*nnmoli,dmbsepm,dmbsepm_av,itim,ntim_batch) + call batch_average(nncutmax*nnmoli,tmbsepm,tmbsepm_av,itim,ntim_batch) + endif call batch_average(nncutmax,posepm,posepm_av,itim,ntim_batch) + call batch_average(nncutmax*ns,nasepi,nasepi_av,itim,ntim_batch) call batch_average(nncutmax,nesepi,nesepi_av,itim,ntim_batch) call batch_average(nncutmax,tesepi,tesepi_av,itim,ntim_batch) call batch_average(nncutmax,tisepi,tisepi_av,itim,ntim_batch) + if (nnatmi.gt.0) then + call batch_average(nncutmax*nnatmi,dabsepi,dabsepi_av,itim,ntim_batch) + call batch_average(nncutmax*nnatmi,tabsepi,tabsepi_av,itim,ntim_batch) + endif + if (nnmoli.gt.0) then + call batch_average(nncutmax*nnmoli,dmbsepi,dmbsepi_av,itim,ntim_batch) + call batch_average(nncutmax*nnmoli,tmbsepi,tmbsepi_av,itim,ntim_batch) + endif call batch_average(nncutmax,posepi,posepi_av,itim,ntim_batch) + call batch_average(nncutmax*ns,nasepa,nasepa_av,itim,ntim_batch) call batch_average(nncutmax,nesepa,nesepa_av,itim,ntim_batch) call batch_average(nncutmax,tesepa,tesepa_av,itim,ntim_batch) call batch_average(nncutmax,tisepa,tisepa_av,itim,ntim_batch) + if (nnatmi.gt.0) then + call batch_average(nncutmax*nnatmi,dabsepa,dabsepa_av,itim,ntim_batch) + call batch_average(nncutmax*nnatmi,tabsepa,tabsepa_av,itim,ntim_batch) + endif + if (nnmoli.gt.0) then + call batch_average(nncutmax*nnmoli,dmbsepa,dmbsepa_av,itim,ntim_batch) + call batch_average(nncutmax*nnmoli,tmbsepa,tmbsepa_av,itim,ntim_batch) + endif call batch_average(nncutmax,posepa,posepa_av,itim,ntim_batch) + call batch_average(nncutmax*ns,namxip,namxip_av,itim,ntim_batch) call batch_average(nncutmax,nemxip,nemxip_av,itim,ntim_batch) call batch_average(nncutmax,temxip,temxip_av,itim,ntim_batch) call batch_average(nncutmax,timxip,timxip_av,itim,ntim_batch) call batch_average(nncutmax,pomxip,pomxip_av,itim,ntim_batch) + call batch_average(nncutmax*ns,namxap,namxap_av,itim,ntim_batch) call batch_average(nncutmax,nemxap,nemxap_av,itim,ntim_batch) call batch_average(nncutmax,temxap,temxap_av,itim,ntim_batch) call batch_average(nncutmax,timxap,timxap_av,itim,ntim_batch) call batch_average(nncutmax,pomxap,pomxap_av,itim,ntim_batch) + call batch_average_sq(nncutmax*ns,nasepm,nasepm_std,itim,ntim_batch) call batch_average_sq(nncutmax,nesepm,nesepm_std,itim,ntim_batch) call batch_average_sq(nncutmax,tesepm,tesepm_std,itim,ntim_batch) call batch_average_sq(nncutmax,tisepm,tisepm_std,itim,ntim_batch) + if (nnatmi.gt.0) then + call batch_average_sq(nncutmax*nnatmi,dabsepm,dabsepm_std,itim,ntim_batch) + call batch_average_sq(nncutmax*nnatmi,tabsepm,tabsepm_std,itim,ntim_batch) + endif + if (nnmoli.gt.0) then + call batch_average_sq(nncutmax*nnmoli,dmbsepm,dmbsepm_std,itim,ntim_batch) + call batch_average_sq(nncutmax*nnmoli,tmbsepm,tmbsepm_std,itim,ntim_batch) + endif call batch_average_sq(nncutmax,posepm,posepm_std,itim,ntim_batch) + call batch_average_sq(nncutmax*ns,nasepi,nasepi_std,itim,ntim_batch) call batch_average_sq(nncutmax,nesepi,nesepi_std,itim,ntim_batch) call batch_average_sq(nncutmax,tesepi,tesepi_std,itim,ntim_batch) call batch_average_sq(nncutmax,tisepi,tisepi_std,itim,ntim_batch) + if (nnatmi.gt.0) then + call batch_average_sq(nncutmax*nnatmi,dabsepi,dabsepi_std,itim,ntim_batch) + call batch_average_sq(nncutmax*nnatmi,tabsepi,tabsepi_std,itim,ntim_batch) + endif + if (nnmoli.gt.0) then + call batch_average_sq(nncutmax*nnmoli,dmbsepi,dmbsepi_std,itim,ntim_batch) + call batch_average_sq(nncutmax*nnmoli,tmbsepi,tmbsepi_std,itim,ntim_batch) + endif call batch_average_sq(nncutmax,posepi,posepi_std,itim,ntim_batch) + call batch_average_sq(nncutmax*ns,nasepa,nasepa_std,itim,ntim_batch) call batch_average_sq(nncutmax,nesepa,nesepa_std,itim,ntim_batch) call batch_average_sq(nncutmax,tesepa,tesepa_std,itim,ntim_batch) call batch_average_sq(nncutmax,tisepa,tisepa_std,itim,ntim_batch) + if (nnatmi.gt.0) then + call batch_average_sq(nncutmax*nnatmi,dabsepa,dabsepa_std,itim,ntim_batch) + call batch_average_sq(nncutmax*nnatmi,tabsepa,tabsepa_std,itim,ntim_batch) + endif + if (nnmoli.gt.0) then + call batch_average_sq(nncutmax*nnmoli,dmbsepa,dmbsepa_std,itim,ntim_batch) + call batch_average_sq(nncutmax*nnmoli,tmbsepa,tmbsepa_std,itim,ntim_batch) + endif call batch_average_sq(nncutmax,posepa,posepa_std,itim,ntim_batch) + call batch_average_sq(nncutmax*ns,namxip,namxip_std,itim,ntim_batch) call batch_average_sq(nncutmax,nemxip,nemxip_std,itim,ntim_batch) call batch_average_sq(nncutmax,temxip,temxip_std,itim,ntim_batch) call batch_average_sq(nncutmax,timxip,timxip_std,itim,ntim_batch) call batch_average_sq(nncutmax,pomxip,pomxip_std,itim,ntim_batch) + call batch_average_sq(nncutmax*ns,namxap,namxap_std,itim,ntim_batch) call batch_average_sq(nncutmax,nemxap,nemxap_std,itim,ntim_batch) call batch_average_sq(nncutmax,temxap,temxap_std,itim,ntim_batch) call batch_average_sq(nncutmax,timxap,timxap_std,itim,ntim_batch) @@ -978,8 +1442,35 @@ subroutine b2mwti (itim, tim, & imap(1)=1 tstepn(1) = ntstep call rwcdf(rw,ncid,'ntstep',imap,tstepn,iret) + jxin(1) = jxi + call rwcdf(rw,ncid,'jxi',imap,jxin,iret) + jxan(1) = jxa + call rwcdf(rw,ncid,'jxa',imap,jxan,iret) + jsepn(1) = jsep + call rwcdf(rw,ncid,'jsep',imap,jsepn,iret) + call rwcdf(rw,ncid,'dsl',imap,dsl,iret) + call rwcdf(rw,ncid,'dsi',imap,dsi,iret) + call rwcdf(rw,ncid,'dsa',imap,dsa,iret) + call rwcdf(rw,ncid,'dsr',imap,dsr,iret) + if (nnreg(0).ge.7) then + call rwcdf(rw,ncid,'dstl',imap,dstl,iret) + call rwcdf(rw,ncid,'dstr',imap,dstr,iret) + endif + call rwcdf(rw,ncid,'dsLT',imap,dsLT,iret) + call rwcdf(rw,ncid,'dsRT',imap,dsRT,iret) + if (nnreg(0).ge.7) then + call rwcdf(rw,ncid,'dsTLT',imap,dsTLT,iret) + call rwcdf(rw,ncid,'dsTRT',imap,dsTRT,iret) + endif + call rwcdf(rw,ncid,'dsLP',imap,dsLP,iret) + call rwcdf(rw,ncid,'dsRP',imap,dsRP,iret) + if (nnreg(0).ge.7) then + call rwcdf(rw,ncid,'dsTLP',imap,dsTLP,iret) + call rwcdf(rw,ncid,'dsTRP',imap,dsTRP,iret) + endif call rwcdf(rw,ncid,'timesa',imap,timesa,iret) if (write_2d .ge. 1) then + call rwcdf(rw,ncid,'na2d',(/1,1,1,1/),na,iret) call rwcdf(rw,ncid,'ne2d',(/1,1,1/),ne,iret) call rwcdf(rw,ncid,'te2d',(/1,1,1/),te,iret) call rwcdf(rw,ncid,'ti2d',(/1,1,1/),ti,iret) @@ -1012,13 +1503,31 @@ subroutine b2mwti (itim, tim, & call rwcdf(rw,ncid,'fetxap',imap,fetxap,iret) call rwcdf(rw,ncid,'fchxap',imap,fchxap,iret) + call rwcdf(rw,ncid,'nasepi',(/1,1,1/),nasepi,iret) call rwcdf(rw,ncid,'nesepi',imap,nesepi,iret) call rwcdf(rw,ncid,'tesepi',imap,tesepi,iret) call rwcdf(rw,ncid,'tisepi',imap,tisepi,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepi',(/1,1,1/),dabsepi,iret) + call rwcdf(rw,ncid,'tabsepi',(/1,1,1/),tabsepi,iret) + endif + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dmbsepi',(/1,1,1/),dmbsepi,iret) + call rwcdf(rw,ncid,'tmbsepi',(/1,1,1/),tmbsepi,iret) + endif call rwcdf(rw,ncid,'posepi',imap,posepi,iret) + call rwcdf(rw,ncid,'nasepm',(/1,1,1/),nasepm,iret) call rwcdf(rw,ncid,'nesepm',imap,nesepm,iret) call rwcdf(rw,ncid,'tesepm',imap,tesepm,iret) call rwcdf(rw,ncid,'tisepm',imap,tisepm,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepm',(/1,1,1/),dabsepm,iret) + call rwcdf(rw,ncid,'tabsepm',(/1,1,1/),tabsepm,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepm',(/1,1,1/),dmbsepm,iret) + call rwcdf(rw,ncid,'tmbsepm',(/1,1,1/),tmbsepm,iret) + endif call rwcdf(rw,ncid,'posepm',imap,posepm,iret) call rwcdf(rw,ncid,'dnsepm',imap,dnsepm,iret) call rwcdf(rw,ncid,'dpsepm',imap,dpsepm,iret) @@ -1027,14 +1536,25 @@ subroutine b2mwti (itim, tim, & call rwcdf(rw,ncid,'vxsepm',imap,vxsepm,iret) call rwcdf(rw,ncid,'vysepm',imap,vysepm,iret) call rwcdf(rw,ncid,'vssepm',imap,vssepm,iret) + call rwcdf(rw,ncid,'nasepa',(/1,1,1/),nasepa,iret) call rwcdf(rw,ncid,'nesepa',imap,nesepa,iret) call rwcdf(rw,ncid,'tesepa',imap,tesepa,iret) call rwcdf(rw,ncid,'tisepa',imap,tisepa,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepa',(/1,1,1/),dabsepa,iret) + call rwcdf(rw,ncid,'tabsepa',(/1,1,1/),tabsepa,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepa',(/1,1,1/),dmbsepa,iret) + call rwcdf(rw,ncid,'tmbsepa',(/1,1,1/),tmbsepa,iret) + endif call rwcdf(rw,ncid,'posepa',imap,posepa,iret) + call rwcdf(rw,ncid,'namxip',(/1,1,1/),namxip,iret) call rwcdf(rw,ncid,'nemxip',imap,nemxip,iret) call rwcdf(rw,ncid,'temxip',imap,temxip,iret) call rwcdf(rw,ncid,'timxip',imap,timxip,iret) call rwcdf(rw,ncid,'pomxip',imap,pomxip,iret) + call rwcdf(rw,ncid,'namxap',(/1,1,1/),namxap,iret) call rwcdf(rw,ncid,'nemxap',imap,nemxap,iret) call rwcdf(rw,ncid,'temxap',imap,temxap,iret) call rwcdf(rw,ncid,'timxap',imap,timxap,iret) @@ -1085,11 +1605,13 @@ subroutine b2mwti (itim, tim, & ! imap(1)=nx+2 ! bl imap(2)=1 + + call rwcdf(rw,ncid,'na3dl',(/1,1,1/),na3dl,iret) call rwcdf(rw,ncid,'ne3dl',imap,ne(-1+target_offset,iylstrt),iret) call rwcdf(rw,ncid,'te3dl',imap,te(-1+target_offset,iylstrt),iret) call rwcdf(rw,ncid,'ti3dl',imap,ti(-1+target_offset,iylstrt),iret) call rwcdf(rw,ncid,'po3dl',imap,po(-1+target_offset,iylstrt),iret) - call rwcdf(rw,ncid,'fn3dl',imap,fna(0,iylstrt,0,ismain),iret) + call rwcdf(rw,ncid,'fn3dl',(/1,1,1/),fn3dl,iret) call rwcdf(rw,ncid,'fe3dl',imap,fhe(0,iylstrt,0),iret) call rwcdf(rw,ncid,'fi3dl',imap,fhi(0,iylstrt,0),iret) call rwcdf(rw,ncid,'fc3dl',imap,fch(0,iylstrt,0),iret) @@ -1097,23 +1619,26 @@ subroutine b2mwti (itim, tim, & call rwcdf(rw,ncid,'fo3dl',imap,fni(0,iylstrt,0),iret) imap(1)=nx+2 ! i imap(2)=1 + call rwcdf(rw,ncid,'na3di',(/1,1,1/),na3di,iret) call rwcdf(rw,ncid,'ne3di',imap,ne(jxi,iyistrt),iret) call rwcdf(rw,ncid,'te3di',imap,te(jxi,iyistrt),iret) call rwcdf(rw,ncid,'ti3di',imap,ti(jxi,iyistrt),iret) call rwcdf(rw,ncid,'po3di',imap,po(jxi,iyistrt),iret) imap(1)=nx+2 ! a imap(2)=1 + call rwcdf(rw,ncid,'na3da',(/1,1,1/),na3da,iret) call rwcdf(rw,ncid,'ne3da',imap,ne(jxa,iyastrt),iret) call rwcdf(rw,ncid,'te3da',imap,te(jxa,iyastrt),iret) call rwcdf(rw,ncid,'ti3da',imap,ti(jxa,iyastrt),iret) call rwcdf(rw,ncid,'po3da',imap,po(jxa,iyastrt),iret) imap(1)=nx+2 ! br imap(2)=1 + call rwcdf(rw,ncid,'na3dr',(/1,1,1/),na3dr,iret) call rwcdf(rw,ncid,'ne3dr',imap,ne(nx-target_offset,iyrstrt),iret) call rwcdf(rw,ncid,'te3dr',imap,te(nx-target_offset,iyrstrt),iret) call rwcdf(rw,ncid,'ti3dr',imap,ti(nx-target_offset,iyrstrt),iret) call rwcdf(rw,ncid,'po3dr',imap,po(nx-target_offset,iyrstrt),iret) - call rwcdf(rw,ncid,'fn3dr',imap,fna(nx,iyrstrt,0,ismain),iret) + call rwcdf(rw,ncid,'fn3dr',(/1,1,1/),fn3dr,iret) call rwcdf(rw,ncid,'fe3dr',imap,fhe(nx,iyrstrt,0),iret) call rwcdf(rw,ncid,'fi3dr',imap,fhi(nx,iyrstrt,0),iret) call rwcdf(rw,ncid,'fc3dr',imap,fch(nx,iyrstrt,0),iret) @@ -1122,11 +1647,12 @@ subroutine b2mwti (itim, tim, & if (nnreg(0).ge.7) then imap(1)=nx+2 ! tr imap(2)=1 + call rwcdf(rw,ncid,'na3dtr',(/1,1,1/),na3dtr,iret) call rwcdf(rw,ncid,'ne3dtr',imap,ne(ixtr+target_offset,iytrstrt),iret) call rwcdf(rw,ncid,'te3dtr',imap,te(ixtr+target_offset,iytrstrt),iret) call rwcdf(rw,ncid,'ti3dtr',imap,ti(ixtr+target_offset,iytrstrt),iret) call rwcdf(rw,ncid,'po3dtr',imap,po(ixtr+target_offset,iytrstrt),iret) - call rwcdf(rw,ncid,'fn3dtr',imap,fna(ixtr+1,iytrstrt,0,ismain),iret) + call rwcdf(rw,ncid,'fn3dtr',(/1,1,1/),fn3dtr,iret) call rwcdf(rw,ncid,'fe3dtr',imap,fhe(ixtr+1,iytrstrt,0),iret) call rwcdf(rw,ncid,'fi3dtr',imap,fhi(ixtr+1,iytrstrt,0),iret) call rwcdf(rw,ncid,'fc3dtr',imap,fch(ixtr+1,iytrstrt,0),iret) @@ -1134,11 +1660,12 @@ subroutine b2mwti (itim, tim, & call rwcdf(rw,ncid,'fo3dtr',imap,fni(ixtr+1,iytrstrt,0),iret) imap(1)=nx+2 ! tl imap(2)=1 + call rwcdf(rw,ncid,'na3dtl',(/1,1,1/),na3dtl,iret) call rwcdf(rw,ncid,'ne3dtl',imap,ne(ixtl-target_offset,iytlstrt),iret) call rwcdf(rw,ncid,'te3dtl',imap,te(ixtl-target_offset,iytlstrt),iret) call rwcdf(rw,ncid,'ti3dtl',imap,ti(ixtl-target_offset,iytlstrt),iret) call rwcdf(rw,ncid,'po3dtl',imap,po(ixtl-target_offset,iytlstrt),iret) - call rwcdf(rw,ncid,'fn3dtl',imap,fna(ixtl,iytlstrt,0,ismain),iret) + call rwcdf(rw,ncid,'fn3dtl',(/1,1,1/),fn3dtl,iret) call rwcdf(rw,ncid,'fe3dtl',imap,fhe(ixtl,iytlstrt,0),iret) call rwcdf(rw,ncid,'fi3dtl',imap,fhi(ixtl,iytlstrt,0),iret) call rwcdf(rw,ncid,'fc3dtl',imap,fch(ixtl,iytlstrt,0),iret) @@ -1222,6 +1749,147 @@ subroutine b2mwti (itim, tim, & endif endif ! + + if (nnatmi.gt.0) then + allocate(dab3dl(nybl, nnatmi)) + allocate(dab3di(nyi, nnatmi)) + allocate(dab3da(nya, nnatmi)) + allocate(dab3dr(nybr, nnatmi)) + allocate(tab3dl(nybl, nnatmi)) + allocate(tab3di(nyi, nnatmi)) + allocate(tab3da(nya, nnatmi)) + allocate(tab3dr(nybr, nnatmi)) + if (nnreg(0).ge.7) then + allocate(dab3dtl(nytl, nnatmi)) + allocate(dab3dtr(nytr, nnatmi)) + allocate(tab3dtl(nytl, nnatmi)) + allocate(tab3dtr(nytr, nnatmi)) + endif + endif + + if (nnmoli.gt.0) then + allocate(dmb3dl(nybl, nnmoli)) + allocate(dmb3di(nyi, nnmoli)) + allocate(dmb3da(nya, nnmoli)) + allocate(dmb3dr(nybr, nnmoli)) + allocate(tmb3dl(nybl, nnmoli)) + allocate(tmb3di(nyi, nnmoli)) + allocate(tmb3da(nya, nnmoli)) + allocate(tmb3dr(nybr, nnmoli)) + if (nnreg(0).ge.7) then + allocate(dmb3dtl(nytl, nnmoli)) + allocate(dmb3dtr(nytr, nnmoli)) + allocate(tmb3dtl(nytl, nnmoli)) + allocate(tmb3dtr(nytr, nnmoli)) + endif + endif + + if (nnatmi.gt.0) then + dab3dl=0.0_R8 + dab3di=0.0_R8 + dab3da=0.0_R8 + dab3dr=0.0_R8 + tab3dl=0.0_R8 + tab3di=0.0_R8 + tab3da=0.0_R8 + tab3dr=0.0_R8 + if (nnreg(0).ge.7) then + dab3dtl=0.0_R8 + dab3dtr=0.0_R8 + tab3dtl=0.0_R8 + tab3dtr=0.0_R8 + endif + endif + + if (nnmoli.gt.0) then + dmb3dl=0.0_R8 + dmb3di=0.0_R8 + dmb3da=0.0_R8 + dmb3dr=0.0_R8 + tmb3dl=0.0_R8 + tmb3di=0.0_R8 + tmb3da=0.0_R8 + tmb3dr=0.0_R8 + if (nnreg(0).ge.7) then + dmb3dtl=0.0_R8 + dmb3dtr=0.0_R8 + tmb3dtl=0.0_R8 + tmb3dtr=0.0_R8 + endif + endif + + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dab3dl(2:ny+1, iatm)=dab2(1,1:ny,iatm,1) + dab3di(2:ny+1, iatm)=dab2(jxi+1,1:ny,iatm,1) + dab3da(2:ny+1, iatm)=dab2(jxa+1,1:ny,iatm,1) + dab3dr(2:ny+1, iatm)=dab2(nx,1:ny,iatm,1) + tab3dl(2:ny+1, iatm)=tab2(1,1:ny,iatm,1) + tab3di(2:ny+1, iatm)=tab2(jxi+1,1:ny,iatm,1) + tab3da(2:ny+1, iatm)=tab2(jxa+1,1:ny,iatm,1) + tab3dr(2:ny+1, iatm)=tab2(nx,1:ny,iatm,1) + if (nnreg(0).ge.7) then + dab3dtl(2:ny+1, iatm)=dab2(ixtl,1:ny,iatm,1) + dab3dtr(2:ny+1, iatm)=dab2(ixtr+1,1:ny,iatm,1) + tab3dtl(2:ny+1, iatm)=tab2(ixtl,1:ny,iatm,1) + tab3dtr(2:ny+1, iatm)=tab2(ixtr+1,1:ny,iatm,1) + endif + enddo + endif + + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmb3dl(2:ny+1, imol)=dmb2(1,1:ny,imol,1) + dmb3di(2:ny+1, imol)=dmb2(jxi+1,1:ny,imol,1) + dmb3da(2:ny+1, imol)=dmb2(jxa+1,1:ny,imol,1) + dmb3dr(2:ny+1, imol)=dmb2(nx,1:ny,imol,1) + tmb3dl(2:ny+1, imol)=tmb2(1,1:ny,imol,1) + tmb3di(2:ny+1, imol)=tmb2(jxi+1,1:ny,imol,1) + tmb3da(2:ny+1, imol)=tmb2(jxa+1,1:ny,imol,1) + tmb3dr(2:ny+1, imol)=tmb2(nx,1:ny,imol,1) + if (nnreg(0).ge.7) then + dmb3dtl(2:ny+1, imol)=dmb2(ixtl,1:ny,imol,1) + dmb3dtr(2:ny+1, imol)=dmb2(ixtr+1,1:ny,imol,1) + tmb3dtl(2:ny+1, imol)=tmb2(ixtl,1:ny,imol,1) + tmb3dtr(2:ny+1, imol)=tmb2(ixtr+1,1:ny,imol,1) + endif + enddo + endif + + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dab3dl',(/1,1,1/),dab3dl,iret) + call rwcdf(rw,ncid,'dab3di',(/1,1,1/),dab3di,iret) + call rwcdf(rw,ncid,'dab3da',(/1,1,1/),dab3da,iret) + call rwcdf(rw,ncid,'dab3dr',(/1,1,1/),dab3dr,iret) + call rwcdf(rw,ncid,'tab3dl',(/1,1,1/),tab3dl,iret) + call rwcdf(rw,ncid,'tab3di',(/1,1,1/),tab3di,iret) + call rwcdf(rw,ncid,'tab3da',(/1,1,1/),tab3da,iret) + call rwcdf(rw,ncid,'tab3dr',(/1,1,1/),tab3dr,iret) + if (nnreg(0).ge.7) then + call rwcdf(rw,ncid,'dab3dtl',(/1,1,1/),dab3dtl,iret) + call rwcdf(rw,ncid,'dab3dtr',(/1,1,1/),dab3dtr,iret) + call rwcdf(rw,ncid,'tab3dtl',(/1,1,1/),tab3dtl,iret) + call rwcdf(rw,ncid,'tab3dtr',(/1,1,1/),tab3dtr,iret) + endif + endif + + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmb3dl',(/1,1,1/),dmb3dl,iret) + call rwcdf(rw,ncid,'dmb3di',(/1,1,1/),dmb3di,iret) + call rwcdf(rw,ncid,'dmb3da',(/1,1,1/),dmb3da,iret) + call rwcdf(rw,ncid,'dmb3dr',(/1,1,1/),dmb3dr,iret) + call rwcdf(rw,ncid,'tmb3dl',(/1,1,1/),tmb3dl,iret) + call rwcdf(rw,ncid,'tmb3di',(/1,1,1/),tmb3di,iret) + call rwcdf(rw,ncid,'tmb3da',(/1,1,1/),tmb3da,iret) + call rwcdf(rw,ncid,'tmb3dr',(/1,1,1/),tmb3dr,iret) + if (nnreg(0).ge.7) then + call rwcdf(rw,ncid,'dmb3dtl',(/1,1,1/),dmb3dtl,iret) + call rwcdf(rw,ncid,'dmb3dtr',(/1,1,1/),dmb3dtr,iret) + call rwcdf(rw,ncid,'tmb3dtl',(/1,1,1/),tmb3dtl,iret) + call rwcdf(rw,ncid,'tmb3dtr',(/1,1,1/),tmb3dtr,iret) + endif + endif + slice=0.0_R8 do iy = iylstrt, iylend call calc_fet(-1,iy,'L',1._R8,nx,ny,ismain,BoRiS,slice(iy)) @@ -1246,22 +1914,11 @@ subroutine b2mwti (itim, tim, & enddo call rwcdf(rw,ncid,'ft3dtr',imap,slice(iytrstrt),iret) endif - slice(-1:ny)=dna0(jxi,-1:ny,ismain) - call rwcdf(rw,ncid,'dn3di',imap,slice,iret) - slice(-1:ny)=dna0(jxa,-1:ny,ismain) - call rwcdf(rw,ncid,'dn3da',imap,slice,iret) - slice(-1:ny)=dpa0(jxi,-1:ny,ismain0)* (rza(jxi,-1:ny,ismain0)*te(jxi,-1:ny)+ti(jxi,-1:ny)) - call rwcdf(rw,ncid,'dp3di',imap,slice,iret) - slice(-1:ny)=dpa0(jxa,-1:ny,ismain0)* (rza(jxa,-1:ny,ismain0)*te(jxa,-1:ny)+ti(jxa,-1:ny)) - call rwcdf(rw,ncid,'dp3da',imap,slice,iret) - slice(-1:ny)=fllim0fhi(jxi,-1:ny,1,ismain0) - call rwcdf(rw,ncid,'lh3di',imap,slice,iret) - slice(-1:ny)=fllim0fhi(jxa,-1:ny,1,ismain0) - call rwcdf(rw,ncid,'lh3da',imap,slice,iret) - slice(-1:ny)=fllim0fna(jxi,-1:ny,1,ismain0) - call rwcdf(rw,ncid,'ln3di',imap,slice,iret) - slice(-1:ny)=fllim0fna(jxa,-1:ny,1,ismain0) - call rwcdf(rw,ncid,'ln3da',imap,slice,iret) + + call rwcdf(rw,ncid,'dn3di',(/1,1,1/),dn3di,iret) + call rwcdf(rw,ncid,'dn3da',(/1,1,1/),dn3da,iret) + call rwcdf(rw,ncid,'dp3di',(/1,1,1/),dp3di,iret) + call rwcdf(rw,ncid,'dp3da',(/1,1,1/),dp3da,iret) slice(-1:ny)=hce0(jxi,-1:ny)/ne(jxi,-1:ny) call rwcdf(rw,ncid,'ke3di',imap,slice,iret) slice(-1:ny)=hce0(jxa,-1:ny)/ne(jxa,-1:ny) @@ -1270,18 +1927,20 @@ subroutine b2mwti (itim, tim, & call rwcdf(rw,ncid,'ki3di',imap,slice,iret) slice(-1:ny)=hci0(jxa,-1:ny)/ni(jxa,-1:ny,0) call rwcdf(rw,ncid,'ki3da',imap,slice,iret) - slice(-1:ny)=vla0(jxi,-1:ny,0,ismain) - call rwcdf(rw,ncid,'vx3di',imap,slice,iret) - slice(-1:ny)=vla0(jxa,-1:ny,0,ismain) - call rwcdf(rw,ncid,'vx3da',imap,slice,iret) - slice(-1:ny)=vla0(jxi,-1:ny,1,ismain) - call rwcdf(rw,ncid,'vy3di',imap,slice,iret) - slice(-1:ny)=vla0(jxa,-1:ny,1,ismain) - call rwcdf(rw,ncid,'vy3da',imap,slice,iret) - slice(-1:ny)=vsa0(jxi,-1:ny,ismain)/(mp*am(ismain)*na(jxi,-1:ny,ismain)) - call rwcdf(rw,ncid,'vs3di',imap,slice,iret) - slice(-1:ny)=vsa0(jxa,-1:ny,ismain)/(mp*am(ismain)*na(jxa,-1:ny,ismain)) - call rwcdf(rw,ncid,'vs3da',imap,slice,iret) + call rwcdf(rw,ncid,'vx3di',(/1,1,1/),vx3di,iret) + call rwcdf(rw,ncid,'vx3da',(/1,1,1/),vx3da,iret) + call rwcdf(rw,ncid,'vy3di',(/1,1,1/),vy3di,iret) + call rwcdf(rw,ncid,'vy3da',(/1,1,1/),vy3da,iret) + call rwcdf(rw,ncid,'vs3di',(/1,1,1/),vs3di,iret) + call rwcdf(rw,ncid,'vs3da',(/1,1,1/),vs3da,iret) + slice(-1:ny)=fllim0fhi(jxi,-1:ny,1,ismain0) + call rwcdf(rw,ncid,'lh3di',imap,slice,iret) + slice(-1:ny)=fllim0fhi(jxa,-1:ny,1,ismain0) + call rwcdf(rw,ncid,'lh3da',imap,slice,iret) + slice(-1:ny)=fllim0fna(jxi,-1:ny,1,ismain0) + call rwcdf(rw,ncid,'ln3di',imap,slice,iret) + slice(-1:ny)=fllim0fna(jxa,-1:ny,1,ismain0) + call rwcdf(rw,ncid,'ln3da',imap,slice,iret) ! imap(1)=1 imap(2)=1 @@ -1341,22 +2000,73 @@ subroutine b2mwti (itim, tim, & call check_cdf_status(iret) !wdk compute the standard deviation from average and average of squares fac = rratio(ntim_batch,ntim_batch - 1) + do is = 0, ns-1 + nasepm_std(is+1,1:nc) = (abs(nasepm_std(is+1,1:nc) - nasepm_av(is+1,1:nc)**2)*fac)**0.5 + end do nesepm_std(1:nc) = (abs(nesepm_std(1:nc) - nesepm_av(1:nc)**2)*fac)**0.5 tesepm_std(1:nc) = (abs(tesepm_std(1:nc) - tesepm_av(1:nc)**2)*fac)**0.5 tisepm_std(1:nc) = (abs(tisepm_std(1:nc) - tisepm_av(1:nc)**2)*fac)**0.5 + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepm_std(iatm,1:nc) = (abs(dabsepm_std(iatm,1:nc) - dabsepm_av(iatm,1:nc)**2)*fac)**0.5 + tabsepm_std(iatm,1:nc) = (abs(tabsepm_std(iatm,1:nc) - tabsepm_av(iatm,1:nc)**2)*fac)**0.5 + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepm_std(imol,1:nc) = (abs(dmbsepm_std(imol,1:nc) - dmbsepm_av(imol,1:nc)**2)*fac)**0.5 + tmbsepm_std(imol,1:nc) = (abs(tmbsepm_std(imol,1:nc) - tmbsepm_av(imol,1:nc)**2)*fac)**0.5 + end do + endif posepm_std(1:nc) = (abs(posepm_std(1:nc) - posepm_av(1:nc)**2)*fac)**0.5 + do is = 0, ns-1 + nasepi_std(is+1,1:nc) = (abs(nasepi_std(is+1,1:nc) - nasepi_av(is+1,1:nc)**2)*fac)**0.5 + end do nesepi_std(1:nc) = (abs(nesepi_std(1:nc) - nesepi_av(1:nc)**2)*fac)**0.5 tesepi_std(1:nc) = (abs(tesepi_std(1:nc) - tesepi_av(1:nc)**2)*fac)**0.5 tisepi_std(1:nc) = (abs(tisepi_std(1:nc) - tisepi_av(1:nc)**2)*fac)**0.5 + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepi_std(iatm,1:nc) = (abs(dabsepi_std(iatm,1:nc) - dabsepi_av(iatm,1:nc)**2)*fac)**0.5 + tabsepi_std(iatm,1:nc) = (abs(tabsepi_std(iatm,1:nc) - tabsepi_av(iatm,1:nc)**2)*fac)**0.5 + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepi_std(imol,1:nc) = (abs(dmbsepi_std(imol,1:nc) - dmbsepi_av(imol,1:nc)**2)*fac)**0.5 + tmbsepi_std(imol,1:nc) = (abs(tmbsepi_std(imol,1:nc) - tmbsepi_av(imol,1:nc)**2)*fac)**0.5 + end do + endif posepi_std(1:nc) = (abs(posepi_std(1:nc) - posepi_av(1:nc)**2)*fac)**0.5 + do is = 0, ns-1 + nasepa_std(is+1,1:nc) = (abs(nasepa_std(is+1,1:nc) - nasepa_av(is+1,1:nc)**2)*fac)**0.5 + end do nesepa_std(1:nc) = (abs(nesepa_std(1:nc) - nesepa_av(1:nc)**2)*fac)**0.5 tesepa_std(1:nc) = (abs(tesepa_std(1:nc) - tesepa_av(1:nc)**2)*fac)**0.5 tisepa_std(1:nc) = (abs(tisepa_std(1:nc) - tisepa_av(1:nc)**2)*fac)**0.5 + if (nnatmi.gt.0) then + do iatm=1,nnatmi + dabsepa_std(iatm,1:nc) = (abs(dabsepa_std(iatm,1:nc) - dabsepa_av(iatm,1:nc)**2)*fac)**0.5 + tabsepa_std(iatm,1:nc) = (abs(tabsepa_std(iatm,1:nc) - tabsepa_av(iatm,1:nc)**2)*fac)**0.5 + end do + endif + if (nnmoli.gt.0) then + do imol=1,nnmoli + dmbsepa_std(imol,1:nc) = (abs(dmbsepa_std(imol,1:nc) - dmbsepa_av(imol,1:nc)**2)*fac)**0.5 + tmbsepa_std(imol,1:nc) = (abs(tmbsepa_std(imol,1:nc) - tmbsepa_av(imol,1:nc)**2)*fac)**0.5 + end do + endif posepa_std(1:nc) = (abs(posepa_std(1:nc) - posepa_av(1:nc)**2)*fac)**0.5 + do is = 0, ns-1 + namxip_std(is+1,1:nc) = (abs(namxip_std(is+1,1:nc) - namxip_av(is+1,1:nc)**2)*fac)**0.5 + end do nemxip_std(1:nc) = (abs(nemxip_std(1:nc) - nemxip_av(1:nc)**2)*fac)**0.5 temxip_std(1:nc) = (abs(temxip_std(1:nc) - temxip_av(1:nc)**2)*fac)**0.5 timxip_std(1:nc) = (abs(timxip_std(1:nc) - timxip_av(1:nc)**2)*fac)**0.5 pomxip_std(1:nc) = (abs(pomxip_std(1:nc) - pomxip_av(1:nc)**2)*fac)**0.5 + do is = 0, ns-1 + namxap_std(is+1,1:nc) = (abs(namxap_std(is+1,1:nc) - namxap_av(is+1,1:nc)**2)*fac)**0.5 + end do nemxap_std(1:nc) = (abs(nemxap_std(1:nc) - nemxap_av(1:nc)**2)*fac)**0.5 temxap_std(1:nc) = (abs(temxap_std(1:nc) - temxap_av(1:nc)**2)*fac)**0.5 timxap_std(1:nc) = (abs(timxap_std(1:nc) - timxap_av(1:nc)**2)*fac)**0.5 @@ -1371,44 +2081,102 @@ subroutine b2mwti (itim, tim, & !wdk averages imap(1)=1 imap(2)=nncutmax + call rwcdf(rw,ncid,'nasepm_av',(/1,1,nncutmax/),nasepm_av,iret) call rwcdf(rw,ncid,'nesepm_av',imap,nesepm_av,iret) call rwcdf(rw,ncid,'tesepm_av',imap,tesepm_av,iret) call rwcdf(rw,ncid,'tisepm_av',imap,tisepm_av,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepm_av',(/1,1,nncutmax/),dabsepm_av,iret) + call rwcdf(rw,ncid,'tabsepm_av',(/1,1,nncutmax/),tabsepm_av,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepm_av',(/1,1,nncutmax/),dmbsepm_av,iret) + call rwcdf(rw,ncid,'tmbsepm_av',(/1,1,nncutmax/),tmbsepm_av,iret) + endif call rwcdf(rw,ncid,'posepm_av',imap,posepm_av,iret) + call rwcdf(rw,ncid,'nasepi_av',(/1,1,nncutmax/),nasepi_av,iret) call rwcdf(rw,ncid,'nesepi_av',imap,nesepi_av,iret) call rwcdf(rw,ncid,'tesepi_av',imap,tesepi_av,iret) call rwcdf(rw,ncid,'tisepi_av',imap,tisepi_av,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepi_av',(/1,1,nncutmax/),dabsepi_av,iret) + call rwcdf(rw,ncid,'tabsepi_av',(/1,1,nncutmax/),tabsepi_av,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepi_av',(/1,1,nncutmax/),dmbsepi_av,iret) + call rwcdf(rw,ncid,'tmbsepi_av',(/1,1,nncutmax/),tmbsepi_av,iret) + endif call rwcdf(rw,ncid,'posepi_av',imap,posepi_av,iret) + call rwcdf(rw,ncid,'nasepa_av',(/1,1,nncutmax/),nasepa_av,iret) call rwcdf(rw,ncid,'nesepa_av',imap,nesepa_av,iret) call rwcdf(rw,ncid,'tesepa_av',imap,tesepa_av,iret) call rwcdf(rw,ncid,'tisepa_av',imap,tisepa_av,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepa_av',(/1,1,nncutmax/),dabsepa_av,iret) + call rwcdf(rw,ncid,'tabsepa_av',(/1,1,nncutmax/),tabsepa_av,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepa_av',(/1,1,nncutmax/),dmbsepa_av,iret) + call rwcdf(rw,ncid,'tmbsepa_av',(/1,1,nncutmax/),tmbsepa_av,iret) + endif call rwcdf(rw,ncid,'posepa_av',imap,posepa_av,iret) + call rwcdf(rw,ncid,'namxip_av',(/1,1,nncutmax/),namxip_av,iret) call rwcdf(rw,ncid,'nemxip_av',imap,nemxip_av,iret) call rwcdf(rw,ncid,'temxip_av',imap,temxip_av,iret) call rwcdf(rw,ncid,'timxip_av',imap,timxip_av,iret) call rwcdf(rw,ncid,'pomxip_av',imap,pomxip_av,iret) + call rwcdf(rw,ncid,'namxap_av',(/1,1,nncutmax/),namxap_av,iret) call rwcdf(rw,ncid,'nemxap_av',imap,nemxap_av,iret) call rwcdf(rw,ncid,'temxap_av',imap,temxap_av,iret) call rwcdf(rw,ncid,'timxap_av',imap,timxap_av,iret) call rwcdf(rw,ncid,'pomxap_av',imap,pomxap_av,iret) !wdk standard deviations + call rwcdf(rw,ncid,'nasepm_std',(/1,1,nncutmax/),nasepm_std,iret) call rwcdf(rw,ncid,'nesepm_std',imap,nesepm_std,iret) call rwcdf(rw,ncid,'tesepm_std',imap,tesepm_std,iret) call rwcdf(rw,ncid,'tisepm_std',imap,tisepm_std,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepm_std',(/1,1,nncutmax/),dabsepm_std,iret) + call rwcdf(rw,ncid,'tabsepm_std',(/1,1,nncutmax/),tabsepm_std,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepm_std',(/1,1,nncutmax/),dmbsepm_std,iret) + call rwcdf(rw,ncid,'tmbsepm_std',(/1,1,nncutmax/),tmbsepm_std,iret) + endif call rwcdf(rw,ncid,'posepm_std',imap,posepm_std,iret) + call rwcdf(rw,ncid,'nasepi_std',(/1,1,nncutmax/),nasepi_std,iret) call rwcdf(rw,ncid,'nesepi_std',imap,nesepi_std,iret) call rwcdf(rw,ncid,'tesepi_std',imap,tesepi_std,iret) call rwcdf(rw,ncid,'tisepi_std',imap,tisepi_std,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepi_std',(/1,1,nncutmax/),dabsepi_std,iret) + call rwcdf(rw,ncid,'tabsepi_std',(/1,1,nncutmax/),tabsepi_std,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepi_std',(/1,1,nncutmax/),dmbsepi_std,iret) + call rwcdf(rw,ncid,'tmbsepi_std',(/1,1,nncutmax/),tmbsepi_std,iret) + endif call rwcdf(rw,ncid,'posepi_std',imap,posepi_std,iret) + call rwcdf(rw,ncid,'nasepa_std',(/1,1,nncutmax/),nasepa_std,iret) call rwcdf(rw,ncid,'nesepa_std',imap,nesepa_std,iret) call rwcdf(rw,ncid,'tesepa_std',imap,tesepa_std,iret) call rwcdf(rw,ncid,'tisepa_std',imap,tisepa_std,iret) + if (nnatmi.gt.0) then + call rwcdf(rw,ncid,'dabsepa_std',(/1,1,nncutmax/),dabsepa_std,iret) + call rwcdf(rw,ncid,'tabsepa_std',(/1,1,nncutmax/),tabsepa_std,iret) + endif + if (nnmoli.gt.0) then + call rwcdf(rw,ncid,'dmbsepa_std',(/1,1,nncutmax/),dmbsepa_std,iret) + call rwcdf(rw,ncid,'tmbsepa_std',(/1,1,nncutmax/),tmbsepa_std,iret) + endif call rwcdf(rw,ncid,'posepa_std',imap,posepa_std,iret) + call rwcdf(rw,ncid,'namxip_std',(/1,1,nncutmax/),namxip_std,iret) call rwcdf(rw,ncid,'nemxip_std',imap,nemxip_std,iret) call rwcdf(rw,ncid,'temxip_std',imap,temxip_std,iret) call rwcdf(rw,ncid,'timxip_std',imap,timxip_std,iret) call rwcdf(rw,ncid,'pomxip_std',imap,pomxip_std,iret) + call rwcdf(rw,ncid,'namxap_std',(/1,1,nncutmax/),namxap_std,iret) call rwcdf(rw,ncid,'nemxap_std',imap,nemxap_std,iret) call rwcdf(rw,ncid,'temxap_std',imap,temxap_std,iret) call rwcdf(rw,ncid,'timxap_std',imap,timxap_std,iret) @@ -1432,42 +2200,76 @@ subroutine dealloc_b2mod_mwti if (.not.allocated(nesepi_av)) return + deallocate(nasepi_av) deallocate(nesepi_av) deallocate(tesepi_av) deallocate(tisepi_av) + deallocate(dabsepi_av) + deallocate(tabsepi_av) + deallocate(dmbsepi_av) + deallocate(tmbsepi_av) deallocate(posepi_av) + deallocate(nasepm_av) deallocate(nesepm_av) deallocate(tesepm_av) deallocate(tisepm_av) + deallocate(dabsepm_av) + deallocate(tabsepm_av) + deallocate(dmbsepm_av) + deallocate(tmbsepm_av) deallocate(posepm_av) + deallocate(nasepa_av) deallocate(nesepa_av) deallocate(tesepa_av) deallocate(tisepa_av) + deallocate(dabsepa_av) + deallocate(tabsepa_av) + deallocate(dmbsepa_av) + deallocate(tmbsepa_av) deallocate(posepa_av) + deallocate(namxip_av) deallocate(nemxip_av) deallocate(temxip_av) deallocate(timxip_av) deallocate(pomxip_av) + deallocate(namxap_av) deallocate(nemxap_av) deallocate(temxap_av) deallocate(timxap_av) deallocate(pomxap_av) + deallocate(nasepi_std) deallocate(nesepi_std) deallocate(tesepi_std) deallocate(tisepi_std) + deallocate(dabsepi_std) + deallocate(tabsepi_std) + deallocate(dmbsepi_std) + deallocate(tmbsepi_std) deallocate(posepi_std) + deallocate(nasepm_std) deallocate(nesepm_std) deallocate(tesepm_std) deallocate(tisepm_std) + deallocate(dabsepm_std) + deallocate(tabsepm_std) + deallocate(dmbsepm_std) + deallocate(tmbsepm_std) deallocate(posepm_std) + deallocate(nasepa_std) deallocate(nesepa_std) deallocate(tesepa_std) deallocate(tisepa_std) + deallocate(dabsepa_std) + deallocate(tabsepa_std) + deallocate(dmbsepa_std) + deallocate(tmbsepa_std) deallocate(posepa_std) + deallocate(namxip_std) deallocate(nemxip_std) deallocate(temxip_std) deallocate(timxip_std) deallocate(pomxip_std) + deallocate(namxap_std) deallocate(nemxap_std) deallocate(temxap_std) deallocate(timxap_std) @@ -1478,38 +2280,45 @@ end subroutine dealloc_b2mod_mwti #ifndef NO_CDF subroutine b2crtimecdf(filename, & - nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, write_2d, & + nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, nnatmi, nnmoli, write_2d, & ncid, batch_only, iret) use b2mod_constants # include - integer nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, iret + integer nx, ny, nybl, nytl, nytr, nybr, nya, nyi, nc, ns, nnatmi, nnmoli, iret integer, intent(in) :: write_2d logical, intent(in) :: batch_only character*256 :: filename ! NetCDF id integer ncid ! dimension ids - integer :: nxdim, nydim, nsdim, timedim, batchdim, & + integer :: nxdim, nydim, nsdim, natmdim, nmoldim, timedim, batchdim, & nybldim, nytldim, nytrdim, nybrdim, nyadim, nyidim, ncdim, idirdim ! variable ids - integer :: ntstepid, timesaid, fnixipid, feexipid, feixipid, & - fnixapid, feexapid, feixapid, nesepiid, tesepiid, tisepiid, & - nesepmid, tesepmid, tisepmid, nesepaid, tesepaid, tisepaid, & - nemxipid, temxipid, timxipid, nemxapid, temxapid, timxapid, & + integer :: ntstepid, jxiid, jxaid, jsepid, timesaid, & + dslid, dsiid, dsaid, dsrid, dstlid, dstrid, & + dsLTid, dsRTid, dsTLTid, dsTRTid, dsLPid, dsRPid, dsTLPid, dsTRPid, & + fnixipid, feexipid, feixipid, fnixapid, feexapid, feixapid, & + nasepiid, nesepiid, tesepiid, tisepiid, dabsepiid, dmbsepiid, tabsepiid, tmbsepiid, & + nasepmid, nesepmid, tesepmid, tisepmid, dabsepmid, dmbsepmid, tabsepmid, tmbsepmid, & + nasepaid, nesepaid, tesepaid, tisepaid, dabsepaid, dmbsepaid, tabsepaid, tmbsepaid, & + namxipid, nemxipid, temxipid, timxipid, namxapid, nemxapid, temxapid, timxapid, & fniyipid, feeyipid, feiyipid, fniyapid, feeyapid, feiyapid, & pwmxipid, pwmxapid, tmneid, tmteid, tmtiid, tmhacoreid, & tmhasolid, tmhadivid, fnisipid, feesipid, feisipid, fnisapid, & feesapid, feisapid, fnisippid, feesippid, feisippid, fnisappid, & - feesappid, feisappid, ne3dlid, te3dlid, ti3dlid, ne3diid, & - te3diid, ti3diid, ne3daid, te3daid, ti3daid, ne3drid, te3drid, & + feesappid, feisappid, na3dlid, ne3dlid, te3dlid, ti3dlid, & + dab3dlid, dab3diid, dab3daid, dab3drid, tab3dlid, tab3diid, tab3daid, tab3drid, & + dmb3dlid, dmb3diid, dmb3daid, dmb3drid, tmb3dlid, tmb3diid, tmb3daid, tmb3drid, & + dab3dtlid, dab3dtrid, tab3dtlid, tab3dtrid, dmb3dtlid, dmb3dtrid, tmb3dtlid, tmb3dtrid, & + na3diid, ne3diid, te3diid, ti3diid, na3daid, ne3daid, te3daid, ti3daid, na3drid, ne3drid, te3drid, & ti3drid, an3dlid, mn3dlid, an3diid, mn3diid, an3daid, mn3daid, & an3drid, mn3drid, fn3dlid, fe3dlid, fi3dlid, fn3drid, fe3drid, & - fi3drid, ne3dtlid, te3dtlid, ti3dtlid, ne3dtrid, te3dtrid, & + fi3drid, na3dtlid, ne3dtlid, te3dtlid, ti3dtlid, na3dtrid, ne3dtrid, te3dtrid, & ti3dtrid, an3dtlid, mn3dtlid, & an3dtrid, mn3dtrid, fn3dtlid, fe3dtlid, fi3dtlid, fn3dtrid, & fe3dtrid, fi3dtrid, fetxipid, fetxapid, fetyipid, fetyapid, & fetsipid, fetsapid, fetsippid, fetsappid - integer :: ne2did, te2did, ti2did, po2did, kin2did, rsahi2did, & + integer :: na2did, ne2did, te2did, ti2did, po2did, kin2did, rsahi2did, & rsana2did, rrahi2did, rrana2did, rcxhi2did, rcxna2did, rqrad2did, & rqahe2did, fch2did, fhe2did, fhi2did, fna2did integer :: fchxipid, fchxapid, posepiid, posepmid, posepaid, & @@ -1528,16 +2337,22 @@ subroutine b2crtimecdf(filename, & tpmxipid, tpmxapid, tp3drid, tp3dlid, tp3dtlid, tp3dtrid, & tpsepiid, tpsepaid, & nastepid, ntimbatchid, batchsaid, & - nesepm_avid, tesepm_avid, tisepm_avid, posepm_avid, & - nesepi_avid, tesepi_avid, tisepi_avid, posepi_avid, & - nesepa_avid, tesepa_avid, tisepa_avid, posepa_avid, & - nemxip_avid, temxip_avid, timxip_avid, pomxip_avid, & - nemxap_avid, temxap_avid, timxap_avid, pomxap_avid, & - nesepm_stdid, tesepm_stdid, tisepm_stdid, posepm_stdid, & - nesepi_stdid, tesepi_stdid, tisepi_stdid, posepi_stdid, & - nesepa_stdid, tesepa_stdid, tisepa_stdid, posepa_stdid, & - nemxip_stdid, temxip_stdid, timxip_stdid, pomxip_stdid, & - nemxap_stdid, temxap_stdid, timxap_stdid, pomxap_stdid + nasepm_avid, nesepm_avid, tesepm_avid, tisepm_avid, posepm_avid, & + dabsepm_avid, tabsepm_avid, dmbsepm_avid, tmbsepm_avid, & + nasepi_avid, nesepi_avid, tesepi_avid, tisepi_avid, posepi_avid, & + dabsepi_avid, tabsepi_avid, dmbsepi_avid, tmbsepi_avid, & + nasepa_avid, nesepa_avid, tesepa_avid, tisepa_avid, posepa_avid, & + dabsepa_avid, tabsepa_avid, dmbsepa_avid, tmbsepa_avid, & + namxip_avid, nemxip_avid, temxip_avid, timxip_avid, pomxip_avid, & + namxap_avid, nemxap_avid, temxap_avid, timxap_avid, pomxap_avid, & + nasepm_stdid, nesepm_stdid, tesepm_stdid, tisepm_stdid, posepm_stdid, & + dabsepm_stdid, tabsepm_stdid, dmbsepm_stdid, tmbsepm_stdid, & + nasepi_stdid, nesepi_stdid, tesepi_stdid, tisepi_stdid, posepi_stdid, & + dabsepi_stdid, tabsepi_stdid, dmbsepi_stdid, tmbsepi_stdid, & + nasepa_stdid, nesepa_stdid, tesepa_stdid, tisepa_stdid, posepa_stdid, & + dabsepa_stdid, tabsepa_stdid, dmbsepa_stdid, tmbsepa_stdid, & + namxip_stdid, nemxip_stdid, temxip_stdid, timxip_stdid, pomxip_stdid, & + namxap_stdid, nemxap_stdid, temxap_stdid, timxap_stdid, pomxap_stdid ! variable shapes integer :: dims(2) real (kind=R8) :: dvals(1) @@ -1580,11 +2395,29 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_dim(ncid, 'ns', ns, nsdim) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_dim(ncid, 'natm', nnatmi, natmdim) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_dim(ncid, 'nmol', nnmoli, nmoldim) + call check_cdf_status(iret) + endif iret = nf_def_dim(ncid, 'time', ncunlim, timedim) call check_cdf_status(iret) else iret = nf_def_dim(ncid, 'nc', nc, ncdim) call check_cdf_status(iret) + iret = nf_def_dim(ncid, 'ns', ns, nsdim) + call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_dim(ncid, 'natm', nnatmi, natmdim) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_dim(ncid, 'nmol', nnmoli, nmoldim) + call check_cdf_status(iret) + endif iret = nf_def_dim(ncid, 'batch', ncunlim, batchdim) call check_cdf_status(iret) end if @@ -1593,11 +2426,61 @@ subroutine b2crtimecdf(filename, & dims(1) = 0 iret = nf_def_var(ncid, 'ntstep', NCDOUBLE, 0, dims, ntstepid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'jxi', NCDOUBLE, 0, dims, jxiid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'jxa', NCDOUBLE, 0, dims, jxaid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'jsep', NCDOUBLE, 0, dims, jsepid) + call check_cdf_status(iret) dims(1) = timedim iret = nf_def_var(ncid, 'timesa', NCDOUBLE, 1, dims, timesaid) call check_cdf_status(iret) + dims(1) = nyidim + iret = nf_def_var(ncid, 'dsi', NCDOUBLE, 1, dims, dsiid) + call check_cdf_status(iret) + dims(1) = nyadim + iret = nf_def_var(ncid, 'dsa', NCDOUBLE, 1, dims, dsaid) + call check_cdf_status(iret) + dims(1) = nybldim + iret = nf_def_var(ncid, 'dsl', NCDOUBLE, 1, dims, dslid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsLT', NCDOUBLE, 1, dims, dsLTid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsLP', NCDOUBLE, 1, dims, dsLPid) + call check_cdf_status(iret) + dims(1) = nybrdim + iret = nf_def_var(ncid, 'dsr', NCDOUBLE, 1, dims, dsrid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsRT', NCDOUBLE, 1, dims, dsRTid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsRP', NCDOUBLE, 1, dims, dsRPid) + call check_cdf_status(iret) + if(nytl.gt.0) then + dims(1) = nytldim + iret = nf_def_var(ncid, 'dstl', NCDOUBLE, 1, dims, dstlid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsTLT', NCDOUBLE, 1, dims, dsTLTid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsTLP', NCDOUBLE, 1, dims, dsTLPid) + call check_cdf_status(iret) + endif + if(nytr.gt.0) then + dims(1) = nytrdim + iret = nf_def_var(ncid, 'dstr', NCDOUBLE, 1, dims, dstrid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsTRT', NCDOUBLE, 1, dims, dsTRTid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dsTRP', NCDOUBLE, 1, dims, dsTRPid) + call check_cdf_status(iret) + endif dvals(1) = 1.0_R8/ev if (write_2d .ge. 1) then + iret = nf_def_var(ncid, 'na2d', NCDOUBLE, 4, (/nxdim,nydim,nsdim,timedim/), na2did) + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na2did, 'long_name', 2, 'na') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na2did, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_def_var(ncid, 'ne2d', NCDOUBLE, 3, (/nxdim,nydim,timedim/), ne2did) call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne2did, 'long_name', 2, 'ne') @@ -1733,22 +2616,50 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'fchxap', NCDOUBLE, 2, dims, fchxapid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepi', NCDOUBLE, 3, (/ncdim,nsdim,timedim/), nasepiid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepi', NCDOUBLE, 2, dims, nesepiid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepi', NCDOUBLE, 2, dims, tesepiid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepi', NCDOUBLE, 2, dims, tisepiid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepi', NCDOUBLE, 3, (/ncdim,natmdim,timedim/), dabsepiid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepi', NCDOUBLE, 3, (/ncdim,natmdim,timedim/), tabsepiid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepi', NCDOUBLE, 3, (/ncdim,nmoldim,timedim/), dmbsepiid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepi', NCDOUBLE, 3, (/ncdim,nmoldim,timedim/), tmbsepiid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'tpsepi', NCDOUBLE, 2, dims, tpsepiid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'posepi', NCDOUBLE, 2, dims, posepiid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepm', NCDOUBLE, 3, (/ncdim,nsdim,timedim/), nasepmid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepm', NCDOUBLE, 2, dims, nesepmid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepm', NCDOUBLE, 2, dims, tesepmid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepm', NCDOUBLE, 2, dims, tisepmid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepm', NCDOUBLE, 3, (/ncdim,natmdim,timedim/), dabsepmid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepm', NCDOUBLE, 3, (/ncdim,natmdim,timedim/), tabsepmid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepm', NCDOUBLE, 3, (/ncdim,nmoldim,timedim/), dmbsepmid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepm', NCDOUBLE, 3, (/ncdim,nmoldim,timedim/), tmbsepmid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'posepm', NCDOUBLE, 2, dims, posepmid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'dnsepm', NCDOUBLE, 2, dims, dnsepmid) @@ -1765,16 +2676,32 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'vssepm', NCDOUBLE, 2, dims, vssepmid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepa', NCDOUBLE, 3, (/ncdim,nsdim,timedim/), nasepaid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepa', NCDOUBLE, 2, dims, nesepaid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepa', NCDOUBLE, 2, dims, tesepaid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepa', NCDOUBLE, 2, dims, tisepaid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepa', NCDOUBLE, 3, (/ncdim,natmdim,timedim/), dabsepaid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepa', NCDOUBLE, 3, (/ncdim,natmdim,timedim/), tabsepaid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepa', NCDOUBLE, 3, (/ncdim,nmoldim,timedim/), dmbsepaid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepa', NCDOUBLE, 3, (/ncdim,nmoldim,timedim/), tmbsepaid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'tpsepa', NCDOUBLE, 2, dims, tpsepaid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'posepa', NCDOUBLE, 2, dims, posepaid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'namxip', NCDOUBLE, 3, (/ncdim,nsdim,timedim/), namxipid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nemxip', NCDOUBLE, 2, dims, nemxipid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'temxip', NCDOUBLE, 2, dims, temxipid) @@ -1785,6 +2712,8 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'pomxip', NCDOUBLE, 2, dims, pomxipid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'namxap', NCDOUBLE, 3, (/ncdim,nsdim,timedim/), namxapid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nemxap', NCDOUBLE, 2, dims, nemxapid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'temxap', NCDOUBLE, 2, dims, temxapid) @@ -1876,7 +2805,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) dims(2) = timedim dims(1) = nybldim - iret = nf_def_var(ncid, 'fn3dl', NCDOUBLE, 2, dims, fn3dlid) + iret = nf_def_var(ncid, 'fn3dl', NCDOUBLE, 3, (/nybldim,nsdim,timedim/), fn3dlid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'fe3dl', NCDOUBLE, 2, dims, fe3dlid) call check_cdf_status(iret) @@ -1890,6 +2819,8 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'fo3dl', NCDOUBLE, 2, dims, fo3dlid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'na3dl', NCDOUBLE, 3, (/nybldim,nsdim,timedim/), na3dlid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'ne3dl', NCDOUBLE, 2, dims, ne3dlid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'te3dl', NCDOUBLE, 2, dims, te3dlid) @@ -1904,10 +2835,22 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'tp3dl', NCDOUBLE, 2, dims, tp3dlid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dab3dl', NCDOUBLE, 3, (/nybldim,natmdim,timedim/), dab3dlid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tab3dl', NCDOUBLE, 3, (/nybldim,natmdim,timedim/), tab3dlid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmb3dl', NCDOUBLE, 3, (/nybldim,nmoldim,timedim/), dmb3dlid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmb3dl', NCDOUBLE, 3, (/nybldim,nmoldim,timedim/), tmb3dlid) + call check_cdf_status(iret) + endif if(nytl.gt.0) then dims(2) = timedim dims(1) = nytldim - iret = nf_def_var(ncid, 'fn3dtl', NCDOUBLE, 2, dims, fn3dtlid) + iret = nf_def_var(ncid, 'fn3dtl', NCDOUBLE, 3, (/nytldim,nsdim,timedim/), fn3dtlid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'fe3dtl', NCDOUBLE, 2, dims, fe3dtlid) call check_cdf_status(iret) @@ -1921,6 +2864,8 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'fo3dtl', NCDOUBLE, 2, dims, fo3dtlid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'na3dtl', NCDOUBLE, 3, (/nytldim,nsdim,timedim/), na3dtlid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'ne3dtl', NCDOUBLE, 2, dims, ne3dtlid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'te3dtl', NCDOUBLE, 2, dims, te3dtlid) @@ -1935,9 +2880,23 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'tp3dtl', NCDOUBLE, 2, dims, tp3dtlid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dab3dtl', NCDOUBLE, 3, (/nytldim,natmdim,timedim/), dab3dtlid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tab3dtl', NCDOUBLE, 3, (/nytldim,natmdim,timedim/), tab3dtlid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmb3dtl', NCDOUBLE, 3, (/nytldim,nmoldim,timedim/), dmb3dtlid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmb3dtl', NCDOUBLE, 3, (/nytldim,nmoldim,timedim/), tmb3dtlid) + call check_cdf_status(iret) + endif endif dims(2) = timedim dims(1) = nyidim + iret = nf_def_var(ncid, 'na3di', NCDOUBLE, 3, (/nyidim,nsdim,timedim/), na3diid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'ne3di', NCDOUBLE, 2, dims, ne3diid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'te3di', NCDOUBLE, 2, dims, te3diid) @@ -1950,9 +2909,9 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'mn3di', NCDOUBLE, 2, dims, mn3diid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'dn3di', NCDOUBLE, 2, dims, dn3diid) + iret = nf_def_var(ncid, 'dn3di', NCDOUBLE, 3, (/nyidim,nsdim,timedim/), dn3diid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'dp3di', NCDOUBLE, 2, dims, dp3diid) + iret = nf_def_var(ncid, 'dp3di', NCDOUBLE, 3, (/nyidim,nsdim,timedim/), dp3diid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'lh3di', NCDOUBLE, 2, dims, lh3diid) call check_cdf_status(iret) @@ -1962,14 +2921,28 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'ki3di', NCDOUBLE, 2, dims, ki3diid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'vx3di', NCDOUBLE, 2, dims, vx3diid) + iret = nf_def_var(ncid, 'vx3di', NCDOUBLE, 3, (/nyidim,nsdim,timedim/), vx3diid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'vy3di', NCDOUBLE, 2, dims, vy3diid) + iret = nf_def_var(ncid, 'vy3di', NCDOUBLE, 3, (/nyidim,nsdim,timedim/), vy3diid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'vs3di', NCDOUBLE, 2, dims, vs3diid) + iret = nf_def_var(ncid, 'vs3di', NCDOUBLE, 3, (/nyidim,nsdim,timedim/), vs3diid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dab3di', NCDOUBLE, 3, (/nyidim,natmdim,timedim/), dab3diid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tab3di', NCDOUBLE, 3, (/nyidim,natmdim,timedim/), tab3diid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmb3di', NCDOUBLE, 3, (/nyidim,nmoldim,timedim/), dmb3diid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmb3di', NCDOUBLE, 3, (/nyidim,nmoldim,timedim/), tmb3diid) + call check_cdf_status(iret) + endif dims(2) = timedim dims(1) = nyadim + iret = nf_def_var(ncid, 'na3da', NCDOUBLE, 3, (/nyadim,nsdim,timedim/), na3daid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'ne3da', NCDOUBLE, 2, dims, ne3daid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'te3da', NCDOUBLE, 2, dims, te3daid) @@ -1982,9 +2955,9 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'mn3da', NCDOUBLE, 2, dims, mn3daid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'dn3da', NCDOUBLE, 2, dims, dn3daid) + iret = nf_def_var(ncid, 'dn3da', NCDOUBLE, 3, (/nyadim,nsdim,timedim/), dn3daid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'dp3da', NCDOUBLE, 2, dims, dp3daid) + iret = nf_def_var(ncid, 'dp3da', NCDOUBLE, 3, (/nyadim,nsdim,timedim/), dp3daid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'lh3da', NCDOUBLE, 2, dims, lh3daid) call check_cdf_status(iret) @@ -1994,14 +2967,28 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'ki3da', NCDOUBLE, 2, dims, ki3daid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'vx3da', NCDOUBLE, 2, dims, vx3daid) + iret = nf_def_var(ncid, 'vx3da', NCDOUBLE, 3, (/nyadim,nsdim,timedim/), vx3daid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'vy3da', NCDOUBLE, 2, dims, vy3daid) + iret = nf_def_var(ncid, 'vy3da', NCDOUBLE, 3, (/nyadim,nsdim,timedim/), vy3daid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'vs3da', NCDOUBLE, 2, dims, vs3daid) + iret = nf_def_var(ncid, 'vs3da', NCDOUBLE, 3, (/nyadim,nsdim,timedim/), vs3daid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dab3da', NCDOUBLE, 3, (/nyadim,natmdim,timedim/), dab3daid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tab3da', NCDOUBLE, 3, (/nyadim,natmdim,timedim/), tab3daid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmb3da', NCDOUBLE, 3, (/nyadim,nmoldim,timedim/), dmb3daid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmb3da', NCDOUBLE, 3, (/nyadim,nmoldim,timedim/), tmb3daid) + call check_cdf_status(iret) + endif dims(2) = timedim dims(1) = nybrdim + iret = nf_def_var(ncid, 'na3dr', NCDOUBLE, 3, (/nybrdim,nsdim,timedim/), na3drid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'ne3dr', NCDOUBLE, 2, dims, ne3drid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'te3dr', NCDOUBLE, 2, dims, te3drid) @@ -2014,7 +3001,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'mn3dr', NCDOUBLE, 2, dims, mn3drid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'fn3dr', NCDOUBLE, 2, dims, fn3drid) + iret = nf_def_var(ncid, 'fn3dr', NCDOUBLE, 3, (/nybrdim,nsdim,timedim/), fn3drid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'fe3dr', NCDOUBLE, 2, dims, fe3drid) call check_cdf_status(iret) @@ -2030,9 +3017,23 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'tp3dr', NCDOUBLE, 2, dims, tp3drid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dab3dr', NCDOUBLE, 3, (/nybrdim,natmdim,timedim/), dab3drid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tab3dr', NCDOUBLE, 3, (/nybrdim,natmdim,timedim/), tab3drid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmb3dr', NCDOUBLE, 3, (/nybrdim,nmoldim,timedim/), dmb3drid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmb3dr', NCDOUBLE, 3, (/nybrdim,nmoldim,timedim/), tmb3drid) + call check_cdf_status(iret) + endif if(nytr.gt.0) then dims(2) = timedim dims(1) = nytrdim + iret = nf_def_var(ncid, 'na3dtr', NCDOUBLE, 3, (/nytrdim,nsdim,timedim/), na3dtrid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'ne3dtr', NCDOUBLE, 2, dims, ne3dtrid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'te3dtr', NCDOUBLE, 2, dims, te3dtrid) @@ -2045,7 +3046,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'mn3dtr', NCDOUBLE, 2, dims, mn3dtrid) call check_cdf_status(iret) - iret = nf_def_var(ncid, 'fn3dtr', NCDOUBLE, 2, dims, fn3dtrid) + iret = nf_def_var(ncid, 'fn3dtr', NCDOUBLE, 3, (/nytrdim,nsdim,timedim/), fn3dtrid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'fe3dtr', NCDOUBLE, 2, dims, fe3dtrid) call check_cdf_status(iret) @@ -2061,6 +3062,18 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'tp3dtr', NCDOUBLE, 2, dims, tp3dtrid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dab3dtr', NCDOUBLE, 3, (/nytrdim,natmdim,timedim/), dab3dtrid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tab3dtr', NCDOUBLE, 3, (/nytrdim,natmdim,timedim/), tab3dtrid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmb3dtr', NCDOUBLE, 3, (/nytrdim,nmoldim,timedim/), dmb3dtrid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmb3dtr', NCDOUBLE, 3, (/nytrdim,nmoldim,timedim/), tmb3dtrid) + call check_cdf_status(iret) + endif endif endif !not.batch_only @@ -2076,30 +3089,74 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) dims(1) = ncdim dims(2) = batchdim + iret = nf_def_var(ncid, 'nasepm_av', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), nasepm_avid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepm_av', NCDOUBLE, 2, dims, nesepm_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepm_av', NCDOUBLE, 2, dims, tesepm_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepm_av', NCDOUBLE, 2, dims, tisepm_avid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepm_av', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), dabsepm_avid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepm_av', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), tabsepm_avid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepm_av', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), dmbsepm_avid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepm_av', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), tmbsepm_avid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'posepm_av', NCDOUBLE, 2, dims, posepm_avid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepi_av', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), nasepi_avid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepi_av', NCDOUBLE, 2, dims, nesepi_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepi_av', NCDOUBLE, 2, dims, tesepi_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepi_av', NCDOUBLE, 2, dims, tisepi_avid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepi_av', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), dabsepi_avid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepi_av', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), tabsepi_avid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepi_av', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), dmbsepi_avid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepi_av', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), tmbsepi_avid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'posepi_av', NCDOUBLE, 2, dims, posepi_avid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepa_av', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), nasepa_avid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepa_av', NCDOUBLE, 2, dims, nesepa_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepa_av', NCDOUBLE, 2, dims, tesepa_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepa_av', NCDOUBLE, 2, dims, tisepa_avid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepa_av', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), dabsepa_avid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepa_av', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), tabsepa_avid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepa_av', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), dmbsepa_avid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepa_av', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), tmbsepa_avid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'posepa_av', NCDOUBLE, 2, dims, posepa_avid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'namxip_av', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), namxip_avid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nemxip_av', NCDOUBLE, 2, dims, nemxip_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'temxip_av', NCDOUBLE, 2, dims, temxip_avid) @@ -2108,6 +3165,8 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'pomxip_av', NCDOUBLE, 2, dims, pomxip_avid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'namxap_av', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), namxap_avid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nemxap_av', NCDOUBLE, 2, dims, nemxap_avid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'temxap_av', NCDOUBLE, 2, dims, temxap_avid) @@ -2116,30 +3175,74 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'pomxap_av', NCDOUBLE, 2, dims, pomxap_avid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepm_std', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), nasepm_stdid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepm_std', NCDOUBLE, 2, dims, nesepm_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepm_std', NCDOUBLE, 2, dims, tesepm_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepm_std', NCDOUBLE, 2, dims, tisepm_stdid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepm_std', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), dabsepm_stdid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepm_std', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), tabsepm_stdid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepm_std', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), dmbsepm_stdid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepm_std', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), tmbsepm_stdid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'posepm_std', NCDOUBLE, 2, dims, posepm_stdid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepi_std', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), nasepi_stdid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepi_std', NCDOUBLE, 2, dims, nesepi_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepi_std', NCDOUBLE, 2, dims, tesepi_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepi_std', NCDOUBLE, 2, dims, tisepi_stdid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepi_std', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), dabsepi_stdid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepi_std', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), tabsepi_stdid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepi_std', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), dmbsepi_stdid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepi_std', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), tmbsepi_stdid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'posepi_std', NCDOUBLE, 2, dims, posepi_stdid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'nasepa_std', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), nasepa_stdid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nesepa_std', NCDOUBLE, 2, dims, nesepa_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tesepa_std', NCDOUBLE, 2, dims, tesepa_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'tisepa_std', NCDOUBLE, 2, dims, tisepa_stdid) call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_def_var(ncid, 'dabsepa_std', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), dabsepa_stdid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tabsepa_std', NCDOUBLE, 3, (/ncdim,natmdim,batchdim/), tabsepa_stdid) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_def_var(ncid, 'dmbsepa_std', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), dmbsepa_stdid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'tmbsepa_std', NCDOUBLE, 3, (/ncdim,nmoldim,batchdim/), tmbsepa_stdid) + call check_cdf_status(iret) + endif iret = nf_def_var(ncid, 'posepa_std', NCDOUBLE, 2, dims, posepa_stdid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'namxip_std', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), namxip_stdid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nemxip_std', NCDOUBLE, 2, dims, nemxip_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'temxip_std', NCDOUBLE, 2, dims, temxip_stdid) @@ -2148,6 +3251,8 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_def_var(ncid, 'pomxip_std', NCDOUBLE, 2, dims, pomxip_stdid) call check_cdf_status(iret) + iret = nf_def_var(ncid, 'namxap_std', NCDOUBLE, 3, (/ncdim,nsdim,batchdim/), namxap_stdid) + call check_cdf_status(iret) iret = nf_def_var(ncid, 'nemxap_std', NCDOUBLE, 2, dims, nemxap_stdid) call check_cdf_status(iret) iret = nf_def_var(ncid, 'temxap_std', NCDOUBLE, 2, dims, temxap_stdid) @@ -2164,6 +3269,66 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, timesaid, 'units', 2, 's ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsiid, 'long_name', 35, 'radial coordinate, inboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsiid, 'units', 2, 'm ') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsaid, 'long_name', 36, 'radial coordinate, outboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsaid, 'units', 2, 'm ') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dslid, 'long_name', 31, 'radial coordinate, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dslid, 'units', 2, 'm ') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsLTid, 'long_name', 26, 'target areas, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsLTid, 'units', 3, 'm^2') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsLPid, 'long_name', 35, 'poloial contact areas, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsLPid, 'units', 3, 'm^2') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsrid, 'long_name', 30, 'radial coordinate, Easter edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsrid, 'units', 2, 'm ') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsRTid, 'long_name', 26, 'target areas, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsRTid, 'units', 3, 'm^2') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsRPid, 'long_name', 36, 'poloidal contact areas, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsRPid, 'units', 3, 'm^2') + call check_cdf_status(iret) + if(nytl.gt.0) then + iret = nf_put_att_text(ncid, dstlid, 'long_name', 41, 'radial coordinate, upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dstlid, 'units', 2, 'm ') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTLTid, 'long_name', 36, 'target areas, upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTLTid, 'units', 3, 'm^2') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTLPid, 'long_name', 46, 'poloidal contact areas, upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTLPid, 'units', 3, 'm^2') + call check_cdf_status(iret) + endif + if(nytr.gt.0) then + iret = nf_put_att_text(ncid, dstrid, 'long_name', 42, 'radial coordinate, upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dstrid, 'units', 2, 'm ') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTRTid, 'long_name', 37, 'target areas, upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTRTid, 'units', 3, 'm^2') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTRPid, 'long_name', 47, 'poloidal contact areas, upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dsTRPid, 'units', 3, 'm^2') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, fnixipid, 'long_name', 47, 'integrated poloidal particle flux, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, fnixipid, 'units', 4, 's^-1') @@ -2204,6 +3369,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, fchxapid, 'units', 2, 'A ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepiid, 'long_name', 46, 'separatrix fluid species density, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepiid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepiid, 'long_name', 41, 'separatrix electron density, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepiid, 'units', 4, 'm^-3') @@ -2216,6 +3385,26 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepiid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepiid, 'long_name', 46, 'separatrix atom density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepiid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepiid, 'long_name', 50, 'separatrix atom temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepiid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepiid, 'long_name', 50, 'separatrix molecule density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepiid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepiid, 'long_name', 54, 'separatrix molecule temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepiid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, tpsepiid, 'long_name', 42, 'separatrix plate temperature, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, tpsepiid, 'units', 2, 'K ') @@ -2224,6 +3413,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepiid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepmid, 'long_name', 48, 'separatrix fluid species density, outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepmid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepmid, 'long_name', 43, 'separatrix electron density, outer midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepmid, 'units', 4, 'm^-3') @@ -2236,6 +3429,26 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepmid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepmid, 'long_name', 48, 'separatrix atom density (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepmid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepmid, 'long_name', 52, 'separatrix atom temperature (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepmid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepmid, 'long_name', 52, 'separatrix molecule density (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepmid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepmid, 'long_name', 56, 'separatrix molecule temperature (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepmid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, posepmid, 'long_name', 36, 'separatrix potential, outer midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepmid, 'units', 2, 'V ') @@ -2270,6 +3483,10 @@ subroutine b2crtimecdf(filename, & iret = nf_put_att_text(ncid, vssepmid, 'units', 12, 'm.kg^-1.s^-1') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepaid, 'long_name', 46, 'separatrix fluid species density, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepaid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepaid, 'long_name', 41, 'separatrix electron density, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepaid, 'units', 4, 'm^-3') @@ -2282,6 +3499,26 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepaid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepaid, 'long_name', 46, 'separatrix atom density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepaid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepaid, 'long_name', 50, 'separatrix atom temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepaid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepaid, 'long_name', 50, 'separatrix molecule density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepaid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepaid, 'long_name', 54, 'separatrix molecule temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepaid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, tpsepaid, 'long_name', 42, 'separatrix plate temperature, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, tpsepaid, 'units', 2, 'K ') @@ -2290,6 +3527,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepaid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxipid, 'long_name', 43, 'maximum fluid species density, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxipid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxipid, 'long_name', 38, 'maximum electron density, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxipid, 'units', 4, 'm^-3') @@ -2310,6 +3551,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, pomxipid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxapid, 'long_name', 43, 'maximum fluid species density, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxapid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxapid, 'long_name', 38, 'maximum electron density, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxapid, 'units', 4, 'm^-3') @@ -2488,6 +3733,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) ! Western edge (inboard divertor for LSN, outboard divertor for USN) quantities + iret = nf_put_att_text(ncid, na3dlid, 'long_name', 35, 'fluid species density, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na3dlid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3dlid, 'long_name', 30, 'electron density, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3dlid, 'units', 4, 'm^-3') @@ -2512,7 +3761,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, po3dlid, 'units', 2, 'V ') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, an3dlid, 'long_name', 26, 'atom density, Western edge') + iret = nf_put_att_text(ncid, an3dlid, 'long_name', 41, 'atom density (main species), Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, an3dlid, 'units', 4, 'm^-3') call check_cdf_status(iret) @@ -2520,8 +3769,32 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, mn3dlid, 'units', 4, 'm^-3') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dab3dlid, 'long_name', 35, 'atom density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dab3dlid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3dlid, 'long_name', 39, 'atom temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3dlid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tab3dlid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmb3dlid, 'long_name', 39, 'molecule density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmb3dlid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3dlid, 'long_name', 43, 'molecule temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3dlid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tmb3dlid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif dvals(1) = -1.0_R8 - iret = nf_put_att_text(ncid, fn3dlid, 'long_name', 40, 'poloidal main species flux, Western edge') + iret = nf_put_att_text(ncid, fn3dlid, 'long_name', 32, 'poloidal atom flux, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, fn3dlid, 'units', 4, 's^-1') call check_cdf_status(iret) @@ -2565,6 +3838,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) ! inboard midplane quantities + iret = nf_put_att_text(ncid, na3diid, 'long_name', 39, 'fluid species density, inboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na3diid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3diid, 'long_name', 34, 'electron density, inboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3diid, 'units', 4, 'm^-3') @@ -2586,7 +3863,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, po3diid, 'units', 2, 'V ') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, an3diid, 'long_name', 30, 'atom density, inboard midplane') + iret = nf_put_att_text(ncid, an3diid, 'long_name', 45, 'atom density (main species), inboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, an3diid, 'units', 4, 'm^-3') call check_cdf_status(iret) @@ -2594,11 +3871,11 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, mn3diid, 'units', 4, 'm^-3') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, dn3diid, 'long_name', 39, 'diffusion coefficient, inboard midplane') + iret = nf_put_att_text(ncid, dn3diid, 'long_name', 40, 'diffusion coefficients, inboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, dn3diid, 'units', 8, 'm^2.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, dp3diid, 'long_name', 48, 'pressure diffusion coefficient, inboard midplane') + iret = nf_put_att_text(ncid, dp3diid, 'long_name', 49, 'pressure diffusion coefficients, inboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, dp3diid, 'units', 8, 'm^2.s^-1') call check_cdf_status(iret) @@ -2618,21 +3895,49 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, ki3diid, 'units', 8, 'm^2.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, vx3diid, 'long_name', 41, 'poloidal pinch velocity, inboard midplane') + iret = nf_put_att_text(ncid, vx3diid, 'long_name', 43, 'poloidal pinch velocities, inboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, vx3diid, 'units', 6, 'm.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, vy3diid, 'long_name', 39, 'radial pinch velocity, inboard midplane') + iret = nf_put_att_text(ncid, vy3diid, 'long_name', 41, 'radial pinch velocities, inboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, vy3diid, 'units', 6, 'm.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, vs3diid, 'long_name', 39, 'viscosity coefficient, inboard midplane') + iret = nf_put_att_text(ncid, vs3diid, 'long_name', 40, 'viscosity coefficients, inboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, vs3diid, 'units', 12, 'm.kg^-1.s^-1') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dab3diid, 'long_name', 39, 'atom density (Eirene), inboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dab3diid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3diid, 'long_name', 43, 'atom temperature (Eirene), inboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3diid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tab3diid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmb3diid, 'long_name', 43, 'molecule density (Eirene), inboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmb3diid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3diid, 'long_name', 47, 'molecule temperature (Eirene), inboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3diid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tmb3diid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif ! upper inboard divertor quantities if(nytl.gt.0) then + iret = nf_put_att_text(ncid, na3dtlid, 'long_name', 45, 'fluid species density, upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na3dtlid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3dtlid, 'long_name', 40, 'electron density, upper inboard divertor') call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3dtlid, 'units', 4, 'm^-3') @@ -2657,7 +3962,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, po3dtlid, 'units', 2, 'V ') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, an3dtlid, 'long_name', 36, 'atom density, upper inboard divertor') + iret = nf_put_att_text(ncid, an3dtlid, 'long_name', 51, 'atom density (main species), upper inboard divertor') call check_cdf_status(iret) iret = nf_put_att_text(ncid, an3dtlid, 'units', 4, 'm^-3') call check_cdf_status(iret) @@ -2665,7 +3970,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, mn3dtlid, 'units', 4, 'm^-3') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, fn3dtlid, 'long_name', 50, 'poloidal main species flux, upper inboard divertor') + iret = nf_put_att_text(ncid, fn3dtlid, 'long_name', 42, 'poloidal atom flux, upper inboard divertor') call check_cdf_status(iret) iret = nf_put_att_text(ncid, fn3dtlid, 'units', 4, 's^-1') call check_cdf_status(iret) @@ -2693,9 +3998,37 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, fc3dtlid, 'units', 2, 'A ') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dab3dtlid, 'long_name', 45, 'atom density (Eirene), upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dab3dtlid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3dtlid, 'long_name', 49, 'atom temperature (Eirene), upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3dtlid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tab3dtlid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmb3dtlid, 'long_name', 49, 'molecule density (Eirene), upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmb3dtlid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3dtlid, 'long_name', 53, 'molecule temperature (Eirene), upper inboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3dtlid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tmb3dtlid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif endif ! outboard midplane quantities + iret = nf_put_att_text(ncid, na3daid, 'long_name', 40, 'fluid species density, outboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na3daid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3daid, 'long_name', 35, 'electron density, outboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3daid, 'units', 4, 'm^-3') @@ -2716,7 +4049,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, po3daid, 'units', 2, 'V ') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, an3daid, 'long_name', 31, 'atom density, outboard midplane') + iret = nf_put_att_text(ncid, an3daid, 'long_name', 46, 'atom density (main species), outboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, an3daid, 'units', 4, 'm^-3') call check_cdf_status(iret) @@ -2724,11 +4057,11 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, mn3daid, 'units', 4, 'm^-3') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, dn3daid, 'long_name', 40, 'diffusion coefficient, outboard midplane') + iret = nf_put_att_text(ncid, dn3daid, 'long_name', 41, 'diffusion coefficients, outboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, dn3daid, 'units', 8, 'm^2.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, dp3daid, 'long_name', 49, 'pressure diffusion coefficient, outboard midplane') + iret = nf_put_att_text(ncid, dp3daid, 'long_name', 50, 'pressure diffusion coefficients, outboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, dp3daid, 'units', 8, 'm^2.s^-1') call check_cdf_status(iret) @@ -2748,20 +4081,48 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, ki3daid, 'units', 8, 'm^2.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, vx3daid, 'long_name', 42, 'poloidal pinch velocity, outboard midplane') + iret = nf_put_att_text(ncid, vx3daid, 'long_name', 44, 'poloidal pinch velocities, outboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, vx3daid, 'units', 6, 'm.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, vy3daid, 'long_name', 40, 'radial pinch velocity, outboard midplane') + iret = nf_put_att_text(ncid, vy3daid, 'long_name', 42, 'radial pinch velocities, outboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, vy3daid, 'units', 6, 'm.s^-1') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, vs3daid, 'long_name', 40, 'viscosity coefficient, outboard midplane') + iret = nf_put_att_text(ncid, vs3daid, 'long_name', 41, 'viscosity coefficients, outboard midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, vs3daid, 'units', 12, 'm.kg^-1.s^-1') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dab3daid, 'long_name', 40, 'atom density (Eirene), outboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dab3daid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3daid, 'long_name', 44, 'atom temperature (Eirene), outboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3daid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tab3daid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmb3daid, 'long_name', 44, 'molecule density (Eirene), outboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmb3daid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3daid, 'long_name', 48, 'molecule temperature (Eirene), outboard midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3daid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tmb3daid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif ! Eastern edge (outboard divertor for LSN, inboard divertor for USN) quantities + iret = nf_put_att_text(ncid, na3drid, 'long_name', 35, 'fluid species density, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na3drid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3drid, 'long_name', 30, 'electron density, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3drid, 'units', 4, 'm^-3') @@ -2786,7 +4147,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, po3drid, 'units', 2, 'V ') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, an3drid, 'long_name', 26, 'atom density, Eastern edge') + iret = nf_put_att_text(ncid, an3drid, 'long_name', 41, 'atom density (main species), Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, an3drid, 'units', 4, 'm^-3') call check_cdf_status(iret) @@ -2794,7 +4155,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, mn3drid, 'units', 4, 'm^-3') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, fn3drid, 'long_name', 40, 'poloidal main species flux, Eastern edge') + iret = nf_put_att_text(ncid, fn3drid, 'long_name', 32, 'poloidal atom flux, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, fn3drid, 'units', 4, 's^-1') call check_cdf_status(iret) @@ -2822,9 +4183,37 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, fc3drid, 'units', 2, 'A ') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dab3drid, 'long_name', 35, 'atom density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dab3drid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3drid, 'long_name', 39, 'atom temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3drid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tab3drid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmb3drid, 'long_name', 39, 'molecule density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmb3drid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3drid, 'long_name', 43, 'molecule temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3drid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tmb3drid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif ! upper outboard divertor quantities if(nytr.gt.0) then + iret = nf_put_att_text(ncid, na3dtrid, 'long_name', 46, 'fluid species density, upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, na3dtrid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3dtrid, 'long_name', 41, 'electron density, upper outboard divertor') call check_cdf_status(iret) iret = nf_put_att_text(ncid, ne3dtrid, 'units', 4, 'm^-3') @@ -2849,7 +4238,7 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, po3dtrid, 'units', 2, 'V ') call check_cdf_status(iret) - iret = nf_put_att_text(ncid, an3dtrid, 'long_name', 37, 'atom density, upper outboard divertor') + iret = nf_put_att_text(ncid, an3dtrid, 'long_name', 52, 'atom density (main species), upper outboard divertor') call check_cdf_status(iret) iret = nf_put_att_text(ncid, an3dtrid, 'units', 4, 'm^-3') call check_cdf_status(iret) @@ -2858,7 +4247,7 @@ subroutine b2crtimecdf(filename, & iret = nf_put_att_text(ncid, mn3dtrid, 'units', 4, 'm^-3') call check_cdf_status(iret) dvals(1) = -1.0_R8 - iret = nf_put_att_text(ncid, fn3dtrid, 'long_name', 51, 'poloidal main species flux, upper outboard divertor') + iret = nf_put_att_text(ncid, fn3dtrid, 'long_name', 43, 'poloidal atom flux, upper outboard divertor') call check_cdf_status(iret) iret = nf_put_att_text(ncid, fn3dtrid, 'units', 4, 's^-1') call check_cdf_status(iret) @@ -2900,9 +4289,38 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_double(ncid, fc3dtrid, 'scale', NCDOUBLE, 1, dvals(1)) call check_cdf_status(iret) + dvals(1) = 1.0_R8/ev + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dab3dtrid, 'long_name', 46, 'atom density (Eirene), upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dab3dtrid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3dtrid, 'long_name', 50, 'atom temperature (Eirene), upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tab3dtrid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tab3dtrid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmb3dtrid, 'long_name', 50, 'molecule density (Eirene), upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmb3dtrid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3dtrid, 'long_name', 54, 'molecule temperature (Eirene), upper outboard divertor') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmb3dtrid, 'units', 2, 'eV') + call check_cdf_status(iret) + iret = nf_put_att_double(ncid, tmb3dtrid, 'scale', NCDOUBLE, 1, dvals(1)) + call check_cdf_status(iret) + endif endif else !wdk averaged quantities + iret = nf_put_att_text(ncid, nasepm_avid, 'long_name', 57, 'averaged separatrix fluid species density, outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepm_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepm_avid, 'long_name', 52, 'averaged separatrix electron density, outer midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepm_avid, 'units', 4, 'm^-3') @@ -2915,10 +4333,35 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepm_avid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepm_avid, 'long_name', 57, 'averaged separatrix atom density (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepm_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepm_avid, 'long_name', 61, 'averaged separatrix atom temperature (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepm_avid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepm_avid, 'long_name', 61, 'averaged separatrix molecule density (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepm_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepm_avid, 'long_name', 65, & + 'averaged separatrix molecule temperature (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepm_avid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, posepm_avid, 'long_name', 45, 'averaged separatrix potential, outer midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepm_avid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepi_avid, 'long_name', 55, 'averaged separatrix fluid species density, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepi_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepi_avid, 'long_name', 50, 'averaged separatrix electron density, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepi_avid, 'units', 4, 'm^-3') @@ -2931,10 +4374,35 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepi_avid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepi_avid, 'long_name', 55, 'averaged separatrix atom density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepi_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepi_avid, 'long_name', 59, 'averaged separatrix atom temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepi_avid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepi_avid, 'long_name', 59, 'averaged separatrix molecule density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepi_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepi_avid, 'long_name', 63, & + 'averaged separatrix molecule temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepi_avid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, posepi_avid, 'long_name', 43, 'averaged separatrix potential, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepi_avid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepa_avid, 'long_name', 55, 'averaged separatrix fluid species density, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepa_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepa_avid, 'long_name', 50, 'averaged separatrix electron density, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepa_avid, 'units', 4, 'm^-3') @@ -2947,10 +4415,35 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepa_avid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepa_avid, 'long_name', 55, 'averaged separatrix atom density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepa_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepa_avid, 'long_name', 59, 'averaged separatrix atom temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepa_avid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepa_avid, 'long_name', 59, 'averaged separatrix molecule density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepa_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepa_avid, 'long_name', 63, & + 'averaged separatrix molecule temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepa_avid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, posepa_avid, 'long_name', 43, 'averaged separatrix potential, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepa_avid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxip_avid, 'long_name', 52, 'averaged maximum fluid species density, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxip_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxip_avid, 'long_name', 47, 'averaged maximum electron density, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxip_avid, 'units', 4, 'm^-3') @@ -2967,6 +4460,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, pomxip_avid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxap_avid, 'long_name', 52, 'averaged maximum fluid species density, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxap_avid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxap_avid, 'long_name', 47, 'averaged maximum electron density, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxap_avid, 'units', 4, 'm^-3') @@ -2985,6 +4482,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) !wdk standard deviation of averaged quantities + iret = nf_put_att_text(ncid, nasepm_stdid, 'long_name', 60, 'variance of separatrix fluid species density, outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepm_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepm_stdid, 'long_name', 55, 'variance of separatrix electron density, outer midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepm_stdid, 'units', 4, 'm^-3') @@ -2997,10 +4498,37 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepm_stdid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepm_stdid, 'long_name', 60, 'variance of separatrix atom density (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepm_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepm_stdid, 'long_name', 64, & + 'variance of separatrix atom temperature (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepm_stdid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepm_stdid, 'long_name', 64, & + 'variance of separatrix molecule density (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepm_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepm_stdid, 'long_name', 68, & + 'variance of separatrix molecule temperature (Eirene), outer midplane') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepm_stdid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, posepm_stdid, 'long_name', 48, 'variance of separatrix potential, outer midplane') call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepm_stdid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepi_stdid, 'long_name', 58, 'variance of separatrix fluid species density, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepi_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepi_stdid, 'long_name', 53, 'variance of separatrix electron density, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepi_stdid, 'units', 4, 'm^-3') @@ -3013,10 +4541,37 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepi_stdid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepi_stdid, 'long_name', 58, 'variance of separatrix atom density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepi_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepi_stdid, 'long_name', 62, & + 'variance of separatrix atom temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepi_stdid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepi_stdid, 'long_name', 62, & + 'variance of separatrix molecule density (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepi_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepi_stdid, 'long_name', 66, & + 'variance of separatrix molecule temperature (Eirene), Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepi_stdid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, posepi_stdid, 'long_name', 46, 'variance of separatrix potential, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepi_stdid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepa_stdid, 'long_name', 58, 'variance of separatrix fluid species density, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, nasepa_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepa_stdid, 'long_name', 53, 'variance of separatrix electron density, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nesepa_stdid, 'units', 4, 'm^-3') @@ -3029,10 +4584,37 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, tisepa_stdid, 'units', 2, 'eV') call check_cdf_status(iret) + if (nnatmi.gt.0) then + iret = nf_put_att_text(ncid, dabsepa_stdid, 'long_name', 58, 'variance of separatrix atom density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dabsepa_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepa_stdid, 'long_name', 62, & + 'variance of separatrix atom temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tabsepa_stdid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif + if (nnmoli.gt.0) then + iret = nf_put_att_text(ncid, dmbsepa_stdid, 'long_name', 62, & + 'variance of separatrix molecule density (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, dmbsepa_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepa_stdid, 'long_name', 66, & + 'variance of separatrix molecule temperature (Eirene), Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, tmbsepa_stdid, 'units', 2, 'eV') + call check_cdf_status(iret) + endif iret = nf_put_att_text(ncid, posepa_stdid, 'long_name', 46, 'variance of separatrix potential, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, posepa_stdid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxip_stdid, 'long_name', 55, 'variance of maximum fluid species density, Western edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxip_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxip_stdid, 'long_name', 50, 'variance of maximum electron density, Western edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxip_stdid, 'units', 4, 'm^-3') @@ -3049,6 +4631,10 @@ subroutine b2crtimecdf(filename, & call check_cdf_status(iret) iret = nf_put_att_text(ncid, pomxip_stdid, 'units', 2, 'V ') call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxap_stdid, 'long_name', 55, 'variance of maximum fluid species density, Eastern edge') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, namxap_stdid, 'units', 4, 'm^-3') + call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxap_stdid, 'long_name', 50, 'variance of maximum electron density, Eastern edge') call check_cdf_status(iret) iret = nf_put_att_text(ncid, nemxap_stdid, 'units', 4, 'm^-3') @@ -3181,13 +4767,13 @@ end subroutine rwcdf_setbatch #endif #endif ! - subroutine output_ds(ny,iref,target_offset,jsep,iystart,iyend,filename) + subroutine output_ds(ny,iref,target_offset,jsep,iystart,iyend,filename,ds) use b2mod_geo use b2mod_indirect implicit none integer ny,iref,jsep,iystart,iyend,target_offset - real (kind=R8) :: & - ds(-1:ny), ds_offset + real (kind=R8), intent(out) :: ds(-1:ny) + real (kind=R8) :: ds_offset character*(*) filename integer iy external xertst diff --git a/src/postprocessing/b2ytdr.F b/src/postprocessing/b2ytdr.F index 0a630ee65..0354f3ca2 100644 --- a/src/postprocessing/b2ytdr.F +++ b/src/postprocessing/b2ytdr.F @@ -177,6 +177,8 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) integer ix1, ix2, iy1, iy2 integer ix11, ix21, iy11, iy21 integer elm_ix1, elm_ix2 + integer neoclassical_iystart, neoclassical_iyend + integer neoclassical_iystart1, neoclassical_iyend1 integer mw_ix1, mw_ix2, mw_jxa, mw_jsep, jsep_cnv, jxa_cnv, iyped integer mw_jxa1, mw_jsep1, jsep1cnv, jxa1cnv, iyped1 integer jsep1, jxi1, jxa1, nxtl1, nxtr1, iswitch, pulse, shot @@ -184,7 +186,7 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) integer coriolis, lhalpha integer nncut1, nnreg1(0:2), periodic_bc1 integer scaling_ix_begin(nscale), scaling_ix_end(nscale) - integer elm_ix_begin, elm_ix_end + integer elm_ix_begin, elm_ix_end, elm_ixref integer ndim, ndm2, nfitanf, nfitend, ifail integer invert_bpol, invert_btor, b2ux7p_style integer naver, ntotdt @@ -480,7 +482,10 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) . scaling_width(nscale), scaling_strength(nscale), . ixfb, iyfb, ixfb1, iyfb1, b2tfhe_vis_par, b2tvspa_vis_par, . xfrhie, xfrhiehz, xfrhie_no_drift, b2tfhe_inert, - . elm_time_begin, elm_time_end, elm_time_period, + . elm_time_begin(nkind_coeff), elm_time_plateau(nkind_coeff), + . elm_time_recovery(nkind_coeff), elm_time_end(nkind_coeff), + . elm_crash_factor(nkind_coeff), elm_recovery_factor(nkind_coeff), + . elm_ballooning_exp(nkind_coeff), elm_time_period, . sources_time_mod, sources_time_switch, fch_ion_neutral, 1 zamin0(0:DEF_NSD-1), zamax0(0:DEF_NSD-1), 2 zn0(0:DEF_NSD-1), am0(0:DEF_NSD-1), @@ -569,6 +574,7 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) logical region_flags(NNREGMAX,nkind_coeff), no_pflux logical region_flags1(NNREGMAX,nkind_coeff) logical poloidal_scaling(nscale), prdone, axdone, spdone + logical elm_dynamics_multiple logical clash(ns-1), shared(0:ns-1) logical track_chem_sput1(ntrack) * ..procedures @@ -624,8 +630,10 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) 1 transport_filename, transport_time_mod, 2 transport_time_switch, scaling_ix_begin, scaling_ix_end, 3 scaling_strength, region_flags, no_pflux, poloidal_scaling, - 4 scaling_width, elm_time_begin, elm_time_end, elm_time_period, - 5 elm_ix_begin, elm_ix_end + 4 scaling_width, elm_time_begin, elm_time_plateau, + 5 elm_time_recovery, elm_time_end, elm_time_period, + 6 elm_crash_factor, elm_recovery_factor, elm_ballooning_exp, + 7 elm_dynamics_multiple, elm_ix_begin, elm_ix_end, elm_ixref namelist /atomic_physics_rescale/ 1 rescale_sa, rescale_ra, rescale_qa, rescale_cx, 3 rescale_rd, rescale_br @@ -1456,6 +1464,8 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) call ipgeti ('set_transport_ixref', ixref) call ipgeti ('set_transport_iyref', iyref) call ipgeti ('eirene_lhalpha', lhalpha) + call ipgeti ('b2tqna_neoclassical_iystart', neoclassical_iystart) + call ipgeti ('b2tqna_neoclassical_iyend', neoclassical_iyend) call ipgeti ('b2tqna_iy1', iy1) call ipgeti ('b2tqna_iy2', iy2) call ipgeti ('b2tqna_ix1', ix1) @@ -1749,6 +1759,10 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) endif iyped1 = conformal_convert . (non_commensurate,2,jxa,iyped,nx,ny,nx1,ny1,4) + neoclassical_iystart1 = conformal_convert + . (non_commensurate,2,jxa,neoclassical_iystart,nx,ny,nx1,ny1,0) + neoclassical_iyend1 = conformal_convert + . (non_commensurate,2,jxa,neoclassical_iyend,nx,ny,nx1,ny1,2) iy11 = conformal_convert . (non_commensurate,2,ix1,iy1,nx,ny,nx1,ny1,0) iy21 = conformal_convert @@ -1878,6 +1892,10 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) iswitch = ixref1 case('set_transport_iyref') iswitch = iyref1 + case('b2tqna_neoclassical_iystart') + iswitch = neoclassical_iystart1 + case('b2tqna_neoclassical_iyend') + iswitch = neoclassical_iyend1 case('b2tqna_iy1') iswitch = iy11 case('b2tqna_iy2') @@ -2884,11 +2902,18 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) scaling_width=0.0_R8 scaling_ix_begin=-2 scaling_ix_end=-2 - elm_time_begin=0.0_R8 - elm_time_end=0.0_R8 + elm_dynamics_multiple=.false. + elm_time_begin(:)=0.0_R8 + elm_time_plateau(:)=0.0_R8 + elm_time_recovery(:)=0.0_R8 + elm_time_end(:)=0.0_R8 elm_time_period=0.0_R8 elm_ix_begin=-2 elm_ix_end=-2 + elm_ixref = jxa + elm_crash_factor(:)=1.0e-10_R8 + elm_recovery_factor(:)=1.0e-10_R8 + elm_ballooning_exp(:)=0.0_R8 transport_filename='b2.transport.inputfile' transport_time_mod=0.0_R8 transport_time_switch=0.0_R8 @@ -3094,12 +3119,39 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) if (maxval(scaling_width(1:nscale)).gt.0.0_R8) > write(99,hlp_frm) . 'SCALING_WIDTH=',scaling_width(1:nscale) - if (elm_time_begin.ne.0.0_R8) write(99,'(1x,a,1p,g10.3,a)') - . 'ELM_TIME_BEGIN=',elm_time_begin,',' - if (elm_time_end.ne.0.0_R8) write(99,'(1x,a,1p,g10.3,a)') - . 'ELM_TIME_END=',elm_time_end,',' + if (elm_dynamics_multiple) then + write(99,'(1x,a)') 'ELM_DYNAMICS_MULTIPLE=T,' + endif + if (any(elm_time_begin.ne.0.0_R8)) then + write(99,'(1x,a,1p,9(g10.3,:,","),a)') + . 'ELM_TIME_BEGIN=', elm_time_begin, ',' + end if + if (any(elm_time_plateau.ne.0.0_R8)) then + write(99,'(1x,a,1p,9(g10.3,:,","),a)') + . 'ELM_TIME_PLATEAU=', elm_time_plateau, ',' + end if + if (any(elm_time_recovery.ne.0.0_R8)) then + write(99,'(1x,a,1p,9(g10.3,:,","),a)') + . 'ELM_TIME_RECOVERY=', elm_time_recovery, ',' + end if + if (any(elm_time_end.ne.0.0_R8)) then + write(99,'(1x,a,1p,9(g10.3,:,","),a)') + . 'ELM_TIME_END=', elm_time_end, ',' + end if if (elm_time_period.ne.0.0_R8) write(99,'(1x,a,1p,g10.3,a)') . 'ELM_TIME_PERIOD=',elm_time_period,',' + if (any(elm_crash_factor.ne.1.0e-10_R8)) then + write(99,'(1x,a,1p,9(g10.3,:,","),a)') + . 'ELM_CRASH_FACTOR=', elm_crash_factor, ',' + end if + if (any(elm_recovery_factor.ne.1.0e-10_R8)) then + write(99,'(1x,a,1p,9(g10.3,:,","),a)') + . 'ELM_RECOVERY_FACTOR=', elm_recovery_factor, ',' + end if + if (any(elm_ballooning_exp.ne.0.0_R8)) then + write(99,'(1x,a,1p,9(g10.3,:,","),a)') + . 'ELM_BALLOONING_EXP=', elm_ballooning_exp, ',' + end if if (elm_ix_begin.ne.-2) then elm_ix_begin = conformal_convert(non_commensurate,1, . elm_ix_begin,jsep,nx,ny,nx1,ny1,1) @@ -3111,6 +3163,12 @@ subroutine b2ytdr (ninp, nout, nx1, ny1) . elm_ix_end,jsep,nx,ny,nx1,ny1,3) write(99,'(1x,a,i4,a)') . 'ELM_IX_END=',elm_ix_end,',' + endif + if (elm_ixref.ne.jxa) then + elm_ixref = conformal_convert(non_commensurate,1, + . elm_ixref,jsep,nx,ny,nx1,ny1,3) + write(99,'(1x,a,i4,a)') + . 'ELM_IXREF=',elm_ixref,',' endif write(99,'(a1)') '/' close(99) diff --git a/src/transport/b2tqna.F b/src/transport/b2tqna.F index deff5a309..e3cb06f66 100644 --- a/src/transport/b2tqna.F +++ b/src/transport/b2tqna.F @@ -106,6 +106,8 @@ subroutine b2tqna (nx, ny, ns, nscx, iscx, bb, na, 1 transport_namelist, user_transport, transport_inputfile, 2 jsep, jxi, jxa integer, save :: model_sig = 0, iout = 0, iout_b2wdat = 0 !srv 02.12.04 + integer, save :: neo_time_steps = 1, nstg2=1 + integer, save :: neo_output = 0 character chns*3 !srv 10.11.09 real (kind=R8) :: * ballooning, bb_ref, ballooning_rescale, pfr_rescale, @@ -172,6 +174,10 @@ subroutine b2tqna (nx, ny, ns, nscx, iscx, bb, na, call ipgeti ('b2tqna_model_sig', model_sig) !srv 02.12.04 call ipgeti ('b2tqna_iout', iout) !srv 10.11.09 call ipgeti ('b2wdat_iout', iout_b2wdat) !iys 17.04.17 + call ipgeti ('b2tqna_neoclassical_time_steps', neo_time_steps) + call ipgeti ('b2tqna_neoclassical_output', + 1 neo_output) + call ipgeti ('b2mndt_nstg2', nstg2) endif * ..set n2 n2 = (nx+2)*(ny+2) @@ -481,7 +487,8 @@ subroutine b2tqna (nx, ny, ns, nscx, iscx, bb, na, endif call set_transport_neo(nx, ny, ns, hx, hy1, vol, crx, cry, & conn, bb, na, te, ti, ni, ne, dna0, dpa0, vla0, vsa0, - & hci0, hcib, hce0, sig0, alf0, hvi0, hve0) + & hci0, hcib, hce0, sig0, alf0, hvi0, hve0, neo_time_steps, + & neo_output, nstg2, jsep) c ank added blobby transport !! FIXME: Was user_transport.eq.6 in 4.x, 5.0/5.1 elseif(user_transport.eq.9) then @@ -2707,7 +2714,7 @@ end subroutine set_transport_disruption subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, & crx, cry, conn, bb, na, te, ti, ni, ne, & dna0, dpa0, vla0, vsa0, hci0, hcib, hce0, sig0, alf0, - & hvi0, hve0) + & hvi0, hve0, neo_time_steps, neo_output, nstg2, jsep) use b2mod_types use b2mod_indirect use b2mod_constants @@ -2721,7 +2728,8 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, use b2mod_subsys implicit none * ..input arguments (unchanged on exit) - integer nx, ny, ns + integer nx, ny, ns, jsep + integer neo_time_steps, neo_output, nstg2 real (kind=R8) :: * bb(-1:nx,-1:ny,0:3), na(-1:nx,-1:ny,0:ns-1), & te(-1:nx,-1:ny), ti(-1:nx,-1:ny), ni(-1:nx,-1:ny,0:1), @@ -2747,7 +2755,8 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, save ncall, ixref, iyref, transpbgr_namelist data transpbgr_namelist/1/ * ..local variables for neoclassical transport - integer, save :: ic + integer, save :: ic, iystart, iyend, dna_set, vla_set, hci_set, + * hvi_set, hce_set, hve_set integer :: istate,ispecies,ishift integer :: isorth(0:nsdecl,0:nzdecl-1), nclh(0:nsdecl), nslh real (kind=R8) :: @@ -2763,6 +2772,10 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, & cellface(0:nsdecl,0:nzdecl-1,-1:ny,1:5) real (kind=R8) :: * zacomp, amcomp, epsn + character*256 filename + logical ex + logical, save :: neo_ns_set(0:nsdecl) + namelist /neoclassical_transport/ neo_ns_set * ..set the accuracy parameter (epsn=1.e-3) real (kind=R8) :: @@ -2778,6 +2791,13 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, & gradnsav(0:nsdecl,0:nzdecl-1,-1:ny), & tforce(0:nsdecl,0:nzdecl-1,1:2,-1:ny) + real (kind=R8), allocatable :: dd_output(:,:) + real (kind=R8), allocatable :: vvn_output(:,:) + real (kind=R8), allocatable :: chi_i_output(:,:) + real (kind=R8), allocatable :: vwt_i_output(:,:) + real (kind=R8), allocatable :: chi_e_output(:) + real (kind=R8), allocatable :: vwt_e_output(:) + * ..procedures external ipgeti, ipgetr, b2xvsg, fluxav, sfluxav, & tfluxav, neodv, neochi @@ -2791,7 +2811,8 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, * mind that B2 already calculates the classical transport ! * avoid double transport, 0+4 for cross-checks only ! data ic /3/ - + data dna_set /1/, vla_set /1/, hci_set /1/, hvi_set /1/, + * hce_set /1/, hve_set /1/ * ..subprogram start-up calls call subini ('set_transport_neo') if (ncall.eq.0) then @@ -2827,6 +2848,16 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, call xertst (-1.le.iyref.and.iyref.le.ny, 1 'faulty argument set_transport_iyref') call ipgeti ('neoclassical_ic', ic) + iystart = -1 + iyend = jsep + call ipgeti ('b2tqna_neoclassical_iystart', iystart) + call ipgeti ('b2tqna_neoclassical_iyend', iyend) + call ipgeti ('b2tqna_neoclassical_dna', dna_set) + call ipgeti ('b2tqna_neoclassical_vla', vla_set) + call ipgeti ('b2tqna_neoclassical_hci', hci_set) + call ipgeti ('b2tqna_neoclassical_hvi', hvi_set) + call ipgeti ('b2tqna_neoclassical_hce', hce_set) + call ipgeti ('b2tqna_neoclassical_hve', hve_set) call xertst(0.le.ic .and. ic.le.4, . 'invalid parameter neoclassical_ic') write(*,*) 'NEOART option ', ic, ' has been used' @@ -2858,6 +2889,24 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, call b2xvsg (n2, ne, 1, 'ne', '.gt.') endif +* ..read species indices for which to calculate +* the neoclassical transport coefficients + neo_ns_set=.true. + filename='b2.neoclassical_transport.parameters' + call find_file(filename,ex) + if(ex) then + open(99,file=filename) + write(*,*) 'Reading ',trim(filename) +#ifdef USE_MPI + read(99,neoclassical_transport,err=999) +#else + read(99,neoclassical_transport) +#endif + write(*,neoclassical_transport) + close(99) + write(*,*) 'Read ',trim(filename) + endif + * ..main * ..initialize densities and temperatures @@ -2881,134 +2930,134 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, * ..obtain input - call ipgeti ('b2tqna_transpbgr_namelist', transpbgr_namelist) - if(transpbgr_namelist.ge.1) then - call read_b2mod_transpbgr_namelist - call write_b2mod_transpbgr_namelist - endif + call ipgeti ('b2tqna_transpbgr_namelist', transpbgr_namelist) + if(transpbgr_namelist.ge.1) then + call read_b2mod_transpbgr_namelist + call write_b2mod_transpbgr_namelist + endif * ..loop voltage eparr (to be included in a separate routine!) * default value: - eparr=0.0_R8 + eparr=0.0_R8 * read scalar from b2mn.dat - call ipgetr ('b2tqna_eparr', eparr) - write(*,*) 'eparr =', eparr + call ipgetr ('b2tqna_eparr', eparr) + write(*,*) 'eparr =', eparr * ..initialize geometric parameters - do iy=-1,ny - bav_(iy)=0.0_R8 - b2av_(iy)=0.0_R8 - bi2a_(iy)=0.0_R8 - rbt_(iy)=0.0_R8 - bgradp_(iy)=0.0_R8 - dpsidr_(iy)=0.0_R8 - rnq_(iy)=0.0_R8 - fc_(iy)=0.0_R8 - gclass_(iy)=0.0_R8 - do is=1,mmx - fm_(is,iy)=0.0_R8 + do iy=-1,ny + bav_(iy)=0.0_R8 + b2av_(iy)=0.0_R8 + bi2a_(iy)=0.0_R8 + rbt_(iy)=0.0_R8 + bgradp_(iy)=0.0_R8 + dpsidr_(iy)=0.0_R8 + rnq_(iy)=0.0_R8 + fc_(iy)=0.0_R8 + gclass_(iy)=0.0_R8 + do is=1,mmx + fm_(is,iy)=0.0_R8 + enddo + r2i_(iy)=0.0_R8 + rho_(iy)=0.0_R8 enddo - r2i_(iy)=0.0_R8 - rho_(iy)=0.0_R8 - enddo * ..split species into species and charge states - do ispecies=0,nsdecl - ncl(ispecies)=0 - do istate=0,nzdecl-1 - isort(ispecies,istate)=0 + do ispecies=0,nsdecl + ncl(ispecies)=0 + do istate=0,nzdecl-1 + isort(ispecies,istate)=0 + enddo enddo - enddo - do is=0,ns-1 - zah(is)=(zamin(is)+zamax(is))/2.0_R8 - if (zamin(is).ne.zamax(is)) then - write(6,*) 'Warning: '// - . 'neoclassical transport model may not be accurate '// - . 'for bundled charge states!' - end if - amh(is)=am(is) - enddo - do is=0,ns-2 - zacomp=zah(is) - amcomp=amh(is) - ispecies=is - do is2=is+1,ns-1 - if((abs(amh(is2)-amcomp).lt.0.5_R8).and. - & (zah(is2).lt.zacomp)) then - zacomp=zah(is2) - ispecies=is2 - elseif(amh(is2).lt.amcomp) then - amcomp=amh(is2) - zacomp=zah(is2) - ispecies=is2 - endif + do is=0,ns-1 + zah(is)=(zamin(is)+zamax(is))/2.0_R8 + if (zamin(is).ne.zamax(is)) then + write(6,*) 'Warning: '// + . 'neoclassical transport model may not be accurate '// + . 'for bundled charge states!' + end if + amh(is)=am(is) enddo - zah(ispecies)=zah(is) - amh(ispecies)=amh(is) - zah(is)=zacomp - amh(is)=amcomp - enddo - ispecies=1 - istate=1 - amcomp=amh(0) - do is=1,ns-1 - if((amh(is)-amcomp).gt.0.5_R8) then - ncl(ispecies-1)=istate - ispecies=ispecies+1 + do is=0,ns-2 + zacomp=zah(is) amcomp=amh(is) - istate=1 - elseif(abs(amh(is)-amcomp).lt.0.5_R8) then - istate=istate+1 - endif - enddo + ispecies=is + do is2=is+1,ns-1 + if((abs(amh(is2)-amcomp).lt.0.5_R8).and. + & (zah(is2).lt.zacomp)) then + zacomp=zah(is2) + ispecies=is2 + elseif(amh(is2).lt.amcomp) then + amcomp=amh(is2) + zacomp=zah(is2) + ispecies=is2 + endif + enddo + zah(ispecies)=zah(is) + amh(ispecies)=amh(is) + zah(is)=zacomp + amh(is)=amcomp + enddo + ispecies=1 + istate=1 + amcomp=amh(0) + do is=1,ns-1 + if((amh(is)-amcomp).gt.0.5_R8) then + ncl(ispecies-1)=istate + ispecies=ispecies+1 + amcomp=amh(is) + istate=1 + elseif(abs(amh(is)-amcomp).lt.0.5_R8) then + istate=istate+1 + endif + enddo - ncl(ispecies-1)=istate + ncl(ispecies-1)=istate - nsl=ispecies + nsl=ispecies - is=0 - do ispecies=0,nsl-1 - do istate=0,ncl(ispecies)-1 - do is2=0,ns-1 - if((abs(am(is2)-amh(is)).lt.0.5_R8).and. - & (abs((zamin(is2)+zamax(is2))/2.0_R8-zah(is)).lt. - . 0.5_R8)) then - isort(ispecies,istate)=is2 - endif + is=0 + do ispecies=0,nsl-1 + do istate=0,ncl(ispecies)-1 + do is2=0,ns-1 + if((abs(am(is2)-amh(is)).lt.0.5_R8).and. + & (abs((zamin(is2)+zamax(is2))/2.0_R8-zah(is)).lt. + . 0.5_R8)) then + isort(ispecies,istate)=is2 + endif + enddo + is=is+1 enddo - is=is+1 enddo - enddo * ..remove neutrals from list - do ispecies=0,nsl-1 - nclh(ispecies)=ncl(ispecies) - enddo - nslh=nsl - isorth=isort - do ispecies=0,nsl-1 - do istate=0,ncl(ispecies)-1 - if (is_neutral(isort(ispecies,istate))) then - nclh(ispecies)=nclh(ispecies)-1 - if (nclh(ispecies).eq.0) nslh=nslh-1 + do ispecies=0,nsl-1 + nclh(ispecies)=ncl(ispecies) + enddo + nslh=nsl + isorth=isort + do ispecies=0,nsl-1 + do istate=0,ncl(ispecies)-1 + if (is_neutral(isort(ispecies,istate))) then + nclh(ispecies)=nclh(ispecies)-1 + if (nclh(ispecies).eq.0) nslh=nslh-1 + endif + enddo + enddo + is=0 + do ispecies=0,nsl-1 + if (nclh(ispecies).ne.0) then + nclh(is)=nclh(ispecies) + is=is+1 endif enddo - enddo - is=0 - do ispecies=0,nsl-1 - if (nclh(ispecies).ne.0) then - nclh(is)=nclh(ispecies) - is=is+1 - endif - enddo - is=0 - is2=0 - do ispecies=0,nsl-1 - do istate=0,ncl(ispecies)-1 - if (.not. is_neutral(isorth(ispecies,istate))) then - isort(is,is2)=isorth(ispecies,istate) - is2=is2+1 - if (is2.gt.(nclh(is)-1)) then + is=0 + is2=0 + do ispecies=0,nsl-1 + do istate=0,ncl(ispecies)-1 + if (.not. is_neutral(isorth(ispecies,istate))) then + isort(is,is2)=isorth(ispecies,istate) + is2=is2+1 + if (is2.gt.(nclh(is)-1)) then is=is+1 is2=0 endif @@ -3212,9 +3261,14 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, endif -* ..now calculate the neoclassical transport (if newneo set) - - if (newneo) then +* ..now calculate the neoclassical transport +* ..coefficients are recalculated only every neo_time_steps B2.5 time steps. +* ..newneo sets whether the coefficients are recalculated during the +* several calls of b2tqna occurring within every B2.5 time step. +* ..TO FIX: for now only works if nstg0=1 and nstg1=1, in which case +* there are 2+nstg2 calls of b2tqna for every B2.5 time step + if ((mod(ncall,(2+nstg2)*neo_time_steps) .ge. 1 .and. mod(ncall, & + & (2+nstg2)*neo_time_steps).le. (2+nstg2)) .and. newneo) then * ..loop over flux surfaces do iy=0,ny @@ -3298,13 +3352,22 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, r2i=r2i_(iy) rho=rho_(iy) + if (iy >= iystart .and. iy <= iyend) then + * ..calculate the diffusion coefficients - call neodv(nsdecl,nzdecl,nsl,ncl,zsp,ic,m,t,den,ds,rho,eparr, - & epsn,dd(:,:,iy),vvn(:,:,iy),vtn(:,:,iy)) + if (dna_set == 1 .or. vla_set == 1 .or. neo_output == 1) then + call neodv(nsdecl,nzdecl,nsl,ncl,zsp,ic,m,t,den,ds,rho, + & eparr,epsn,dd(:,:,iy),vvn(:,:,iy),vtn(:,:,iy)) + endif * ..calculate the heat conduction coefficients - call neochi(nsdecl,nzdecl,nsl,ncl,zsp,ic,m,t,den,ds,rho,eparr, - & epsn,kappa(:,:,iy),chi(:,:,iy),vw(:,:,iy)) + if (hci_set == 1 .or. hvi_set == 1 .or. hce_set == 1 + & .or. hve_set == 1 .or. neo_output == 1) then + call neochi(nsdecl,nzdecl,nsl,ncl,zsp,ic,m,t,den,ds,rho, + & eparr,epsn,kappa(:,:,iy),chi(:,:,iy),vw(:,:,iy)) + endif + + endif * ..calculate thermal conductivity and heat pinch from * q(i,j) = - kappa(i,j)*grad.T(i) + vw(i,j)*T(i) @@ -3493,6 +3556,60 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, write(*,*) 'use previous neoclassical transport coefficients' endif +* ..output the neoclassical transport coefficients to the b2neo.nc file +* ..TO FIX: for now only works if nstg0=1 and nstg1=1, in which case +* there are 2+nstg2 calls of b2tqna for every B2.5 time step + +#ifndef NO_CDF + + if (neo_output == 1) then + + if (ncall.ne.0 .and. (mod(ncall,(2+nstg2)*neo_time_steps) & + & .eq. 0)) then + + allocate(dd_output(ny+2,ns)) + allocate(vvn_output(ny+2,ns)) + allocate(chi_i_output(ny+2,ns)) + allocate(vwt_i_output(ny+2,ns)) + allocate(chi_e_output(ny+2)) + allocate(vwt_e_output(ny+2)) + + dd_output=0.0_R8 + vvn_output=0.0_R8 + chi_i_output=0.0_R8 + vwt_i_output=0.0_R8 + chi_e_output=0.0_R8 + vwt_e_output=0.0_R8 + + do iy=-1,ny + do ispecies=0,nsl-2 + do istate=0,ncl(ispecies)-1 + is=isort(ispecies,istate) + dd_output(iy+2,is+1)=(dd(ispecies,istate,iy)) + vvn_output(iy+2,is+1)=(vvn(ispecies,istate,iy)) + chi_i_output(iy+2,is+1)=(chi(ispecies,istate,iy)) + vwt_i_output(iy+2,is+1)=(vwt(ispecies,istate,iy)) + enddo + enddo + chi_e_output(iy+2)=(chi(nsl-1,0,iy)) + vwt_e_output(iy+2)=(vwt(nsl-1,0,iy)) + enddo + + call b2neooutput(ny,ns,dd_output,vvn_output, + & chi_i_output,vwt_i_output,chi_e_output,vwt_e_output) + + deallocate(dd_output) + deallocate(vvn_output) + deallocate(chi_i_output) + deallocate(vwt_i_output) + deallocate(chi_e_output) + deallocate(vwt_e_output) + + endif + + endif + +#endif ! if (mod(ncall,200).eq.0) then ! write(*,*) 'temperature output', ncall @@ -3548,29 +3665,47 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, do ix=-1,nx do iy=-1,ny if (on_closed_surface(ix,iy)) then - do ispecies=0,nsl-2 - do istate=0,ncl(ispecies)-1 - is=isort(ispecies,istate) - dna0(ix,iy,is)=dna0(ix,iy,is)+dd(ispecies,istate,iy)* - & (hy1(ix,iy)/hy1(ixref,iy))**2 - vla0(ix,iy,1,is)=vla0(ix,iy,1,is)+ - & vvn(ispecies,istate,iy)*(hy1(ix,iy)/hy1(ixref,iy)) - dfhcb=chi(ispecies,istate,iy)* - & (hy1(ix,iy)/hy1(ixref,iy))**2 - hci0(ix,iy)=hci0(ix,iy)+dfhcb*na(ix,iy,is) - hcib(ix,iy,is)=hcib(ix,iy,is)+dfhcb*na(ix,iy,is) - hvi0(ix,iy,1)=hvi0(ix,iy,1)+vwt(ispecies,istate,iy)* - & (hy1(ix,iy)/hy1(ixref,iy))*na(ix,iy,is)/ - & (ni(ix,iy,0)+ni_ext(ix,iy,0)) + if (iy >= iystart .and. iy <= iyend) then + do ispecies=0,nsl-2 + do istate=0,ncl(ispecies)-1 + is=isort(ispecies,istate) + if (dna_set == 1) then + if (neo_ns_set(is)) then + dna0(ix,iy,is)=dna0(ix,iy,is)+dd(ispecies,istate,iy)* + & (hy1(ix,iy)/hy1(ixref,iy))**2 + endif + endif + if (vla_set == 1) then + if (neo_ns_set(is)) then + vla0(ix,iy,1,is)=vla0(ix,iy,1,is)+ + & vvn(ispecies,istate,iy)*(hy1(ix,iy)/hy1(ixref,iy)) + endif + endif + if (hci_set == 1) then + dfhcb=chi(ispecies,istate,iy)* + & (hy1(ix,iy)/hy1(ixref,iy))**2 + hci0(ix,iy)=hci0(ix,iy)+dfhcb*na(ix,iy,is) + hcib(ix,iy,is)=hcib(ix,iy,is)+dfhcb*na(ix,iy,is) + endif + if (hvi_set == 1) then + hvi0(ix,iy,1)=hvi0(ix,iy,1)+vwt(ispecies,istate,iy)* + & (hy1(ix,iy)/hy1(ixref,iy))*na(ix,iy,is)/ + & (ni(ix,iy,0)+ni_ext(ix,iy,0)) + endif + enddo enddo - enddo - dfhce=chi(nsl-1,0,iy)*(hy1(ix,iy)/hy1(ixref,iy))**2 - if (dfhce.lt.0) then - write(*,*) 'dfhce(',ix,',',iy,')=',dfhce + if (hce_set == 1) then + dfhce=chi(nsl-1,0,iy)*(hy1(ix,iy)/hy1(ixref,iy))**2 + if (dfhce.lt.0) then + write(*,*) 'dfhce(',ix,',',iy,')=',dfhce + endif + hce0(ix,iy)=hce0(ix,iy)+dfhce*ne(ix,iy) + endif + if (hve_set == 1) then + hve0(ix,iy,1)=hve0(ix,iy,1)+ + & vwt(nsl-1,0,iy)*(hy1(ix,iy)/hy1(ixref,iy)) + endif endif - hce0(ix,iy)=hce0(ix,iy)+dfhce*ne(ix,iy) - hve0(ix,iy,1)=hve0(ix,iy,1)+ - & vwt(nsl-1,0,iy)*(hy1(ix,iy)/hy1(ixref,iy)) * ..set constant anomalous transport in the SOL and divertor regions elseif (.not.on_closed_surface(ix,iy)) then @@ -3594,8 +3729,210 @@ subroutine set_transport_neo(nx, ny, ns, hx, hy1, vol, call subend () return +#ifdef USE_MPI + 999 call xerrab + . ('Error while reading NEOCLASSICAL_TRANSPORT namelist!') +#endif + end subroutine set_transport_neo +#ifndef NO_CDF + + subroutine b2neooutput(ny,ns,dd_output,vvn_output, + & chi_i_output,vwt_i_output,chi_e_output,vwt_e_output) + + use b2mod_types + use b2mod_time + use b2mod_mwti + use b2mod_subsys + + implicit none + +# include + + integer ncall + + integer, save :: ntstep, nastep + integer, save :: ncid + integer iret, is, ispecies, istate, ix, ixref, iy + integer ns,nsl,ncl,ny + integer nvars, natts, ndims, unlimid + real (kind=R8) :: tstepn(1), timesa(1) + real (kind=R8) :: dd_output(ny+2,ns), vvn_output(ny+2,ns), + & chi_i_output(ny+2,ns), vwt_i_output(ny+2,ns), + & chi_e_output(ny+2), vwt_e_output(ny+2) + + logical ex + character*5 rw + character*256, save :: filename + save ncall + data ncall/0/ + external check_cdf_status + + call subini ('b2neooutput') + + if (ncall.eq.0) then + + filename='b2neo.nc' + + ntstep = 0 + call b2crneocdf(filename,ny,ns,iret) + call check_cdf_status(iret) + iret = nf_open(trim(filename),or(NF_WRITE,NF_SHARE),ncid) + call check_cdf_status(iret) + + rw='write' + tstepn(1) = ntstep + call rwcdf(rw, ncid, 'ntstep', (/1/), tstepn, iret) + call check_cdf_status(iret) + iret = nf_close(ncid) + call check_cdf_status(iret) + + endif + + ntstep = ntstep + 1 + call rwcdf_settime ('time', ntstep) + timesa(1) = tim + + rw = 'write' + iret = nf_open(filename, or(NF_WRITE,NF_SHARE), ncid) + call check_cdf_status(iret) + tstepn(1) = ntstep + call rwcdf(rw,ncid,'ntstep',(/1/),tstepn,iret) + call rwcdf(rw,ncid,'timesa',(/1/),timesa,iret) + call rwcdf(rw,ncid,'dd',(/1,1,1/),dd_output,iret) + call rwcdf(rw,ncid,'vvn',(/1,1,1/),vvn_output,iret) + call rwcdf(rw,ncid,'chi_i',(/1,1,1/),chi_i_output,iret) + call rwcdf(rw,ncid,'vwt_i',(/1,1,1/),vwt_i_output,iret) + call rwcdf(rw,ncid,'chi_e',(/1,1/),chi_e_output,iret) + call rwcdf(rw,ncid,'vwt_e',(/1,1/),vwt_e_output,iret) + + iret = nf_close(ncid) + call check_cdf_status(iret) + + ncall = ncall+1 + call subend() + return + + end subroutine b2neooutput + + subroutine b2crneocdf(filename,ny,ns,iret) +# include + integer ny, ns, iret + character*256 :: filename + ! NetCDF id + integer ncid + ! dimension ids + integer :: timedim + ! variable ids + integer :: ntstepid, timesaid, + & ddid, vvnid, chiiid, vwtiid, chieid, vwteid + ! variable shapes + integer :: dims(2) + ! CDF format variable + integer, save :: cdf_default = 0 + ! Procedures + external ipgeti, check_cdf_status + + ! Create and enter define mode + call ipgeti ('b2mndr_cdf_default', cdf_default) + if (cdf_default.eq.3 .or. cdf_default.eq.4) then + iret = nf_create(trim(filename), or(ncclob,nf_netcdf4), ncid) + else + iret = nf_create(trim(filename), ncclob, ncid) + end if + call check_cdf_status(iret) + + ! define dimensions + iret = nf_def_dim(ncid, 'ny', ny+2, nydim) + call check_cdf_status(iret) + iret = nf_def_dim(ncid, 'ns', ns, nsdim) + call check_cdf_status(iret) + iret = nf_def_dim(ncid, 'time', ncunlim, timedim) + call check_cdf_status(iret) + + ! define variables + dims(1) = 0 + iret = nf_def_var(ncid, 'ntstep', NCDOUBLE, 0, + & dims, ntstepid) + call check_cdf_status(iret) + dims(1) = timedim + iret = nf_def_var(ncid, 'timesa', NCDOUBLE, 1, + & dims, timesaid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'dd', NCDOUBLE, 3, + & (/nydim,nsdim,timedim/), ddid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'vvn', NCDOUBLE, 3, + & (/nydim,nsdim,timedim/), vvnid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'chi_i', NCDOUBLE, 3, + & (/nydim,nsdim,timedim/), chiiid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'vwt_i', NCDOUBLE, 3, + & (/nydim,nsdim,timedim/), vwtiid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'chi_e', NCDOUBLE, 2, + & (/nydim,timedim/), chieid) + call check_cdf_status(iret) + iret = nf_def_var(ncid, 'vwt_e', NCDOUBLE, 2, + & (/nydim,timedim/), vwteid) + call check_cdf_status(iret) + + ! assign attributes + iret = nf_put_att_text(ncid, timesaid, + & 'long_name', 4,'time') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, timesaid, + % 'units', 2, 's ') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, ddid, + & 'long_name', 20, 'particle diffusivity') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, ddid, + & 'units', 8, 'm^2.s^-1') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, vvnid, + & 'long_name', 26, 'radial convective velocity') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, vvnid, + & 'units', 6, 'm.s^-1') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, chiiid, + & 'long_name', 24, 'ion thermal conductivity') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, chiiid, + & 'units', 8, 'm^2.s^-1') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, vwtiid, + & 'long_name', 35, 'radial ion thermal strange velocity') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, vwtiid, + & 'units', 6, 'm.s^-1') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, chieid, + & 'long_name', 29, 'electron thermal conductivity') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, chieid, + & 'units', 8, 'm^2.s^-1') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, vwteid, + & 'long_name', 40, 'radial electron thermal strange velocity') + call check_cdf_status(iret) + iret = nf_put_att_text(ncid, vwteid, + & 'units', 6, 'm.s^-1') + call check_cdf_status(iret) + ! leave define mode + iret = nf_enddef(ncid) + call check_cdf_status(iret) + iret = nf_close(ncid) + call check_cdf_status(iret) + return + + end subroutine b2crneocdf + +#endif + subroutine set_profile(fnm, n, coord, fun) !srv 01.03.07 { use b2mod_types implicit none diff --git a/src/user/cdfmovie.F b/src/user/cdfmovie.F index 8a734c5ed..1a12048fe 100644 --- a/src/user/cdfmovie.F +++ b/src/user/cdfmovie.F @@ -2,6 +2,9 @@ subroutine cdfmovie(ncid,nx,ny,ns) use b2mod_types use b2mod_plasma use b2mod_sources + use b2mod_anomalous_transport + use b2mod_b2cmpa + use b2mod_rates use b2mod_geo use b2mod_time #ifndef NO_CDF @@ -45,6 +48,7 @@ subroutine cdfmovie(ncid,nx,ny,ns) integer, save :: write_b25_state_variables = 1 integer, save :: write_b25_fluxes = 0 integer, save :: write_b25_sources = 0 + integer, save :: write_b25_transport = 0 integer, save :: write_eirene_state_variables = 0 integer, save :: write_eirene_fluxes = 0 integer, save :: write_eirene_sources = 0 @@ -59,6 +63,7 @@ subroutine cdfmovie(ncid,nx,ny,ns) 1 write_b25_state_variables) call ipgeti ('cdfmovie_b25_fluxes', write_b25_fluxes) call ipgeti ('cdfmovie_b25_sources', write_b25_sources) + call ipgeti ('cdfmovie_b25_transport', write_b25_transport) call ipgeti ('cdfmovie_eirene_state_variables', 1 write_eirene_state_variables) call ipgeti ('cdfmovie_eirene_fluxes', write_eirene_fluxes) @@ -89,6 +94,8 @@ subroutine cdfmovie(ncid,nx,ny,ns) 1 'Ion density', 'm^-3') call create_cdf_field2(ncid, 'ne', 1 'Electron density', 'm^-3') + call create_cdf_field3(ncid, 'ua', 1, + 1 'Ion parallel velocity', 'm s^-1') call create_cdf_field2(ncid, 'te', 1 'Electron temperature', 'eV') call create_cdf_field2(ncid, 'ti', @@ -147,6 +154,22 @@ subroutine cdfmovie(ncid,nx,ny,ns) call create_cdf_field2(ncid, 'rqradsum', 1 'Total volumetric line radiation rate', 'W m^-3') endif + if (write_b25_transport.ge.1) then + call create_cdf_field3(ncid, 'dna', 1, + 1 'Particle density-driven diffusivity', 'm^-2 s^-1') + call create_cdf_field3(ncid, 'dpa', 1, + 1 'Particle pressure-driven diffusivity', 'm^-2 s^-1') + call create_cdf_field2(ncid, 'hci', + 1 'Ion thermal anomalous diffusivity', 'm^-2 s^-1') + call create_cdf_field2(ncid, 'hce', + 1 'Electron thermal anomalous diffusivity', 'm^-2 s^-1') + call create_cdf_field3(ncid, 'vlax', 1, + 1 'Poloidal anomalous pinch velocity', 'm s^-1') + call create_cdf_field3(ncid, 'vlay', 1, + 1 'Radial anomalous pinch velocity', 'm s^-1') + call create_cdf_field3(ncid, 'vsa', 1, + 1 'Anomalous viscosity', 'm kg^-1 s^-1') + endif #ifdef B25_EIRENE if (write_eirene_state_variables.ge.1) then if(nnatmi.gt.0) then @@ -288,6 +311,8 @@ subroutine cdfmovie(ncid,nx,ny,ns) call put_cdf_field3(ncid,'na',na,nx+2,ny+2,ns) write(*,*) 'put_cdf_field2: ne' call put_cdf_field2(ncid,'ne',ne,nx+2,ny+2) + write(*,*) 'put_cdf_field3: ua' + call put_cdf_field3(ncid,'ua',ua,nx+2,ny+2,ns) write(*,*) 'put_cdf_field2: te' dummy(:,:) = te(:,:)/qe call put_cdf_field2(ncid,'te',dummy,nx+2,ny+2) @@ -405,6 +430,32 @@ subroutine cdfmovie(ncid,nx,ny,ns) write(*,*) 'put_cdf_field2: rqradsum' call put_cdf_field2(ncid,'rqradsum',dummy,nx+2,ny+2) endif + if (write_b25_transport.ge.1) then + write(*,*) 'put_cdf_field3: dna' + call put_cdf_field3(ncid,'dna',dna0,nx+2,ny+2,ns) + write(*,*) 'put_cdf_field3: dpa' + do is=0,ns-1 + dummy3(:,:,is) = dpa0(:,:,is)*(rza(:,:,is)*te(:,:)+ti(:,:)) + enddo + call put_cdf_field3(ncid,'dpa',dummy3,nx+2,ny+2,ns) + write(*,*) 'put_cdf_field2: hci' + dummy(:,:) = hci0(:,:)/ni(:,:,0) + call put_cdf_field2(ncid,'hci',dummy,nx+2,ny+2) + write(*,*) 'put_cdf_field2: hce' + dummy(:,:) = hce0(:,:)/ne(:,:) + call put_cdf_field2(ncid,'hce',dummy,nx+2,ny+2) + write(*,*) 'put_cdf_field3: vlax' + dummy3(:,:,:) = vla0(:,:,0,:) + call put_cdf_field3(ncid,'vlax',dummy3,nx+2,ny+2,ns) + write(*,*) 'put_cdf_field3: vlay' + dummy3(:,:,:) = vla0(:,:,1,:) + call put_cdf_field3(ncid,'vlay',dummy3,nx+2,ny+2,ns) + write(*,*) 'put_cdf_field3: vsa' + do is=0,ns-1 + dummy3(:,:,is) = vsa0(:,:,is)/(mp*am(is)*na(:,:,is)) + enddo + call put_cdf_field3(ncid,'vsa',dummy3,nx+2,ny+2,ns) + endif #ifdef B25_EIRENE if (write_eirene_state_variables.ge.1) then if(nnatmi.gt.0) then