started reorganization of interp_eqprof (equilibrium) and coreprofiles modules

Makefile

@@ -3,8 +3,8 @@ EXE=gray
 
 # Objects list
 MAINOBJ=gray.o
-OTHOBJ=conical.o const_and_precisions.o dierckx.o dispersion.o eccd.o eierf.o \
+OTHOBJ=conical.o const_and_precisions.o coreprofiles.o dierckx.o dispersion.o \
-    graydata_anequil.o graydata_flags.o graydata_par.o \
+     eccd.o eierf.o graydata_anequil.o graydata_flags.o graydata_par.o \
     interp_eqprof.o magsurf_data.o math.o minpack.o numint.o quadpack.o \
     reflections.o simplespline.o utils.o beamdata.o 
     
@@ -25,11 +25,13 @@ $(EXE): $(MAINOBJ) $(OTHOBJ)
 	$(FC) $(FFLAGS) -o $@ $^
 
 # Dependencies on modules
-gray.o: const_and_precisions.o dierckx.o dispersion.o eccd.o \
+gray.o: const_and_precisions.o coreprofiles.o dierckx.o dispersion.o eccd.o \
         graydata_anequil.o graydata_flags.o graydata_par.o \
         interp_eqprof.o magsurf_data.o math.o minpack.o numint.o quadpack.o \
         reflections.o simplespline.o utils.o beamdata.o 
 conical.o: const_and_precisions.o
+coreprofiles.o: const_and_precisions.o dierckx.o graydata_anequil.o \
+                graydata_flags.o simplespline.o utils.o
 dierckx.o: const_and_precisions.o
 dispersion.o: const_and_precisions.o eierf.o math.o quadpack.o
 eccd.o: const_and_precisions.o conical.o magsurf_data.o dierckx.o numint.o

src/eccd.f90

@@ -99,11 +99,6 @@ module eccd
 
 contains
 
-  subroutine initeccd(ieccd)
-    implicit none
-    integer, intent(in) :: ieccd
-  end subroutine initeccd
-  
   subroutine setcdcoeff_notrap(zeff,cst2,eccdpar)
     implicit none
     real(wp_), intent(in) :: zeff
@@ -151,7 +146,6 @@ contains
     real(wp_), intent(in) :: zeff,rbx,fc,amu,rhop
     real(wp_), intent(out) :: cst2
     real(wp_), dimension(:), allocatable, intent(out) :: eccdpar
-    real(wp_) :: alams,pa,fp0s
     real(wp_), dimension(nlmt) :: chlm
     integer :: nlm,ierr,npar
 
@@ -424,7 +418,6 @@ contains
     real(wp_) :: upl,fjch
     real(wp_), dimension(npar) :: extrapar
 ! local variables
-    integer :: nhn
     real(wp_) :: anpl,anprre,ygn,zeff,rb,alams,pa,fp0s,          &
       upr2,gam,u2,u,z5,xi,xib,xibi,fu2b,fu2,gu,gg,dgg,alam,fp0,  &
       dfp0,fh,dfhl,eta

src/graydata_par.f90

@@ -4,7 +4,7 @@ module graydata_par
   
   real(wp_), save :: rwmax,rwallm
   real(wp_), save :: psipol0,chipol0
-  real(wp_), save :: factb,factt,factn,psdbnd
+  real(wp_), save :: factb,factt,factn
   real(wp_), save :: sgnbphi,sgniphi
 
 end module graydata_par

src/interp_eqprof.f90

@@ -3,29 +3,53 @@ module interp_eqprof
   implicit none
   
 ! equidata
-  INTEGER, SAVE :: nlim,nr,nz,nbbbs,nsrt,nszt,nsft
+  ! === 2D array psi(R,z) ==========================================
-  REAL(wp_), SAVE :: psia,psiant,psinop,btrcen,rcen
+  INTEGER, SAVE :: nr,nz
-  REAL(wp_), SAVE :: btaxis,rmaxis,zmaxis,rmnm,rmxm,zmnm,zmxm,dr,dz
+  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rv,zv
-  REAL(wp_), SAVE :: zbmin,zbmax,fpolas,phitedge,rrtor,rup,zup,rlw,zlw   !rrtor non usato, solo in equidata
+  REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: psin
-  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: tr,tz,tfp
+  ! === 1D array Fpol(psi), q(psi), rhotor(psi) ====================
-  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: cceq,cfp
+  !INTEGER, SAVE :: npsieq
-  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: cceq01,cceq10,cceq20,cceq02,cceq11
+  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: psinr,rhopnr,fpol,qpsi
-  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: psinr,rhopnr,qpsi,rv,zv
-  REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: psin,psi,btotal,crhot,cq
-  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rlim,zlim,rbbbs,zbbbs
   
-! profdata
+  ! === 1D array plasma boundary Rbnd_i, Zbnd_i ====================
-  INTEGER, SAVE :: npp,nsfd
+  INTEGER, SAVE :: nbbbs
-  REAL(wp_), SAVE :: psnpp,denpp,ddenpp,d2denpp
+  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rbbbs,zbbbs
-  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: psrad,derad,terad,zfc,tfn,cfn
+  ! === 1D array limiter Rlim_i, Zlim_i   ==> move in wall/reflections
-  REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: ct,cz
+  INTEGER, SAVE :: nlim
+  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rlim,zlim
+
+  REAL(wp_), SAVE :: btaxis,rmaxis,zmaxis
+  REAL(wp_), SAVE :: rmnm,rmxm,zmnm,zmxm,dr,dz
+  REAL(wp_), SAVE :: zbmin,zbmax
+  REAL(wp_), SAVE :: phitedge
+  REAL(wp_), SAVE :: rup,zup,rlw,zlw
+  REAL(wp_), SAVE :: rcen,btrcen ! rcen unused, btrcen used only for Jcd_ASTRA def.
+
+  ! === 2D spline psi(R,z), normalization and derivatives ==========
+  INTEGER, SAVE :: nrest, nzest, lw10, lw01, lw20, lw02, lw11
+  INTEGER :: nsr,nsz
+  REAL(wp_), SAVE :: psia, psiant, psinop
+  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: tr,tz
+  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: cceq,   cceq01, cceq10, &
+                                                cceq20, cceq02, cceq11
+  ! === 1D spline Fpol(psi) ========================================
+  ! INTEGER, SAVE :: npsiest
+  INTEGER, SAVE :: nsf
+  REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: tfp,cfp
+  REAL(wp_), SAVE :: fpolas
+  ! === 1D spline rhot(rhop), rhop(rhot), q(psi) ===================
+  ! computed on psinr,rhopnr [,rhotnr] arrays
+  REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: crhot,cq
+
+  ! !!! 2D B(R,z) array. Computed in bfield_res,
+  ! !!! used by cniteq to plot resonant field contour lines.
+  REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: btotal
 
 contains
 
   subroutine alloc_equilvec(ier)
     implicit none
     integer, intent(out) :: ier
-    integer :: nrest,nzest,lw10,lw01,lw20,lw02,lw11
 
     if(nr.le.0.or.nz.le.0) then
       ier = -1
@@ -43,7 +67,7 @@ contains
     call dealloc_equilvec
     allocate(rv(nr),zv(nz),tr(nrest),tz(nzest),tfp(nrest),cfp(nrest), &
      btotal(nr,nz),cceq(nr*nz),cceq01(lw01),cceq10(lw10),cceq02(lw02), &
-     cceq20(lw20),cceq11(lw11),psi(nr,nz),psin(nr,nz),psinr(nr),rhopnr(nr), &
+     cceq20(lw20),cceq11(lw11),psin(nr,nz),psinr(nr),rhopnr(nr),fpol(nr), &
      qpsi(nr), stat=ier)
     if (ier/=0) call dealloc_equilvec
   end subroutine alloc_equilvec
@@ -63,9 +87,9 @@ contains
     if(allocated(cceq02)) deallocate(cceq02)
     if(allocated(cceq20)) deallocate(cceq20)
     if(allocated(cceq11)) deallocate(cceq11)
-    if(allocated(psi)) deallocate(psi)
     if(allocated(psin)) deallocate(psin)
     if(allocated(psinr)) deallocate(psinr)
+    if(allocated(fpol)) deallocate(fpol)
     if(allocated(rhopnr)) deallocate(rhopnr)
     if(allocated(qpsi)) deallocate(qpsi)
 
@@ -117,38 +141,107 @@ contains
     if(allocated(zlim))   deallocate(zlim)
   end subroutine dealloc_lim
 
-
+  subroutine equinum_psi(rpsim,zpsim,psinv,dpsidr,dpsidz, &
-  subroutine alloc_profvec(ier)
+        ddpsidrr,ddpsidzz,ddpsidrz)
+    use dierckx, only : fpbisp
     implicit none
-    integer, intent(out) :: ier
+! local constants
-    integer :: npest
+    integer, parameter :: lwrk=8,liwrk=2
+! arguments
+    real(wp_), intent(in) :: rpsim,zpsim
+    real(wp_), intent(out), optional :: psinv,dpsidr,dpsidz, &
+        ddpsidrr,ddpsidzz,ddpsidrz
 
-    ier=0
+! local variables
-    if(npp.le.0) then
+    integer, dimension(liwrk) :: iwrk
-      ier = -1
+    real(wp_), dimension(1) :: rrs,zzs,ffspl
-      return
+    real(wp_), dimension(lwrk) :: wrk
+
+!
+!     here lengths are measured in meters
+!
+    if (rpsim.le.rmxm .and. rpsim.ge.rmnm .and. &
+        zpsim.le.zmxm .and. zpsim.ge.zmnm) then
+
+      if (present(psinv)) then
+        rrs(1)=rpsim
+        zzs(1)=zpsim
+        call fpbisp(tr,nsr,tz,nsz,cceq,3,3,rrs,1,zzs,1,ffspl, &
+                   wrk(1),wrk(5),iwrk(1),iwrk(2))
+        psinv=(ffspl(1)-psinop)/psiant
+      end if
+      if (present(dpsidr)) then
+        call sub_derpsi(rpsim,zpsim,1,0,dpsidr,cceq10,lw10)
+      end if
+      if (present(dpsidz)) then
+        call sub_derpsi(rpsim,zpsim,0,1,dpsidz,cceq01,lw01)
+      end if
+      if (present(ddpsidrr)) then
+        call sub_derpsi(rpsim,zpsim,2,0,ddpsidrr,cceq20,lw20)
+      end if
+      if (present(ddpsidzz)) then
+        call sub_derpsi(rpsim,zpsim,0,2,ddpsidzz,cceq02,lw02)
+      end if
+      if (present(ddpsidrz)) then
+        call sub_derpsi(rpsim,zpsim,1,1,ddpsidrz,cceq11,lw11)
+      end if
+    else
+      if(present(psinv)) psinv=-1.0_wp_
+      if(present(dpsidr)) dpsidr=0.0_wp_
+      if(present(dpsidz)) dpsidz=0.0_wp_
+      if(present(ddpsidrr)) ddpsidrr=0.0_wp_
+      if(present(ddpsidzz)) ddpsidzz=0.0_wp_
+      if(present(ddpsidrz)) ddpsidrz=0.0_wp_
     end if
+  end subroutine equinum_psi
 
-    npest=npp+4
+  subroutine sub_derpsi(rpsim,zpsim,nur,nuz,derpsi,cc,lw)
-
+    use dierckx, only : fpbisp
-    call dealloc_profvec
-    allocate(psrad(npp),terad(npp),derad(npp),zfc(npp),ct(npp,4), &
-     cz(npp,4),tfn(npest),cfn(npest), &
-     stat=ier)
-    if (ier/=0) call dealloc_profvec
-  end subroutine alloc_profvec
-
-  subroutine dealloc_profvec
     implicit none
-    if(allocated(psrad)) deallocate(psrad)
+! local constants
-    if(allocated(terad)) deallocate(terad)
+    integer, parameter :: liwrk=2,nrs=1,nzs=1
-    if(allocated(derad)) deallocate(derad)
+! arguments
-    if(allocated(zfc)) deallocate(zfc)
+    integer :: nur,nuz,lw
-    if(allocated(ct)) deallocate(ct)
+    real(wp_) :: rpsim,zpsim,derpsi
-    if(allocated(cz)) deallocate(cz)
+    real(wp_), dimension(lw) :: cc
-    if(allocated(tfn)) deallocate(tfn)
+! local variables
-    if(allocated(cfn)) deallocate(cfn)
+    integer :: iwr,iwz
+    integer, dimension(liwrk) :: iwrk
+    real(wp_), dimension(1) :: rrs,zzs,ffspl
 
-  end subroutine dealloc_profvec
+    rrs(1)=rpsim
+    zzs(1)=zpsim
+    iwr=1+(nr-nur-4)*(nz-nuz-4)
+    iwz=iwr+4-nur
+    call fpbisp(tr(nur+1),nsr-2*nur,tz(nuz+1),nsz-2*nuz,cc,3-nur,3-nuz, &
+         rrs,nrs,zzs,nzs,ffspl,cc(iwr),cc(iwz),iwrk(1),iwrk(2))
+    derpsi=ffspl(1)*psia
+  end subroutine sub_derpsi
+
+  subroutine equinum_fpol(psinv,fpolv,dfpv)
+    use dierckx, only : splev,splder
+    implicit none
+! arguments
+    real(wp_), intent(in) :: psinv
+    real(wp_), intent(out) :: fpolv
+    real(wp_), intent(out), optional :: dfpv
+! local variables
+    integer :: ier
+    real(wp_), dimension(1) :: rrs,ffspl
+    real(wp_), dimension(nsf) :: wrkfd
+!      
+    if(psinv.le.1.0_wp_.and.psinv.gt.0.0_wp_) then
+      rrs(1)=psinv
+      call splev(tfp,nsf,cfp,3,rrs,ffspl,1,ier)
+      fpolv=ffspl(1)
+      if(present(dfpv)) then       
+        call splder(tfp,nsf,cfp,3,1,rrs,ffspl,1,wrkfd,ier)
+        dfpv=ffspl(1)/psia
+      end if
+    else
+      fpolv=fpolas
+      if (present(dfpv)) dfpv=0._wp_
+    end if
+  end subroutine equinum_fpol
   
 end module interp_eqprof