addsurf.f

Go to the documentation of this file.

C> @file convert/addsurf.f
C> Converters of EIRENE Additional Surfaces into GRIDMAN_GRID object

!    Copyright (c) 2017  Forschungszentrum Juelich GmbH
!                        Vladislav Kotov 
!
!    This file is part of GRIDMAN.
!
!    GRIDMAN is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    GRIDMAN is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with GRIDMAN.  If not, see <http://www.gnu.org/licenses/>.

C**********************************************************************************************
C> Convert planar EIRENE Additional Surfaces into grid object
C>
C> WARNING: grid object which already exists will be overwritten!
C>
C> 1st edge index GRID%EDGEINDEX(1) contains indices of Additional Surfaces
C> from the EIRENE input file 
C**********************************************************************************************
      SUBROUTINE gridman_addsurf2grid_2d(GRID,NSURF,X,Y,ISRF,IERR)
      USE gridman,ONLY:gridman_grid,gridman_dp,gridman_sp,
     u                 gridman_dbg,gridman_unit,gridman_check  
      USE gridman_lib,ONLY:gridman_grid_allocate,
     u                     gridman_grid_deallocate,
     u                     gridman_index_allocate,gridman_grid2d_check
      IMPLICIT NONE
C> Resulting grid object
      TYPE(gridman_grid) :: GRID
C> Number of edges
      INTEGER(GRIDMAN_SP),INTENT(IN) :: NSURF
C> X-coordinates of the edge vertices   
      REAL(GRIDMAN_DP),INTENT(IN) :: X(2,nsurf)
C> Y-coordinates of the edge vertices   
      REAL(GRIDMAN_DP),INTENT(IN) :: Y(2,nsurf)
C> Indices of EIRENE additional surfaces
      INTEGER(GRIDMAN_SP),INTENT(IN) :: ISRF(nsurf)
C> Error code
      INTEGER,INTENT(OUT) :: IERR  

      INTEGER(GRIDMAN_SP) :: I
      INTEGER :: RES,IERR0

      IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "Starting GRIDMAN_ADDSURF2GRID_2D"

      ierr=0

      IF(nsurf.LT.1) THEN
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2GRID_2D: ",
     w                       "incorrect number of edges"
       WRITE(gridman_unit,*) " NSURF ",nsurf
       ierr=100
       RETURN
      END IF
 
      CALL gridman_grid_allocate(grid,2,nsurf,2*nsurf,
     c                           0_gridman_sp,ierr,1,0)
      IF(ierr.NE.0) GOTO 100
      CALL gridman_index_allocate(grid%EDGEINDEX(1),1,nsurf,ierr)
      IF(ierr.NE.0) GOTO 200

      grid%CELLS=0
      DO i=1,nsurf
       grid%POINTS(1,i)=2*i-1 !2*(I-1)+1
       grid%POINTS(2,i)=2*i   !2*(I-1)+2
       grid%X(1,2*i-1)=x(1,i)
       grid%X(2,2*i-1)=y(1,i)
       grid%X(1,2*i)=x(2,i)
       grid%X(2,2*i)=y(2,i)
       grid%EDGEINDEX(1)%INDEXES(0,i)=i
       grid%EDGEINDEX(1)%INDEXES(1,i)=isrf(i)
      END DO

C     UNITS
      grid%UNIT2SI=1e-2_gridman_dp
      grid%UNITS='CENTIMETER'
C     DEFAULT DESCRIPTION
      grid%DESCRIPTION='EIRENE planar Additional Surfaces'
      grid%EDGEINDEX(1)%DESCRIPTION="Index of EIRENE Additional Surface"
      grid%EDGEINDEX(1)%COLUMNS(1)='EIRENE_ADDSURF'

      IF(gridman_check) THEN
       CALL gridman_grid2d_check(grid,res,ierr)
       IF(res.NE.0.OR.ierr.GT.0) THEN  
        ierr=100
        WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2GRID_2D: ", 
     w                        "the resulting grid is incorrect" 
        CALL gridman_grid_deallocate(grid,ierr0)
       END IF
      END IF  

      IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "GRIDMAN_ADDSURF2GRID_2D finished"

      RETURN
 100  WRITE(gridman_unit,*) "GRIDMAN_ADDSURF2GRID_2D terminated"
      RETURN
 200  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2GRID_2D: ",
     w                      "cannot allocate edge index"
      CALL gridman_grid_deallocate(grid,ierr0)
      RETURN

      END SUBROUTINE gridman_addsurf2grid_2d

C**********************************************************************************************
C> Read planar EIRENE Additional Surfaces and convert them into (2D) grid object
C>
C> WARNING: grid object which already exists will be overwritten!
C>
C> GRIDMAN_ADDSURF2D_READ_ARRAY and GRIDMAN_ADDSURF2D_READ_GRID
C> are combined in the interface GRIDMAN_ADDSURF2D_READ
C>
C> 1st edge index GRID%EDGEINDEX(1) contains indices of Additional Surfaces
C> from the EIRENE input file 
C>
C**********************************************************************************************
      SUBROUTINE gridman_addsurf2d_read_grid(GRID,FNAME,IERR)
       USE gridman,ONLY:gridman_grid,gridman_sp,gridman_dp,
     u                  gridman_dbg,gridman_unit
       USE gridman_lib,ONLY:gridman_addsurf2d_read_array,
     u                      gridman_addsurf2grid_2d
       IMPLICIT NONE
C> Resulting grid object
       TYPE(gridman_grid) :: GRID
C> String containing the name of input file 
       CHARACTER(*),INTENT(IN) :: FNAME
C> Error code        
       INTEGER,INTENT(OUT) :: IERR
       
       INTEGER(GRIDMAN_SP) :: NSURF
       INTEGER :: ST
       INTEGER(GRIDMAN_SP),ALLOCATABLE :: ISRF(:)
       REAL(GRIDMAN_DP),ALLOCATABLE :: X(:,:),Y(:,:)
  
       IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "Starting GRIDMAN_ADDSURF2D_READ_GRID"

       ierr=0

       CALL gridman_addsurf2d_read_array(fname,nsurf,x,y,isrf,ierr) 
       IF(ierr.NE.0) GOTO 100

       CALL gridman_addsurf2grid_2d(grid,nsurf,x,y,isrf,ierr)
       IF(ierr.NE.0) GOTO 100

       IF(ALLOCATED(x)) DEALLOCATE(x,stat=st) 
       IF(ALLOCATED(y)) DEALLOCATE(y,stat=st) 
       IF(ALLOCATED(isrf)) DEALLOCATE(isrf,stat=st) 

       IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "GRIDMAN_ADDSURF2D_READ_GRID finished"

       RETURN

 100   WRITE(gridman_unit,*) "GRIDMAN_ADDSURF2D_READ_GRID terminated"
       IF(ALLOCATED(x)) DEALLOCATE(x,stat=st) 
       IF(ALLOCATED(y)) DEALLOCATE(y,stat=st) 
       IF(ALLOCATED(isrf)) DEALLOCATE(isrf,stat=st) 

      END  SUBROUTINE gridman_addsurf2d_read_grid
       
C**********************************************************************************************
C> Convert triangular elements (EIRENE additional surfaces) into (3D) grid object 
C>
C> WARNING: grid object which already exists will be overwritten!
C>
C> 1st edge index GRID%EDGEINDEX(1) contains indices of Additional Surfaces
C> from the EIRENE input file 
C**********************************************************************************************
      SUBROUTINE gridman_addsurf2grid_3d(GRID,NSURF,X,Y,Z,ISRF,IERR)
      USE gridman,ONLY:gridman_grid,gridman_sp,gridman_dp,
     u                 gridman_dbg,gridman_unit,gridman_check
      USE gridman_lib,ONLY:gridman_grid_allocate,gridman_index_allocate,
     u                     gridman_grid_deallocate,gridman_grid_check
      IMPLICIT NONE
C> Resulting grid object
      TYPE(gridman_grid) :: GRID
C> Number of edges
      INTEGER(GRIDMAN_SP),INTENT(IN) :: NSURF
C> X-coordinates of the triangle vertices   
      REAL(GRIDMAN_DP),INTENT(IN) :: X(3,nsurf)
C> Y-coordinates of the triangle vertices   
      REAL(GRIDMAN_DP),INTENT(IN) :: Y(3,nsurf)
C> Z-coordinates of the triangle vertices   
      REAL(GRIDMAN_DP),INTENT(IN) :: Z(3,nsurf)
C> Indices of EIRENE additional surfaces
      INTEGER(GRIDMAN_SP),INTENT(IN) :: ISRF(nsurf)
C> Error code
      INTEGER,INTENT(OUT) :: IERR  

      INTEGER(GRIDMAN_SP) :: I
      INTEGER :: RES,IERR0

      IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "Starting GRIDMAN_ADDSURF2GRID_3D"

      ierr=0

      IF(nsurf.LT.1) THEN
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2GRID_3D: ",
     w                       "incorrect number of edges"
       WRITE(gridman_unit,*) " NSURF ",nsurf
       ierr=100
       RETURN
      END IF
 
      CALL gridman_grid_allocate(grid,3,nsurf,3*nsurf,
     a                           0_gridman_sp,ierr,1,0)
      IF(ierr.NE.0) GOTO 100
      CALL gridman_index_allocate(grid%EDGEINDEX(1),1,nsurf,ierr)
      IF(ierr.NE.0) GOTO 200

      grid%CELLS=0
      DO i=1,nsurf
       grid%POINTS(1,i)=3*i-2 !3*(I-1)+1
       grid%POINTS(2,i)=3*i-1 !3*(I-1)+2
       grid%POINTS(3,i)=3*i
       grid%X(1,3*i-2)=x(1,i)
       grid%X(2,3*i-2)=y(1,i)
       grid%X(3,3*i-2)=z(1,i)
       grid%X(1,3*i-1)=x(2,i)
       grid%X(2,3*i-1)=y(2,i)
       grid%X(3,3*i-1)=z(2,i)
       grid%X(1,3*i)=x(3,i)
       grid%X(2,3*i)=y(3,i)
       grid%X(3,3*i)=z(3,i)
       grid%EDGEINDEX(1)%INDEXES(0,i)=i
       grid%EDGEINDEX(1)%INDEXES(1,i)=isrf(i)
      END DO

C     UNITS
      grid%UNIT2SI=1e-2_gridman_dp
      grid%UNITS='CENIMETER'
C     DEFAULT DESCRIPTINON
      grid%DESCRIPTION='EIRENE triangular Additional Surfaces'
      grid%EDGEINDEX(1)%DESCRIPTION="Index of EIRENE Additional Surface"
      grid%EDGEINDEX(1)%COLUMNS(1)='EIRENE_ADDSURF'

      IF(gridman_check) THEN
       CALL gridman_grid_check(grid,res,ierr)
       IF(res.NE.0.OR.ierr.GT.0) THEN  
        ierr=100
        WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2GRID_3D: ", 
     w                        "the resulting grid is incorrect" 
        CALL gridman_grid_deallocate(grid,ierr0)
       END IF
      END IF  

      IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "GRIDMAN_ADDSURF2GRID_3D finished"

      RETURN
 100  WRITE(gridman_unit,*) "GRIDMAN_ADDSURF2GRID_3D terminated"
      RETURN
 200  WRITE(gridman_unit,*) "ERROR in GRIDMAN_ADDSURF2GRID_3D: ",
     w                      "cannot allocate edge index"
      CALL gridman_grid_deallocate(grid,ierr0)
      RETURN

      END SUBROUTINE gridman_addsurf2grid_3d

C**********************************************************************************************
C> Read triangular EIRENE Additional Surfaces and convert them into (3D) grid object
C>
C> WARNING: grid object which already exists will be overwritten!
C>
C> GRIDMAN_ADDSURF3D_READ_ARRAY and GRIDMAN_ADDSURF3D_READ_GRID
C> are combined in the interface GRIDMAN_ADDSURF3D_READ
C>
C> 1st edge index GRID%EDGEINDEX(1) contains indices of Additional Surfaces
C> from the EIRENE input file 
C**********************************************************************************************
      SUBROUTINE gridman_addsurf3d_read_grid(GRID,FNAME,IERR)
       USE gridman,ONLY:gridman_grid,gridman_sp,gridman_dp,
     u                  gridman_dbg,gridman_unit
       USE gridman_lib,ONLY:gridman_addsurf3d_read_array,
     u                      gridman_addsurf2grid_3d
       IMPLICIT NONE
C> Resulting grid object
       TYPE(gridman_grid) :: GRID
C> String containing the name of input file 
       CHARACTER(*),INTENT(IN) :: FNAME
C> Error code        
       INTEGER,INTENT(OUT) :: IERR
       
       INTEGER(GRIDMAN_SP)  :: NSURF
       INTEGER :: ST
       INTEGER(GRIDMAN_SP) ,ALLOCATABLE :: ISRF(:)
       REAL(GRIDMAN_DP),ALLOCATABLE :: X(:,:),Y(:,:),Z(:,:)
  
       IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "Starting GRIDMAN_ADDSURF3D_READ_GRID"

       ierr=0

       CALL gridman_addsurf3d_read_array(fname,nsurf,x,y,z,isrf,ierr) 
       IF(ierr.NE.0) GOTO 100

       CALL gridman_addsurf2grid_3d(grid,nsurf,x,y,z,isrf,ierr)
       IF(ierr.NE.0) GOTO 100

       IF(ALLOCATED(x)) DEALLOCATE(x,stat=st) 
       IF(ALLOCATED(y)) DEALLOCATE(y,stat=st) 
       IF(ALLOCATED(z)) DEALLOCATE(z,stat=st) 
       IF(ALLOCATED(isrf)) DEALLOCATE(isrf,stat=st) 

       IF(gridman_dbg) 
     f   WRITE(gridman_unit,*) "GRIDMAN_ADDSURF3D_READ_GRID finished"

       RETURN

 100   WRITE(gridman_unit,*) "GRIDMAN_ADDSURF3D_READ_GRID terminated"
       IF(ALLOCATED(x)) DEALLOCATE(x,stat=st) 
       IF(ALLOCATED(y)) DEALLOCATE(y,stat=st) 
       IF(ALLOCATED(z)) DEALLOCATE(z,stat=st) 
       IF(ALLOCATED(isrf)) DEALLOCATE(isrf,stat=st) 

      END  SUBROUTINE gridman_addsurf3d_read_grid