Commit 63e29e00 authored by Serhiy Mochalskyy's avatar Serhiy Mochalskyy
Browse files

add output subroutines

parent 4c9a20ff
Pipeline #3634 skipped
subroutine output
!-----------------------------------------------------------------------
use mpi_v
implicit none
include "mpif.h"
if(rank==0) write(*,*) 'output begings'
!======================================
!call print_starwall_d_yy
!======================================
!======================================
!call print_starwall_m_ye
!======================================
!======================================
!call print_starwall_m_ey
!======================================
!======================================
!call print_starwall_m_ee
!======================================
!======================================
!call print_starwall_d_ee
!======================================
!======================================
call print_starwall_response
!======================================
!======================================
!call print_starwall_files_vtk
!======================================
if(rank==0) write(*,*) 'output ends'
if(rank==0) write(*,*) '==============================================================='
end subroutine output
subroutine print_starwall_d_ee
use mpi_v
use resistive
use solv
use sca
!-----------------------------------------------------------------------
implicit none
include "mpif.h"
integer :: i_loc,j_loc
real :: num
!-----------------------------------------------------------------------
CALL DESCINIT(DESCA, nd_bez, nd_bez, NB, NB, 0, 0, CONTEXT, LDA_dee, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in print_starwall_d_ee CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
if(rank==0) then
open(60,file='starwall_d_ee',form="formatted",iostat=ier)
write(60,'(2i8)') nd_bez,nd_bez
endif
DO i_loc = 1,nd_bez
DO j_loc = 1,nd_bez
CALL pdelget('A','D',num, d_ee_loc,i_loc,j_loc,DESCA)
if(rank==0) write(60,'(2i6,1pe12.4)') i_loc,j_loc,num
END DO
END DO
if(rank==0) close(60)
end subroutine print_starwall_d_ee
subroutine print_starwall_d_yy
use mpi_v
use resistive
!-----------------------------------------------------------------------
implicit none
include "mpif.h"
integer :: i
!-----------------------------------------------------------------------
if(rank==0) then
open(60,file='starwall_d_yy',form="formatted",iostat=ier)
write(60,'(i8)') n_w
do i=1,n_w
write(60,'(i8,1pe16.8)') i,1./gamma(i)
enddo
close(60)
endif
end subroutine print_starwall_d_yy
subroutine print_starwall_files_vtk
use tri_w
use tri_p
use mpi_v
use resistive
use icontr
use contr_su
use coil2d
!-----------------------------------------------------------------------
implicit none
include "mpif.h"
integer :: i,j
!-----------------------------------------------------------------------
if(rank==0) then
140 format(a)
141 format(a,i8,a)
142 format(3es24.16)
143 format(a,2i8)
144 format(4i8)
!===========================================================
! --- VTK: Control surface
open(60, file='control.vtk')
write(60,140) '# vtk DataFile Version 2.0'
write(60,140) 'testdata'
write(60,140) 'ASCII'
write(60,140) 'DATASET POLYDATA'
write(60,141) 'POINTS', 3*ntri_p, ' float'
do i = 1, ntri_p
do j = 1, 3
write(60,142) xp(i,j), yp(i,j), zp(i,j)
end do
end do
write(60,143) 'POLYGONS', ntri_p, ntri_p*4
do i = 1, ntri_p
write(60,144) 3, 3*(i-1), 3*(i-1)+1, 3*(i-1)+2
end do
write(60,141) 'POINT_DATA', 3*ntri_p
write(60,140) 'SCALARS potentials float'
write(60,140) 'LOOKUP_TABLE default'
do i = 1, 3*ntri_p
write(60,144) mod(i/3,5) !###
end do
close(60)
!===========================================================
!===========================================================
! --- VTK: Wall
open(60, file='wall.vtk')
write(60,140) '# vtk DataFile Version 2.0'
write(60,140) 'testdata'
write(60,140) 'ASCII'
write(60,140) 'DATASET POLYDATA'
write(60,141) 'POINTS', npot_w, ' float'
do i = 1, npot_w
write(60,142) xyzpot_w(i,:)
end do
write(60,143) 'POLYGONS', ntri_w, ntri_w*4
do i = 1, ntri_w
write(60,144) 3, jpot_w(i,:)-1
end do
write(60,141) 'POINT_DATA', npot_w
write(60,140) 'SCALARS potentials float'
write(60,140) 'LOOKUP_TABLE default'
do i = 1, npot_w
write(60,144) mod(i,3) !###
end do
close(60)
!===========================================================
!===========================================================
! --- VTK: Coils
open(60, file='coils.vtk')
write(60,140) '# vtk DataFile Version 2.0'
write(60,140) 'testdata'
write(60,140) 'ASCII'
write(60,140) 'DATASET POLYDATA'
write(60,141) 'POINTS', 3*ntri_c, ' float'
do i = 1, ntri_c
write(60,142) x_coil(i,1), z_coil(i,1), y_coil(i,1)
write(60,142) x_coil(i,2), z_coil(i,2), y_coil(i,2)
write(60,142) x_coil(i,3), z_coil(i,3), y_coil(i,3)
end do
write(60,143) 'POLYGONS', ntri_c, ntri_c*4
do i = 1, ntri_c
write(60,144) 3, 3 * i - (/ 3, 2, 1 /)
end do
write(60,141) 'POINT_DATA', 3*ntri_c
write(60,140) 'SCALARS potentials float'
write(60,140) 'LOOKUP_TABLE default'
do i = 1, ntri_c
write(60,142) 0.d0
end do
close(60)
!===========================================================
endif
if(rank==0) deallocate(xyzpot_w)
end subroutine print_starwall_files_vtk
subroutine print_starwall_m_ee
use mpi_v
use resistive
use solv
use sca
!-----------------------------------------------------------------------
implicit none
include "mpif.h"
integer :: i_loc,j_loc
real :: num
!-----------------------------------------------------------------------
CALL DESCINIT(DESCA, nd_bez,nd_bez, NB, NB, 0, 0, CONTEXT, LDA_ee, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
if(rank==0) then
open(60,file='starwall_m_ee',form="formatted",iostat=ier)
write(60,'(2i8)') nd_bez,nd_bez
endif
DO i_loc = 1,nd_bez
DO j_loc = 1,nd_bez
CALL pdelget('A','D',num, a_ee_loc,i_loc,j_loc,DESCA)
if(rank==0) write(60,'(2i8,1pe16.8)') i_loc,j_loc,num
END DO
END DO
if(rank==0) close(60)
end subroutine print_starwall_m_ee
subroutine print_starwall_m_ey
use mpi_v
use resistive
use solv
use sca
!-----------------------------------------------------------------------
implicit none
include "mpif.h"
integer :: i_loc,j_loc
real :: num
!-----------------------------------------------------------------------
CALL DESCINIT(DESCA, nd_bez, n_w, NB, NB, 0, 0, CONTEXT, LDA_ey, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in print_starwall_m_ye CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
if(rank==0) then
open(60,file='starwall_m_ey',form="formatted",iostat=ier)
write(60,'(2i8)') nd_bez,n_w
endif
DO i_loc = 1,nd_bez
DO j_loc = 1,n_w
CALL pdelget('A','D',num, a_ey_loc,i_loc,j_loc,DESCA)
if(rank==0) write(60,'(2i8,1pe16.8)') i_loc,j_loc,num
END DO
END DO
if(rank==0) close(60)
end subroutine print_starwall_m_ey
subroutine print_starwall_m_ye
use mpi_v
use resistive
use solv
use sca
!-----------------------------------------------------------------------
implicit none
include "mpif.h"
integer :: i_loc,j_loc
real :: num
!-----------------------------------------------------------------------
CALL DESCINIT(DESCA, n_w,nd_bez, NB, NB, 0, 0, CONTEXT, LDA_ye, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
if(rank==0) then
open(60,file='starwall_m_ye',form="formatted",iostat=ier)
write(60,'(2i8)') n_w,nd_bez
endif
DO i_loc = 1,n_w
DO j_loc = 1,nd_bez
CALL pdelget('A','D',num, a_ye_loc,i_loc,j_loc,DESCA)
if(rank==0) write(60,'(2i8,1pe16.8)') i_loc,j_loc,num
END DO
END DO
if(rank==0) close(60)
end subroutine print_starwall_m_ye
subroutine print_starwall_response
use icontr
use contr_su
use solv
use tri_w
use tri_p
use coil2d
use sca
use mpi_v
use time
use resistive
!-----------------------------------------------------------------------
implicit none
include "mpif.h"
integer :: i,j,k,i_loc,j_loc
real :: num=0.
real,dimension(:,:),allocatable :: a_ye_print(:,:),a_ey_print(:,:),a_ee_print(:,:)
real,dimension(:,:),allocatable :: s_ww_print(:,:),s_ww_inv_print(:,:)
!-----------------------------------------------------------------------
! (Determine positions of wall triangle nodes)
if(rank==0) then
allocate( xyzpot_w(npot_w,3) )
do i = 1, ntri_w
do j = 1, 3
xyzpot_w(jpot_w(i,j),:) = (/ xw(i,j), yw(i,j), zw(i,j) /)
end do
end do
endif
if (format_type == 'formatted' ) then
if(rank==0) then
open(60, file='starwall-response.dat', form=format_type, status='replace', action='write')
130 format(a)
131 format('#@intparam ',a24,99i12)
132 format('#@array ',a24,i12,a24,99i12)
133 format(4es24.16)
134 format(8i12)
write(60,130) '#@content STARWALL VACUUM RESPONSE DATA FOR THE JOREK CODE'
write(60,131) 'file_version', 1
write(60,131) 'n_bnd', N_bnd
write(60,131) 'nd_bez', nd_bez
write(60,131) 'ncoil', ncoil
write(60,131) 'npot_w', npot_w
write(60,131) 'n_w', n_w
write(60,131) 'ntri_w', ntri_w
write(60,131) 'n_tor', n_tor_jorek
write(60,132) 'i_tor', 1, 'int', n_tor_jorek, 0
write(60,134) i_tor_jorek(1:n_tor_jorek)
write(60,132) 'yy', 1, 'float', n_w, 0
write(60,133) 1./gamma(:)
write(60,132) 'ye', 2, 'float', n_w, nd_bez
allocate(a_ye_print(n_w,nd_bez),stat=ier)
IF (IER /= 0) THEN
WRITE (*,*) "output.f90, can not allocate a_ye_print MYPROC_NUM=",MYPNUM
STOP
END IF
endif
!=========================================================================================
CALL DESCINIT(DESCA, n_w,nd_bez, NB, NB, 0, 0, CONTEXT, LDA_ye, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
DO i_loc = 1,n_w
DO j_loc = 1,nd_bez
CALL pdelget('A','D',num, a_ye_loc,i_loc,j_loc,DESCA)
if(rank==0) a_ye_print(i_loc,j_loc)=num
END DO
END DO
if(rank==0) then
write(60,133) a_ye_print(:,:)
deallocate (a_ye_print)
allocate(a_ey_print(nd_bez,n_w),stat=ier)
IF (IER /= 0) THEN
WRITE (*,*) "output.f90, can not allocate a_ey_print MYPROC_NUM=",MYPNUM
STOP
END IF
endif
!=========================================================================================
CALL DESCINIT(DESCA, nd_bez,n_w, NB, NB, 0, 0, CONTEXT, LDA_ey, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
DO i_loc = 1,nd_bez
DO j_loc = 1,n_w
CALL pdelget('A','D',num, a_ey_loc,i_loc,j_loc,DESCA)
if(rank==0) a_ey_print(i_loc,j_loc)=num
END DO
END DO
if(rank==0) then
write(60,132) 'ey', 2, 'float', nd_bez, n_w
write(60,133) a_ey_print(:,:)
deallocate (a_ey_print)
allocate(a_ee_print(nd_bez,nd_bez),stat=ier)
IF (IER /= 0) THEN
WRITE (*,*) "output.f90, can not allocate a_ee_print MYPROC_NUM=",MYPNUM
STOP
END IF
endif
!=========================================================================================
CALL DESCINIT(DESCA, nd_bez,nd_bez, NB, NB, 0, 0, CONTEXT, LDA_ee, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
DO i_loc = 1,nd_bez
DO j_loc = 1,nd_bez
CALL pdelget('A','D',num, a_ee_loc,i_loc,j_loc,DESCA)
if(rank==0) a_ee_print(i_loc,j_loc)=num
END DO
END DO
if(rank==0) then
write(60,132) 'ee', 2, 'float', nd_bez, nd_bez
write(60,133) a_ee_print(:,:)
deallocate (a_ee_print)
allocate(s_ww_print(n_w,n_w),stat=ier)
IF (IER /= 0) THEN
WRITE (*,*) "output.f90, can not allocate s_ww_print MYPROC_NUM=",MYPNUM
STOP
END IF
endif
!=========================================================================================
CALL DESCINIT(DESCA, n_w,n_w, NB, NB, 0, 0, CONTEXT, LDA_sww, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
DO i_loc = 1,n_w
DO j_loc = 1,n_w
CALL pdelget('A','D',num, s_ww_loc,i_loc,j_loc,DESCA)
if(rank==0) s_ww_print(i_loc,j_loc)=num
END DO
END DO
if(rank==0) then
write(60,132) 's_ww', 2, 'float', n_w, n_w
write(60,133) s_ww_print(:,:)
deallocate (s_ww_print)
allocate(s_ww_inv_print(n_w,n_w),stat=ier)
IF (IER /= 0) THEN
WRITE (*,*) "output.f90, can not allocate s_ww_inv_print MYPROC_NUM=",MYPNUM
STOP
END IF
endif
!=========================================================================================
CALL DESCINIT(DESCA, n_w,n_w, NB, NB, 0, 0, CONTEXT, LDA_s_ww_inv, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
DO i_loc = 1,n_w
DO j_loc = 1,n_w
CALL pdelget('A','D',num, s_ww_inv_loc,i_loc,j_loc,DESCA)
if(rank==0) s_ww_inv_print(i_loc,j_loc)=num
END DO
END DO
if(rank==0) then
write(60,132) 's_ww_inv', 2, 'float', n_w, n_w
write(60,133) s_ww_inv_print(:,:)
deallocate (s_ww_inv_print)
endif
!=========================================================================================
if(rank==0) then
write(60,132) 'xyzpot_w', 2, 'float', npot_w, 3
write(60,133) xyzpot_w(:,:)
write(60,132) 'jpot_w', 2, 'int', ntri_w, 3
write(60,134) jpot_w(:,:)
endif
else !if (format_type == 'formatted' ) then
if(rank==0) then
open(60, file='starwall-response.dat', form=format_type, status='replace', action='write')
char512='#@content STARWALL VACUUM RESPONSE DATA FOR THE JOREK CODE'
write(60) 42, 42.d0 !### for an elementary check in JOREK
write(60) char512
write(60) '#@intparam ', 'file_version ', 1
write(60) '#@intparam ', 'n_bnd ', N_bnd
write(60) '#@intparam ', 'nd_bez ', nd_bez
write(60) '#@intparam ', 'ncoil ', ncoil
write(60) '#@intparam ', 'npot_w ', npot_w
write(60) '#@intparam ', 'n_w ', n_w
write(60) '#@intparam ', 'ntri_w ', ntri_w
write(60) '#@intparam ', 'n_tor ', n_tor_jorek
write(60) '#@array ', 'i_tor ', 1, 'int ', n_tor_jorek, 0
write(60) i_tor_jorek(1:n_tor_jorek)
write(60) '#@array ', 'yy ', 1, 'float ', n_w, 0
write(60) 1.d0/gamma(:)
write(60) '#@array ', 'ye ', 2, 'float ', n_w, nd_bez
allocate(a_ye_print(n_w,nd_bez),stat=ier)
IF (IER /= 0) THEN
WRITE (*,*) "output.f90, can not allocate a_ye_print MYPROC_NUM=",MYPNUM
STOP
END IF
endif
!=========================================================================================
CALL DESCINIT(DESCA, n_w,nd_bez, NB, NB, 0, 0, CONTEXT, LDA_ye, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
DO i_loc = 1,n_w
DO j_loc = 1,nd_bez
CALL pdelget('A','D',num, a_ye_loc,i_loc,j_loc,DESCA)
if(rank==0) a_ye_print(i_loc,j_loc)=num
END DO
END DO
if(rank==0) then
write(60) a_ye_print(:,:)
deallocate (a_ye_print)
allocate(a_ey_print(nd_bez,n_w),stat=ier)
IF (IER /= 0) THEN
WRITE (*,*) "output.f90, can not allocate a_ey_print MYPROC_NUM=",MYPNUM
STOP
END IF
endif
!=========================================================================================
CALL DESCINIT(DESCA, nd_bez,n_w, NB, NB, 0, 0, CONTEXT, LDA_ey, INFO_A )
if(INFO_A .NE. 0) then
write(6,*) "Something is wrong in output CALL DESCINIT DESCA, INFO_A=",INFO_A
stop
endif
DO i_loc = 1,nd_bez
DO j_loc = 1,n_w
CALL pdelget('A','D',num, a_ey_loc,i_loc,j_loc,DESCA)
if(rank==0) a_ey_print(i_loc,j_loc)=num
END