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