diff options
| author | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
|---|---|---|
| committer | stainer_t <thomas.stainer@oecd-nea.org> | 2025-09-08 13:48:49 +0200 |
| commit | 7dfcc480ba1e19bd3232349fc733caef94034292 (patch) | |
| tree | 03ee104eb8846d5cc1a981d267687a729185d3f3 /Dragon/src/KELMRG.f | |
Initial commit from Polytechnique Montreal
Diffstat (limited to 'Dragon/src/KELMRG.f')
| -rw-r--r-- | Dragon/src/KELMRG.f | 69 |
1 files changed, 69 insertions, 0 deletions
diff --git a/Dragon/src/KELMRG.f b/Dragon/src/KELMRG.f new file mode 100644 index 0000000..5bcade6 --- /dev/null +++ b/Dragon/src/KELMRG.f @@ -0,0 +1,69 @@ +*DECK KELMRG + FUNCTION KELMRG(IPGEOM, NSURO, NVOLO, IDLGEO, MATGEO) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Merge zones for a heterogeneous block. +* +*Copyright: +* Copyright (C) 1990 Ecole Polytechnique de Montreal +* This library is free software; you can redistribute it and/or +* modify it under the terms of the GNU Lesser General Public +* License as published by the Free Software Foundation; either +* version 2.1 of the License, or (at your option) any later version +* +*Author(s): R. Roy +* +*Parameters: input +* IPGEOM pointer to the geometry. +* NSURO number of surfaces for a specific geometry. +* NVOLO number of zones for a specific geometry. +* IDLGEO specific position for a geometry. +* +*Parameters: output +* MATGEO numbering of zones and surfaces for all geometries. +* KELMRG number of surfaces and zones renumbered. +* +*----------------------------------------------------------------------- +* + USE GANLIB + IMPLICIT NONE + LOGICAL SWONCE + TYPE(C_PTR) IPGEOM + INTEGER KELMRG,NSURO,NVOLO,IDLGEO,MATGEO(*) + INTEGER IOUT, IND, MATMIN, MATMAX, ITYLCM, IMRG, JMRG, + > ILEN, I + PARAMETER ( IOUT=6 ) +* + IND(I)= IDLGEO + I + CALL LCMLEN(IPGEOM, 'MERGE', ILEN, ITYLCM) + IF( ILEN.EQ.0 )THEN + KELMRG= NVOLO - NSURO + 1 + ELSE + IF( ILEN.GT.NVOLO ) + > CALL XABORT('KELMRG: MERGING HAS TOO MANY ZONES' ) + CALL LCMGET(IPGEOM, 'MERGE', MATGEO(IND(1)) ) + MATMIN= 100000000 + MATMAX=-100000000 + DO 10 IMRG= 1, ILEN + IF( MATGEO(IND(IMRG)).LT.MATMIN) MATMIN= MATGEO(IND(IMRG)) + IF( MATGEO(IND(IMRG)).GT.MATMAX) MATMAX= MATGEO(IND(IMRG)) + 10 CONTINUE + IF( MATMIN.NE.1 ) + > CALL XABORT('KELMRG: NO FIRST MERGING ZONE' ) + DO 30 JMRG= MATMIN, MATMAX + SWONCE= .FALSE. + DO 20 IMRG= 1, ILEN + SWONCE= SWONCE.OR.(MATGEO(IND(IMRG)).EQ.JMRG) + 20 CONTINUE + IF( .NOT.SWONCE )THEN + WRITE(IOUT,*) 'WHERE IS MERGE REGION NO.', JMRG + CALL XABORT('KELMRG: ERROR IN MERGE NUMBERING' ) + ENDIF + 30 CONTINUE + KELMRG= MATMAX - NSURO + 1 + ENDIF +* + RETURN + END |