diff options
Diffstat (limited to 'Dragon/src/XELEDC.f')
| -rw-r--r-- | Dragon/src/XELEDC.f | 172 |
1 files changed, 172 insertions, 0 deletions
diff --git a/Dragon/src/XELEDC.f b/Dragon/src/XELEDC.f new file mode 100644 index 0000000..cb30ac6 --- /dev/null +++ b/Dragon/src/XELEDC.f @@ -0,0 +1,172 @@ +*DECK XELEDC + SUBROUTINE XELEDC( NDIM, MAXGRI, NGEOME, NTOTCO, NTYPES, + > NBLOCK, NUNKO, + > NSURO, NVOLO, MINDO, MAXDO, + > ICORDO, IDLDIM, KEYGEO, + > KEYTYP, IDLBLK, KEYINT, + > NTOTCL, MAXR, NSUR, NVOL, KEYCYL ) +* +*----------------------------------------------------------------------- +* +*Purpose: +* Associate all blocks of a problem to only one geometry and generate +* the 4 useful integer values that will describe the problem +* in its exact geometric description. +* +*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 +* NDIM number of dimensions. +* MAXGRI number of grid cell in x/y/z directions. +* NGEOME number of geometries. +* NTOTCO tot number of cylinders in all geometries. +* NTYPES number of types. +* NBLOCK number of blocks. +* NUNKO number of unknowns. +* NSURO number of surfaces of each geometry. +* NVOLO number of zones of each geometry. +* MINDO min index in the remesh array. +* MAXDO min index in the remesh array. +* ICORDO coordinate for remesh array. +* IDLDIM position of each geoemtry in cylinders numbering. +* KEYGEO geometric key for each type. +* KEYTYP type key for each block. +* IDLBLK position of each block in numbering scheme. +* KEYINT numbering of cell interfaces. +* +*Parameters: input +* NTOTCL tot number of cylinders in exact geometry. +* MAXR lenght to stock real abscissae. +* NSUR number of surfaces of exact geometry (negative). +* NVOL number of zones of exact geometry. +* KEYCYL index of cylinders by block. +* +*----------------------------------------------------------------------- +* + IMPLICIT NONE +* + INTEGER NDIM, NGEOME, NTOTCO, NTYPES, NBLOCK, NUNKO, + > NTOTCL, MAXR, NSUR, NVOL + INTEGER MAXGRI(3), NSURO(NTYPES), NVOLO(NTYPES), + > MINDO(NTOTCO), MAXDO(NTOTCO), ICORDO(NTOTCO), + > IDLDIM(NTYPES), KEYGEO(NTYPES), + > KEYTYP(NBLOCK), IDLBLK(NBLOCK), KEYCYL(NBLOCK), + > KEYINT( NUNKO) +* + INTEGER ICUR(3), IBLK, N, ICX, ITYP, IGEO, IDLD, MDMIN, + > NP1, NP2, IP1, IP2, IP3, NC, NSUX, NVOX, IVX + INTEGER NUMBLK, I, K +* + NUMBLK(I,K)= I + IDLBLK(K) +* + DO 5 IBLK= 1, NBLOCK + KEYCYL(IBLK)= 0 + 5 CONTINUE +* +* DETERMINE: NTOTCL & MAXR +*.1) RECONSTRUCT CARTESIAN MESH + MAXR= 0 + NTOTCL= 3 + ICUR(1)= 1 + ICUR(2)= 1 + ICUR(3)= 1 + DO 30 N= 1, 3 +* +* SCANNING CELLS ON THE AXIS #N + DO 20 ICX= 1, MAXGRI(N) + ICUR(N)= ICX + IF( NDIM.EQ.2 )THEN + IBLK= MAXGRI(1) * (ICUR(2) - 1) + ICUR(1) + ELSE + IBLK= MAXGRI(1)*(MAXGRI(2)*ICUR(3)+ICUR(2)- + > MAXGRI(2))+ICUR(1)-MAXGRI(1) + ENDIF + ITYP= KEYTYP(IBLK) + IF( ITYP.EQ.0 ) GO TO 20 + IGEO= KEYGEO(ITYP) + IDLD= IDLDIM(IGEO) + MAXR= MAXR + (MAXDO(IDLD+N)-MINDO(IDLD+N)) + 20 CONTINUE + ICUR(N)= 1 + MAXR= MAXR+1 + 30 CONTINUE +* +*.2) RECONSTRUCT INFORMATIONS FOR CYLINDRICAL MESH + IF( NDIM.EQ.2 )THEN + MDMIN= 3 + ELSE + MDMIN= 1 + ENDIF + DO 130 N= MDMIN, 3 + ICUR(N)= 1 + NP1= MOD(N ,3) + 1 + NP2= MOD(N+1,3) + 1 + DO 120 IP2= 1, MAXGRI(NP2) + DO 110 IP1= 1, MAXGRI(NP1) + ICUR(NP1)= IP1 + ICUR(NP2)= IP2 + IF( NDIM.EQ.2 )THEN + IBLK= MAXGRI(1) * (ICUR(2) - 1) + ICUR(1) + ELSE + IBLK= MAXGRI(1)*(MAXGRI(2)*ICUR(3)+ICUR(2)- + > MAXGRI(2))+ICUR(1)-MAXGRI(1) + ENDIF + ITYP= KEYTYP(IBLK) + IF( ITYP.EQ.0 ) GO TO 110 + IGEO= KEYGEO(ITYP) + IDLD= IDLDIM(IGEO) + IF( IGEO.NE.NGEOME )THEN + NC= IDLDIM(IGEO+1)-IDLD-3 + ELSE + NC= NTOTCO-IDLD-3 + ENDIF + IF( NC.EQ.1 )THEN + IF( ICORDO(IDLD+4).EQ.N )THEN + NTOTCL= NTOTCL+1 + MAXR= MAXR + 3 + (MAXDO(IDLD+4)-MINDO(IDLD+4)) + DO 105 IP3= 1, MAXGRI(N) + ICUR(N)= IP3 + IF( NDIM.EQ.2 )THEN + IBLK= MAXGRI(1) * (ICUR(2) - 1) + ICUR(1) + ELSE + IBLK= MAXGRI(1)*(MAXGRI(2)*ICUR(3)+ICUR(2)- + > MAXGRI(2))+ICUR(1)-MAXGRI(1) + ENDIF + KEYCYL(IBLK)= NTOTCL + 105 CONTINUE + ICUR(N)= 1 + ENDIF + ENDIF + 110 CONTINUE + 120 CONTINUE + 130 CONTINUE +* +* DETERMINE: NSUR & NVOL + NSUR= 0 + NVOL= 0 + DO 230 IBLK= 1,NBLOCK + ITYP= KEYTYP(IBLK) + IF( ITYP.EQ.0 ) THEN + CALL XABORT( '*** XELEDC: EXACT VOID CELL NOT ALLOWED') + ENDIF + IGEO= KEYGEO(ITYP) + NSUX= NSURO(IGEO) + NVOX= NVOLO(IGEO) + DO 220 IVX= NSUX, NVOX + IF( IVX.LT.0 )THEN + IF( KEYINT(NUMBLK(IVX,IBLK)).EQ.0 ) NSUR= NSUR-1 + ELSEIF( IVX.GT.0 )THEN + NVOL= NVOL + 1 + ENDIF + 220 CONTINUE + 230 CONTINUE +* + RETURN + END |