diff --git a/src/diagnose.F90 b/src/diagnose.F90 index ed872ad1a74e18b35b26f038ac045dc4f7df5d7d..b3e53fc2c998eb7e6aaa9321b8432494ee331501 100644 --- a/src/diagnose.F90 +++ b/src/diagnose.F90 @@ -157,7 +157,7 @@ SUBROUTINE diagnose_full(kstep) CALL putarrnd(fidres, "/data/metric/hatR", hatR(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/hatZ", hatZ(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/hatB", hatB(izs:ize,0:1), (/1, 1, 1/)) - CALL putarrnd(fidres, "/data/metric/hatB_NL", hatB_NL(izs:ize,0:1), (/1, 1, 1/)) + CALL putarrnd(fidres, "/data/metric/Gamma_NL", Gamma_NL(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/dBdx", dBdx(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/dBdy", dBdy(izs:ize,0:1), (/1, 1, 1/)) CALL putarrnd(fidres, "/data/metric/dBdz", dBdz(izs:ize,0:1), (/1, 1, 1/)) diff --git a/src/geometry_mod.F90 b/src/geometry_mod.F90 index 4c90e1e520794f3e5278eeaab0703fedace44824..7b41ffbf020b36e18da66886c1e70f295dbd4b7a 100644 --- a/src/geometry_mod.F90 +++ b/src/geometry_mod.F90 @@ -57,13 +57,17 @@ implicit none ! derivatives of magnetic field strength REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: dBdx, dBdy, dBdz ! Relative magnetic field strength - REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: hatB, hatB_NL + REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: hatB ! Relative strength of major radius REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: hatR, hatZ ! Some geometrical coefficients REAL(dp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: gradz_coeff ! 1 / [ J_{xyz} \hat{B} ] ! Array to map the index of mode (kx,ky,-pi) to (kx+2pi*s*ky,ky,pi) for sheared periodic boundary condition INTEGER, PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ikx_zBC_L, ikx_zBC_R + ! Geometric factor in front of the nonlinear term (gxx gyy - gxy^2) + REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: Gamma_NL + ! Geometric factor in front of the parallel phi derivative (not implemented) + ! REAL(dp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: Gamma_phipar ! pb_phase, for parallel boundary phase, contains the factor that occurs when taking into account ! that q0 is defined in the middle of the fluxtube whereas the radial position spans in [0,Lx) ! This shift introduces a (-1)^(Nexc*iky) phase change that is included in GENE @@ -166,9 +170,9 @@ CONTAINS gradz_coeff(iz,eo) = 1._dp /(jacobian(iz,eo)*hatB(iz,eo)) ! Nonlinear term prefactor - ! (according to my derivations, there should be a metric dependent factor in front of the Poisson bracket) - hatB_NL(iz,eo) = (gxx(iz,eo)*gyy(iz,eo) - gxy(iz,eo)**2) - + Gamma_NL(iz,eo) = 1._dp ! = G1 + ! Geometric factor in front to the maxwellian dzphi term (not implemented) + ! Gamma_phipar(iz,eo) = -G2/G1 ENDDO ENDDO @@ -271,7 +275,7 @@ CONTAINS ! Relative strengh of modulus of B hatB (iz,eo) = 1._dp - hatB_NL(iz,eo) = 1._dp + Gamma_NL(iz,eo) = 1._dp ! Derivative of the magnetic field strenght dBdx(iz,eo) = -hatB(iz,eo) ! LB = 1 @@ -472,7 +476,8 @@ END SUBROUTINE set_ikx_zBC_map CALL allocate_array( dBdy,izgs,izge, 0,1) CALL allocate_array( dBdz,izgs,izge, 0,1) CALL allocate_array( hatB,izgs,izge, 0,1) - CALL allocate_array( hatB_NL,izgs,izge, 0,1) + CALL allocate_array( Gamma_NL,izgs,izge, 0,1) + ! CALL allocate_array(Gamma_phipar,izgs,izge, 0,1) (not implemented) CALL allocate_array( hatR,izgs,izge, 0,1) CALL allocate_array( hatZ,izgs,izge, 0,1) CALL allocate_array( Rc,izgs,izge, 0,1)