common/bk0/ IM ( At line 40 in my include file)
链接已复制
Jugoslav
Sorry clicked submit too early by accident
I meant to add - You may have IM declared twice in different places (eg two include files, or an include file and a source file)once as integer and once as real*8
Jugoslav/Les,
Thank you for your assistance, however I still cannot determine the source of my error.
I am writing a 2D CFD code. In this code I have three 2D domains containing cells in X and Y, the number of blocks I have is denoted NB. My initial problem is to read in the values for the x and y coordinates of each cell ( denoted xi and yi ) into a 3D array where the 3rd dimension of the array is the block number.
I start by reading the contents of two text files, XBLOCK and YBLOCK into two 1D arrays IM and JM. I then use these values of IM and JM in a DO Loop in my subroutine READDATA to read the x and y values for each cell into a 3D array.
I figure that my subroutine cannot "see "the values for IM and JM as when I output the data the values for IM and JM, and hence xi and yi are zero. It seems that I must make the values if IM and JM accessible to the main program and subroutines via a common block, but if I use a common block in my INCLUDE file I get the error message "Conflicting attributes or multiple declaration of name" at compile.
Once again I'd be grateful for any assistance in figuring out where I have gone wrong.
I enclose part of my main program, subroutine, include file and data files XBLOCK and YBLOCK below.
PROGRAM
SOLVER2DIMPLICIT NONE
INCLUDE
'INCLUDE.INC'OPEN
(5, FILE = 'XBLOCK.DAT')OPEN
(6, FILE = 'YBLOCK.DAT')DO
NB=1,3READ
(5,*) IM(NB)READ
(6,*) JM(NB)END DO
CALL
READDATA (NB,IM,JM,XI,YI)CALL
OUTPUT (NB,IM,JM,XI,YI)END
PROGRAM!**************************************************************************************************
SUBROUTINE
READDATA (NB,IM,JM,XI,YI)INCLUDE
'INCLUDE.INC'CALL
READDATA1 (1,IM,JM, XI,YI)END SUBROUTINE
READDATA!**************************************************************************************************
SUBROUTINE
READDATA1 (NB,IM,JM,XI,YI)INCLUDE
'INCLUDE.INC'OPEN
(10, FILE = 'grid_block1.DAT')READ
(10,' (1x,f10.6,1x,f10.6/))') ((xi(i,j,NB),yi(i,j,NB), i=1,im(NB)), j=1,jm(NB))END SUBROUTINE
READDATA1!**************************************************************************************************
XBLOCK text file contents
16
16
26
YBLOCK text file contents
51
51
51
Steve,
I'm sorry I forgot to add the include file. I give a more complete listing of my code below.
Thank you,
Simon.
PROGRAM SOLVER2D
IMPLICIT NONE
INCLUDE 'INCLUDE.INC'
OPEN (5, FILE = 'XBLOCK.DAT')
OPEN (6, FILE = 'YBLOCK.DAT')
DO NB=1,3
READ (5,*) IM(NB)
READ (6,*) JM(NB)
END DO
CALL READDATA (NB,IM,JM,XI,YI)
CALL OUTPUT (NB,IM,JM,XI,YI)
END PROGRAM
!**************************************************
SUBROUTINE READDATA (NB,IM,JM,XI,YI)
INCLUDE 'INCLUDE.INC'
CALL READDATA1 (1,IM(NB),JM(NB), XI,YI)
CALL READDATA1 (2,IM(NB),JM(NB), XI,YI)
CALL READDATA1 (3,IM(NB),JM(NB), XI,YI)
END SUBROUTINE READDATA
!**************************************************
SUBROUTINE READDATA1 (NB,IM,JM,XI,YI)
INCLUDE 'INCLUDE.INC'
OPEN (10, FILE = 'grid_block1.DAT')
READ (10,' (1x,f10.6,1x,f10.6/))') ((xi(i,j,NB),yi (i,j,NB), i=1,im(NB)), j=1,jm(NB))
END SUBROUTINE READDATA1
!**************************************************
SUBROUTINE READDATA2 (NB,IM,JM,XI,YI)
INCLUDE 'INCLUDE.INC'
OPEN (20, FILE = 'grid_block2.DAT')
READ (20,' (1x,f10.6,1x,f10.6/))') ((xi(i,j,NB),yi(i,j,NB), i=1,im(NB)), j=1,jm(NB))
END SUBROUTINE READDATA2
!**************************************************
SUBROUTINE READDATA3 (NB,IM,JM,XI,YI)
INCLUDE 'INCLUDE.INC'
OPEN (30, FILE = 'grid_block3.DAT')
READ
END SUBROUTINE READDATA3
!**************************************************
SUBROUTINE OUTPUT (NB,IM,JM,XI,YI)
INCLUDE 'INCLUDE.INC'
OPEN (5000, FILE = 'block1_results.DAT')
WRITE (5000,2020)
WRITE (5000,2025)
DO J=1,JM(NB)
DO I=1,IM(NB)
WRITE (5000,2035) xi(I,J,NB),yi(I,J,NB)
END DO
END DO
2020 FORMAT (1X,'TITLE = "X", "Y")
2025 FORMAT (1X,'VARIABLES = "X", "Y")
2030 FORMAT (1X,'ZONE T = "1", I = ',I3,2X, 'J= ',I3,2X,'F=POINT')
2035 FORMAT (9(2X,F15.3))
ENDSUBROUTINEOUTPUT
!**************************************************
! INCLUDE FILE 'INCLUDE.INC'
INTEGER i, j,NB
REAL*8 IM(NB)
REAL*8 JM(NB)
REAL*8 xi(IM,JM,NB), yi(IM,JM,NB)
COMMON/bk0/ IM,JM
COMMON/bk1/ XI,YI
!**************************************************
XBLOCK text file contents
16
16
26
YBLOCK text file contents
51
51
51
REAL*8 xi(IM,JM,NB), yi(IM,JM,NB)
with
REAL*8 xi(I,J,NB), yi(I,J,NB)
The way you have it, IM and JM are previously declared as arrays, but you then use them as bounds expressions, which is not allowed.
Simon
(1) Each subroutine has the include file AND you pass the IM,JM,XI,YI arrays as actual arguments - not a good idea.
(2) You have not specified anywhere the initial sizes of the arrays IM, JM, XI and YI. The actual (anticipated maximum?) sizes should be specified in the include file.
If this is an extract froma real application youmay want to consider using (a) modules instead of common and (b) possibly dynamic allocation of theXI,YI arrays depending on the values read in to IM and JM
eg
K=max(IM)
L=max(JM)
allocate (XI(K,L,3),stat=ierr)
allocate(YI(K,L,3),stat=ierr)
etc.
HTH
Les
