107 lines
3.7 KiB
Fortran
107 lines
3.7 KiB
Fortran
module magsurf_data
|
|
use const_and_precisions, only : wp_
|
|
implicit none
|
|
|
|
INTEGER, SAVE :: npsi, npoints !# sup mag, # punti per sup
|
|
INTEGER, SAVE :: njpt, nlmt
|
|
|
|
REAL(wp_), SAVE :: rarea
|
|
|
|
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: psicon,pstab,rhot_eq, &
|
|
rhotqv,bav,varea,vcurrp,vajphiav,qqv,ffc,vratja,vratjb
|
|
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: rpstab
|
|
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: vvol,rri,rbav,bmxpsi,bmnpsi
|
|
REAL(wp_), DIMENSION(:), ALLOCATABLE, SAVE :: tjp,tlm,ch,ch01
|
|
|
|
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: rcon,zcon
|
|
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: cdadrhot,cdvdrhot
|
|
|
|
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: cvol,crri,crbav,cbmx,cbmn,carea,cfc
|
|
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: crhotq
|
|
REAL(wp_), DIMENSION(:,:), ALLOCATABLE, SAVE :: cratja,cratjb,cratjpl
|
|
|
|
|
|
contains
|
|
|
|
subroutine alloc_surf_anal(ierr)
|
|
implicit none
|
|
integer, intent(out) :: ierr
|
|
|
|
if(npsi.le.0.or.npoints.le.0) then
|
|
ierr = -1
|
|
return
|
|
end if
|
|
|
|
call dealloc_surf_anal
|
|
allocate(psicon(npsi),rcon(npsi,npoints), &
|
|
zcon(npsi,npoints),stat=ierr)
|
|
if (ierr/=0) call dealloc_surf_anal
|
|
end subroutine alloc_surf_anal
|
|
|
|
subroutine dealloc_surf_anal
|
|
implicit none
|
|
if(allocated(psicon)) deallocate(psicon)
|
|
if(allocated(rcon)) deallocate(rcon)
|
|
if(allocated(zcon)) deallocate(zcon)
|
|
end subroutine dealloc_surf_anal
|
|
|
|
|
|
subroutine alloc_surfvec(ierr)
|
|
implicit none
|
|
integer, intent(out) :: ierr
|
|
|
|
if(npsi.le.0.or.npoints.le.0) then
|
|
ierr = -1
|
|
return
|
|
end if
|
|
|
|
call dealloc_surfvec
|
|
allocate(psicon(npsi),rcon(npsi,npoints),zcon(npsi,npoints),pstab(npsi), &
|
|
rhot_eq(npsi),rhotqv(npsi),bav(npsi),bmxpsi(npsi),bmnpsi(npsi),varea(npsi), &
|
|
vvol(npsi),vcurrp(npsi),vajphiav(npsi),qqv(npsi),ffc(npsi),vratja(npsi), &
|
|
vratjb(npsi),rpstab(npsi),rri(npsi),rbav(npsi),cdadrhot(npsi,4), &
|
|
cdvdrhot(npsi,4),cbmx(npsi,4),cbmn(npsi,4),crbav(npsi,4),cvol(npsi,4), &
|
|
crri(npsi,4),carea(npsi,4),cfc(npsi,4),crhotq(npsi,4),cratjpl(npsi,4), &
|
|
cratja(npsi,4),cratjb(npsi,4),stat=ierr)
|
|
if (ierr/=0) call dealloc_surf_anal
|
|
end subroutine alloc_surfvec
|
|
|
|
subroutine dealloc_surfvec
|
|
implicit none
|
|
if(allocated(psicon)) deallocate(psicon)
|
|
if(allocated(rcon)) deallocate(rcon)
|
|
if(allocated(zcon)) deallocate(zcon)
|
|
if(allocated(pstab)) deallocate(pstab)
|
|
if(allocated(rhot_eq)) deallocate(rhot_eq)
|
|
if(allocated(rhotqv)) deallocate(rhotqv)
|
|
if(allocated(bav)) deallocate(bav)
|
|
if(allocated(bmxpsi)) deallocate(bmxpsi)
|
|
if(allocated(bmnpsi)) deallocate(bmnpsi)
|
|
if(allocated(varea)) deallocate(varea)
|
|
if(allocated(vvol)) deallocate(vvol)
|
|
if(allocated(vcurrp)) deallocate(vcurrp)
|
|
if(allocated(vajphiav)) deallocate(vajphiav)
|
|
if(allocated(qqv)) deallocate(qqv)
|
|
if(allocated(ffc)) deallocate(ffc)
|
|
if(allocated(vratja)) deallocate(vratja)
|
|
if(allocated(vratjb)) deallocate(vratjb)
|
|
if(allocated(rpstab)) deallocate(rpstab)
|
|
if(allocated(rri)) deallocate(rri)
|
|
if(allocated(rbav)) deallocate(rbav)
|
|
if(allocated(cdadrhot)) deallocate(cdadrhot)
|
|
if(allocated(cdvdrhot)) deallocate(cdvdrhot)
|
|
if(allocated(cbmx)) deallocate(cbmx)
|
|
if(allocated(cbmn)) deallocate(cbmn)
|
|
if(allocated(crbav)) deallocate(crbav)
|
|
if(allocated(cvol)) deallocate(cvol)
|
|
if(allocated(crri)) deallocate(crri)
|
|
if(allocated(carea)) deallocate(carea)
|
|
if(allocated(cfc)) deallocate(cfc)
|
|
if(allocated(crhotq)) deallocate(crhotq)
|
|
if(allocated(cratjpl)) deallocate(cratjpl)
|
|
if(allocated(cratja)) deallocate(cratja)
|
|
if(allocated(cratjb)) deallocate(cratjb)
|
|
end subroutine dealloc_surfvec
|
|
|
|
end module magsurf_data
|