mergegrid.f

Go to the documentation of this file.

C> @file apps/mergegrid.f
C> Combine two grids onto one.
C>
C> Based on GRIDMAN library
C 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> Marging two grids, main program
C>
C> Usage ./mergegrid < mergegrid.parameters (namelist initialization)
C> Input parameters are described in mergegrid.parameters.description
C***************************************************************************************
      PROGRAM mergegrid
       USE gridman,ONLY:gridman_grid,gridman_dp,
     u                  gridman_dbg,gridman_unit,gridman_check
       IMPLICIT NONE
       INTRINSIC len_trim,get_command_argument,adjustl,trim    
C
       INTERFACE
        SUBROUTINE mergegrid_read(GRID1_IN,GRID2_IN,
     c                            grid1,grid2)
        USE gridman,ONLY:gridman_grid
        CHARACTER(LEN=256) :: GRID1_IN,GRID2_IN
        TYPE(gridman_grid) :: GRID1,GRID2
        END  SUBROUTINE mergegrid_read
C
        SUBROUTINE mergegrid_merge(GRID1,GRID2,MTOL,GRID3)
         USE gridman,ONLY:gridman_grid,gridman_dp
         TYPE(gridman_grid) :: GRID1,GRID2
         REAL(GRIDMAN_DP) :: MTOL
         TYPE(gridman_grid) :: GRID3
        END SUBROUTINE mergegrid_merge
C
        SUBROUTINE mergegrid_combine(GRID1,GRID2,GRID3)
         USE gridman,ONLY:gridman_grid
         TYPE(gridman_grid) :: GRID1,GRID2
         TYPE(gridman_grid) :: GRID3
        END SUBROUTINE mergegrid_combine
C
        SUBROUTINE mergegrid_write(GRID3_OUT,GRID3)
         USE gridman,ONLY:gridman_grid
         CHARACTER(LEN=256) :: GRID3_OUT
         TYPE(gridman_grid) :: GRID3
        END SUBROUTINE mergegrid_write
       END INTERFACE 
C      INPUT PARAMETERS
       CHARACTER(LEN=256) :: GRID1_IN,GRID2_IN,GRID3_OUT
       LOGICAL :: DBGMOD,LCHECK
       REAL(GRIDMAN_DP) :: MTOL
C      LOCAL PARAMETERS
       TYPE(gridman_grid) :: GRID1,GRID2,GRID3
       CHARACTER(LEN=8) :: FTMP

       CALL get_command_argument(1,ftmp)
       IF(len_trim(ftmp).GT.0) THEN
        IF(adjustl(trim(ftmp)).EQ.'help') THEN
         CALL print_description 
         stop
        END IF
       ELSE
C       1. READ INPUT FROM NAMELIST
        CALL read_input
       END IF

C
C      2. READ INPUT
C
       CALL mergegrid_read(grid1_in,grid2_in,grid1,grid2)

C
C      3. MERGE GRIDS
C
       WRITE(gridman_unit,*) "MERGEGRID: merging grids" 
       CALL mergegrid_merge(grid1,grid2,mtol,grid3)
C
C      4. OUTPUT 
C
      CALL mergegrid_write(grid3_out,grid3)
      
      WRITE(gridman_unit,*) "MERGEGRID COMPLETED"

      CONTAINS

C********************************************************************
C Read namelist from standard input
C********************************************************************
      SUBROUTINE read_input
       namelist /mergegrid/ grid1_in,grid2_in,grid3_out,
     c                      dbgmod,lcheck,mtol
       INTEGER :: IO

       grid1_in=''
       grid2_in=''
       grid3_out=''
       dbgmod=.false.
       lcheck=.false.
       mtol=1e-5

       rewind(5)
       READ(5,nml=mergegrid,iostat=io)
       IF(io.NE.0)
     f   CALL mergegrid_error("can not read namelist MERGEGRID")

       gridman_dbg=dbgmod
       gridman_check=lcheck

       IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "MERGE_GRID: READ_INPUT finished"

      END SUBROUTINE read_input

C
      SUBROUTINE print_description
       INTRINSIC index,len,trim
       INTEGER,PARAMETER :: FILE_LENGTH=1024
       CHARACTER(LEN=FILE_LENGTH) :: PATH
       CHARACTER(LEN=128) :: STR
       INTEGER :: I,IO
       CALL get_command_argument(0,path)
       i=index(path,'/',.true.) 
       IF(i.GT.len(path)) THEN 
        path=''
       ELSE 
        path=path(1:i)
       END IF

       IF(gridman_dbg)  WRITE(gridman_unit,*) " PATH:",trim(path)

       OPEN(unit=3,file=trim(path)//'mergegrid.parameters.description',
     o      status='OLD',iostat=io) 
       IF(io.NE.0) GOTO 100

       DO
        READ(3,'(A)',iostat=io,end=200) str
        IF(io.NE.0) GOTO 200
        WRITE(*,*) trim(str)
       END DO
 200   RETURN

 100   WRITE(gridman_unit,*)
     w      "Could not find mergegridg.parameters.description",
     w      trim(path)
       WRITE(gridman_unit,*)
     w  "Use 'which mergegrid' to invoke via the full path"

       END SUBROUTINE print_description
      END PROGRAM mergegrid

C********************************************************************
C Read grids and mappings
C********************************************************************
      SUBROUTINE mergegrid_read(GRID1_IN,GRID2_IN,GRID1,GRID2)
       USE gridman
       USE gridman_lib
       IMPLICIT NONE
       INTRINSIC len_trim
C      INPUT PARAMETERS
       CHARACTER(LEN=256) :: GRID1_IN,GRID2_IN
C      OUTPUT PARAMETERS
       TYPE(gridman_grid) :: GRID1,GRID2
C      LOCAL PARAMETERS
       INTEGER :: LT,IERR

       IF(gridman_dbg) 
     w  WRITE(gridman_unit,*) "MERGEGRID: starting MERGEGRID_READ"
      
       lt=len_trim(grid1_in)
       IF(lt.GT.0) THEN
        WRITE(gridman_unit,*) "MERGEGRID: reading file ",grid1_in(1:lt)
        CALL gridman_grid_read(grid1,grid1_in,ierr)
        IF(ierr.NE.0) CALL mergegrid_error('')
       ELSE
        CALL mergegrid_error('1st grid is not defined')
       END IF 
       lt=len_trim(grid2_in)
       IF(lt.GT.0) THEN
        WRITE(gridman_unit,*) "MERGEGRID: reading file ",grid2_in(1:lt)
        CALL gridman_grid_read(grid2,grid2_in,ierr)
        IF(ierr.NE.0) CALL mergegrid_error('')
       ELSE
        CALL mergegrid_error('2nd grid is not defined')
       END IF 

       IF(gridman_dbg) 
     w  WRITE(gridman_unit,*) "MERGEGRID: MERGEGRID_READ finished"

      END SUBROUTINE mergegrid_read


C***************************************************************************************
C Merge grids
C***************************************************************************************
      SUBROUTINE mergegrid_merge(GRID1,GRID2,MTOL,GRID3)
       USE gridman,ONLY:gridman_grid,gridman_dp,
     u                  gridman_dbg,gridman_unit,gridman_check
       USE gridman_lib,ONLY:gridman_grid2d_merge
       IMPLICIT NONE
C      INPUT PARAMETERS
       TYPE(gridman_grid) :: GRID1,GRID2
       REAL(GRIDMAN_DP) :: MTOL
C      OUTPUT PARAMETERS
       TYPE(gridman_grid) :: GRID3
C      LOCAL PARAMETERS
       INTEGER :: IERR
       LOGICAL :: LCHECK

       IF(gridman_dbg) 
     w   WRITE(gridman_unit,*) "MERGEGRID: starting MERGEGRID_MERGE"

       lcheck=gridman_check
       gridman_check=.true.
       CALL gridman_grid2d_merge(grid3,grid1,grid2,mtol,ierr)   
       IF(ierr.EQ.400) WRITE(gridman_unit,*) 
     w   "You may try to increase or decrease parameter MTOL ",mtol
       IF(ierr.NE.0) CALL mergegrid_error('')
       gridman_check=lcheck

       IF(gridman_dbg) 
     w  WRITE(gridman_unit,*) "MERGEGRID: MERGEGRID_MERGE finished"

      END SUBROUTINE mergegrid_merge
 
C***************************************************************************************
C Writing requested output
C***************************************************************************************
      SUBROUTINE mergegrid_write(GRID3_OUT,GRID3)
       USE gridman,ONLY:gridman_grid,gridman_dbg,gridman_unit
       USE gridman_lib,ONLY:gridman_grid_write
       IMPLICIT NONE
       INTRINSIC len_trim
C      INPUT PARAMETERS
       CHARACTER(LEN=256) :: GRID3_OUT
       TYPE(gridman_grid) :: GRID3

C      LOCAL PARAMETERS
       INTEGER :: LT,IERR

       IF(gridman_dbg) 
     w  WRITE(gridman_unit,*) "MERGEGRID: starting MERGEGRID_WRITE"

       lt=len_trim(grid3_out)
       IF(lt.GT.0) THEN
        WRITE(gridman_unit,*) "MERGEGRID: writing file ",grid3_out(1:lt)
        CALL gridman_grid_write(grid3,grid3_out,ierr)
        IF(ierr.NE.0) CALL mergegrid_error('')
       END IF

       IF(gridman_dbg) 
     w  WRITE(gridman_unit,*) "MERGEGRID: starting MERGEGRID_FINISHED"

      END SUBROUTINE mergegrid_write

C***************************************************************************************
C Print error message and exit
C***************************************************************************************
       SUBROUTINE mergegrid_error(STR)           
        USE gridman,ONLY:gridman_unit
        IMPLICIT NONE
        CHARACTER(*),INTENT(IN) :: STR
        INTEGER :: LT
        INTRINSIC len_trim
        lt=len_trim(str)
        IF(lt.GT.0) 
     w    WRITE(gridman_unit,*) "ERROR in  MERGEGRID: "//str(1:lt)
        stop "ERROR in  MERGEGRID - see log output"
       END SUBROUTINE  mergegrid_error