Commit e0139aa0 authored by Serhiy Mochalskyy's avatar Serhiy Mochalskyy
Browse files

clean print subroutine

parent e8b39720
Pipeline #4503 skipped
......@@ -28,8 +28,7 @@ if(rank==0) write(*,*) 'output begings'
!======================================
!======================================
!call print_starwall_response
call print_starwall_response2
call print_starwall_response
!======================================
!======================================
......
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 DO
END DO
if(rank==0) then
write(60) '#@array ', 'ey ', 2, 'float ', nd_bez, n_w
write(60) 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) '#@array ', 'ee ', 2, 'float ', nd_bez, nd_bez
write(60) 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) '#@array ', 's_ww ', 2, 'float ', n_w, n_w
write(60) 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) '#@array ', 's_ww_inv ', 2, 'float ', n_w, n_w
write(60) s_ww_inv_print(:,:)
deallocate (s_ww_inv_print)
endif
!=========================================================================================
if(rank==0) then
write(60) '#@array ', 'xyzpot_w ', 2, 'float ', npot_w, 3
write(60) xyzpot_w(:,:)
write(60) '#@array ', 'jpot_w ', 2, 'int ', ntri_w, 3
write(60) jpot_w(:,:)
endif
end if !if (format_type == 'formatted' ) then
close(60)
end subroutine print_starwall_response
subroutine print_starwall_response2
use icontr
use contr_su
use solv
......@@ -794,4 +424,4 @@ end if !if (format_type == 'formatted' ) then
close(60)
end subroutine print_starwall_response2
end subroutine print_starwall_response
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment