add output subroutines

src_3d/output.f90

+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

src_3d/print_starwall_d_ee.f90

+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

src_3d/print_starwall_d_yy.f90

+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

src_3d/print_starwall_files_vtk.f90

+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

src_3d/print_starwall_m_ee.f90

+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

src_3d/print_starwall_m_ey.f90

+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

src_3d/print_starwall_m_ye.f90

+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

src_3d/print_starwall_response.f90

+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