template.f

Go to the documentation of this file.

C> @file formats/template.f
C> Read/write coordinates in simple template file (DG template)
C GRIDMAN, grid managment library. Author: Vladislav Kotov, v.kotov@fz-juelich.de

!    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> Read planar coordinates from a simple template file (DG template)
C>
C> Simple template file defines geometry as a set of plygons (closed or open).
C> See DG manual, I.16.1. Each lines defines a pair of coordinates (in Millimeter!),
C> polygons are separated by empty lines: 
C> 
C>             X1_1 Y1_1 
C>             X2_2 Y2_2
C>             
C>             X1_3 Y1_3 
C>             X2_4 Y2_4
C>             X2_5 Y2_5
C>             
C>             .....
C>             X1_L-1 Y1_L-1
C>             X1_L Y1_L
C>
C>             end of file
C>             
C> Lines containing '>>' are comments, they are ignored
C>
C> WARNING: arrays N, X, Y must NOT be allcoated - 
C> they are allocated inside the subroutine. 
C> Arrays which already exist will be re-allocated
C>
C> GRIDMAN_TEMPLATE_READ_ARRAY AND  GRIDMAN_TEMPLATE_READ_GRID
C> are combined in the interface GRIDMAN_TEMPLATE_READ
C>
C*********************************************************************************
      SUBROUTINE gridman_template_read_array(FNAME,M,N,L,X,Y,IERR) 
      USE gridman,ONLY:gridman_dp,gridman_sp,gridman_dbg,gridman_unit
      IMPLICIT NONE
      INTRINSIC trim,sum,index,len_trim
C> String containing the name of input file 
      CHARACTER(*),INTENT(IN) :: FNAME    
C> Number of polygons 
      INTEGER(GRIDMAN_SP),INTENT(OUT) :: M
C> Number of vertices in each polygon, N(M) 
      INTEGER(GRIDMAN_SP),ALLOCATABLE :: N(:)
C> Total number of points, L=SUM(N)
      INTEGER(GRIDMAN_SP),INTENT(OUT) :: L
C> X coordinates of the vertices, X(L) 
      REAL(GRIDMAN_DP),ALLOCATABLE :: X(:)
C> Y coordinates of the vertices, Y(L) 
      REAL(GRIDMAN_DP),ALLOCATABLE :: Y(:)
C> Error code
      INTEGER,INTENT(OUT) :: IERR
     
      INTEGER(GRIDMAN_SP) :: IP,IV,IV1
      INTEGER :: IO
      CHARACTER(256) :: STR,STR0

      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "Starting GRIDMAN_TEMPLATE_READ_ARRAY"

      ierr=0 
      m=0
      l=0

      OPEN (unit=3,status='OLD',access='SEQUENTIAL',
     o      form='FORMATTED',file=fname,iostat=io)
      IF(io.NE.0) THEN
       ierr=300
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     o                       "can not open ",trim(fname)
       RETURN
      END IF
 
      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) 
     w        "GRIDMAN_TEMPLATE_READ_ARRAY: count polygons"

C     COUNT POLYGONS
      m=0
 10   READ(3,'(A)',end=20,iostat=io) str
      IF(io.NE.0) GOTO 100
      IF(len_trim(str).LT.1) m=m+1 !M IS INCREMENTED IF EMPTY LINE
      str0=str        
      GOTO 10     
 20   CONTINUE
      IF(len_trim(str0).GT.1) m=m+1 !... OR END OF FILE AND 
                                    !PREVIOUS LINE WAS NOT EMPTY
 
      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "GRIDMAN_TEMPLATE_READ_ARRAY: M= ",m

C     ALLOCATE N
      IF(m.LT.1) THEN
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     o                       "no polygons found in file ",trim(fname)
       ierr=300
       GOTO 200
      END IF
      IF(ALLOCATED(n)) DEALLOCATE(n,stat=io)
      ALLOCATE(n(m),stat=io)
      IF(io.NE.0) THEN
       ierr=200
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     w                       "cannot perform allocation, M ",m
       GOTO 200
      END IF

      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) 
     w        "GRIDMAN_TEMPLATE_READ_ARRAY: count lengths"

C     COUNT LENGTH OF EACH POLYGON
      rewind(3)
      ip=1 
      n(ip)=0
 11   READ(3,'(A)',end=21,iostat=io) str
      IF(io.NE.0) GOTO 100
C     IF NOT COMMENT THEN INCREMENT THE POLYGON LENGTH
      IF(index(str,'>>').GT.0) GOTO 11 !SKIP COMMENT  
      IF(len_trim(str).LT.1) THEN
C      IF EMPTY LINE THEN THE POLYGON INDEX IS INCREMENTED
       ip=ip+1       
       IF(ip.LT.m+1) n(ip)=0      
      ELSE
C       OTHERWISE THE POLYGON LENGTH IS INCREMENTED
        n(ip)=n(ip)+1 
      END IF

      GOTO 11     
 21   CONTINUE

      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "GRIDMAN_TEMPLATE_READ_ARRAY: N= ",n

C     ALLOCATE ARRAYS OF COORDINATES
      l=sum(n)
      IF(l.LT.1) THEN
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     o                  "all polygons are empty in file ",trim(fname)
       ierr=300
       GOTO 200
      END IF
      rewind(3)
      IF(ALLOCATED(x)) DEALLOCATE(x,stat=io)
      IF(ALLOCATED(y)) DEALLOCATE(y,stat=io)
      ALLOCATE(x(l),y(l),stat=io)
      IF(io.NE.0) THEN
       ierr=200
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     w                       "cannot perform allocation, L ",l
       GOTO 200
      END IF

      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "GRIDMAN_TEMPLATE_READ_ARRAY: L= ",l

      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) 
     w        "GRIDMAN_TEMPLATE_READ_ARRAY: read coordinates"

C     READ COORDINATES
      ip=1
      iv=0  !INDEX OF CURRENT VERTEX
      iv1=0 !ONLY FOR DIAGNOSTIC
 12   READ(3,'(A)',end=22,iostat=io) str
      IF(io.NE.0) GOTO 100
      IF(index(str,'>>').GT.0) GOTO 12 !SKIP COMMENT
      IF(len_trim(str).LT.1) THEN
C      INCREMENT THE POLYGON INDEX IF EMPTY LINE
       IF(iv1.NE.n(ip)) THEN
        WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     w      "internal error - counts do not match"
        WRITE(gridman_unit,*) " IP, IV1, N ",ip,iv1,n(ip)    
        ierr=400
        GOTO 200 
       END IF
       iv1=0
       ip=ip+1      
      ELSE
C      OTHERWISE READ COORDINATES
       iv=iv+1
       iv1=iv1+1
       IF(iv.GT.l) THEN
        WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     w      "internal error - counts do not match"
        WRITE(gridman_unit,*) " IP, IV, L ",ip,iv,l    
        ierr=400
        GOTO 200 
       END IF
       READ(str,*,iostat=io) x(iv),y(iv)
       IF(io.NE.0) GOTO 100
      END IF
      GOTO 12     
 22   CONTINUE

      CLOSE(3)

      IF(gridman_dbg) 
     w  WRITE(gridman_unit,*) "GRIDMAN_TEMPLATE_READ_ARRAY finished"

      RETURN

 100  ierr=300
      WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_READ_ARRAY: ",
     w               "cannot read template from file ",trim(fname)
 200  IF(ALLOCATED(n)) DEALLOCATE(n,stat=io)
      IF(ALLOCATED(x)) DEALLOCATE(x,stat=io)
      IF(ALLOCATED(y)) DEALLOCATE(y,stat=io)
      CLOSE(3)
      m=0
      l=0

      END SUBROUTINE gridman_template_read_array
    

C*********************************************************************************
C> Write coordinates into simple template file (DG template)
C>
C> See GRIDMAN_TEMPLATE_READ_ARRAY for description of the format
C>
C> GRIDMAN_TEMPLATE_WRITE_ARRAY and GRIDMAN_TEMPLATE_WRITE_GRID
C> are combined in the interface GRIDMAN_TEMPLATE_WRITE
C*********************************************************************************
      SUBROUTINE gridman_template_write_array(FNAME,M,N,L,X,Y,IERR) 
      USE gridman,ONLY:gridman_dp,gridman_sp,gridman_dbg,gridman_unit
      IMPLICIT NONE
      INTRINSIC trim,sum
C> String containing the name of input file 
      CHARACTER(*),INTENT(IN) :: FNAME    
C> Number of polygons 
      INTEGER(GRIDMAN_SP),INTENT(IN) :: M
C> Number of vertices in each polygon
      INTEGER(GRIDMAN_SP),INTENT(IN) :: N(m)
C> Total number of points, must be L=SUM(N)
      INTEGER(GRIDMAN_SP),INTENT(IN) :: L
C> X coordinates of the vertices
      REAL(GRIDMAN_DP),INTENT(IN) :: X(l)
C> Y coordinates of the vertices 
      REAL(GRIDMAN_DP),INTENT(IN) :: Y(l)
C> Error code
      INTEGER,INTENT(OUT) :: IERR

      INTEGER(GRIDMAN_SP) :: L1,IP,IV,IL
      INTEGER :: IO

      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "Starting GRIDMAN_TEMPLATE_READ_ARRAY"

      ierr=0 
      
      IF(m.LT.1) THEN
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_WRITE_ARRAY: ",
     w                       "incorrect number of polygons, M ",m
       ierr=100
       RETURN
      END IF

      l1=sum(n)
      IF(l1.NE.l) THEN
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_WRITE_ARRAY: ",
     w                       "incorrect number of points - L=/=sum(N)"
       WRITE(gridman_unit,*) "L, SUM(N) ",l,l1
       ierr=100
       RETURN
      END IF

      OPEN (unit=3,status='REPLACE',access='SEQUENTIAL',
     o      form='FORMATTED',file=fname,iostat=io)
      IF(io.NE.0) THEN
       ierr=300
       WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_WRITE_ARRAY: ",
     o                       "can not open ",trim(fname)
       RETURN
      END IF

      il=0
      DO ip=1,m
       DO iv=1,n(ip) 
        il=il+1
        IF(il.GT.l) THEN
         WRITE(gridman_unit,*) 
     w     "ERROR in GRIDMAN_TEMPLATE_WRITE_ARRAY: ",
     w     "internal error - too large index, IL, L ",il,l
         ierr=400
         CLOSE(3)
         RETURN  
        END IF
        WRITE(3,*,iostat=io) x(il), y(il)
        IF(io.NE.0) GOTO 100
       END DO 
       WRITE(3,*,iostat=io) 
       IF(io.NE.0) GOTO 100
      END DO
 
      CLOSE(3)

      IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "GRIDMAN_TEMPLATE_WRITE_ARRAY finished"

      RETURN

 100  ierr=300
      CLOSE(3)
      WRITE(gridman_unit,*) "ERROR in GRIDMAN_TEMPLATE_WRITE_ARRAY: ",
     w                      "cannot write into file ",trim(fname)

      END SUBROUTINE gridman_template_write_array