 |
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
simon
Joined: 05 Jul 2006 Posts: 299
|
Posted: Sun Aug 07, 2011 4:01 am Post subject: Module conflicts |
|
|
The following program fails to print anything between the signs, and the commented out line that tries to assign a value prior to the subroutine call generates an error message.
There are 4 modules, the first defines a derived type, t2, that is defined in terms of another derived type, t1. The subroutine s11 assigns a value to t2. Module m2 contains another subroutine that does not do anything, and which is never called. Modules m3 and m4 do nothing, but the main program does use m4. If m4 is used after m1 in the main program, the program works as one would expect. Similarly, any further simplification of any of the modules seems to fix the problem.
Code: | MODULE m1
TYPE t1
INTEGER :: i
END TYPE t1
TYPE t2
TYPE(t1) :: e
END TYPE t2
CONTAINS
SUBROUTINE s11 (a)
TYPE(t2) :: a
a%e%i=0
END SUBROUTINE s11
END MODULE m1
!
MODULE m2
CONTAINS
SUBROUTINE s21 (b)
USE m1
TYPE(t1) :: b
END SUBROUTINE s21
END MODULE m2
!
MODULE m3
USE m2
END MODULE m3
!
MODULE m4
USE m3
USE m1
END MODULE m4
!
PROGRAM p
USE m4
USE m1
TYPE(t2) :: z
! z%e%i=0 ! This line will generate an error message
CALL s11 (z)
PRINT *,'Value: ','$',z,'$'
END PROGRAM p |
|
|
Back to top |
|
 |
JohnCampbell
Joined: 16 Feb 2006 Posts: 2615 Location: Sydney
|
Posted: Mon Aug 08, 2011 12:49 am Post subject: |
|
|
As module M4 has USE M1, if you comment out USE M1 from the program P, I'd expect that it still should be accessible. With this change, it does compile without any error report.
I've always have a hierarchy of modules for parameter and type definition, although my equivalent of M4 is the only one where I allocate variables. |
|
Back to top |
|
 |
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 8211 Location: Salford, UK
|
Posted: Mon Aug 08, 2011 7:04 am Post subject: |
|
|
John is correct in his expectation. However, this is presumably a bug and I will aim to provide a fix if this can be achievedd in an economical way. |
|
Back to top |
|
 |
simon
Joined: 05 Jul 2006 Posts: 299
|
Posted: Mon Aug 08, 2011 5:19 pm Post subject: |
|
|
Thanks to both of you - I clearly need to go through my code and clean up some duplicated USE statements. Referring back to the sample code, if I add in a few ONLY qualifiers (specifically in s21, m4, and p), the same problems remain (see below). Is that because in m4, t1 is effectively used twice, even though in m2 it is only used locally in the subroutine?
Code: | MODULE m1
TYPE t1
INTEGER :: i
END TYPE t1
TYPE t2
TYPE(t1) :: e
END TYPE t2
CONTAINS
SUBROUTINE s11 (a)
TYPE(t2) :: a
a%e%i=0
END SUBROUTINE s11
END MODULE m1
!
MODULE m2
CONTAINS
SUBROUTINE s21 (b)
USE m1, ONLY: t1
TYPE(t1) :: b
END SUBROUTINE s21
END MODULE m2
!
MODULE m3
USE m2
END MODULE m3
!
MODULE m4
USE m3
USE m1, ONLY: t1
END MODULE m4
!
PROGRAM p
USE m4
USE m1, ONLY: t2,s11
TYPE(t2) :: z
! z%e%i=0
CALL s11 (z)
PRINT *,'Value: ','$',z,'$'
END PROGRAM p |
In trying to identify what is used, consider the following program, which will not compile because type t is unknown to m3, even though t is used in s2 in module m2, and m2 is used in m3.
Code: | MODULE m1
TYPE t
INTEGER :: i
END TYPE t
END MODULE m1
!
MODULE m2
CONTAINS
SUBROUTINE s2 ()
USE m1, ONLY: t
TYPE(t) :: b
END SUBROUTINE s2
END MODULE m2
!
MODULE m3
USE m2
TYPE(t) :: c
END MODULE m3 |
|
|
Back to top |
|
 |
JohnCampbell
Joined: 16 Feb 2006 Posts: 2615 Location: Sydney
|
Posted: Tue Aug 09, 2011 3:47 am Post subject: |
|
|
My comment is probably showing my age, but why use CONTAINS ?
For my main software package I have 3 main modules, all in one file:
PARAMETER_DEFINITION
TYPE_DEFINITION
KEY_VARIABLES
There are other modules, such as for menus, screen graphics and some specialised stand-alone calculations, which typically refer to the PARAMETER_DEFINITION.
I compile and link all files plus other .lib static libraries for a win32 executable.
Any routines that requires access to any data structure has reference to the required modules.
It all works very reliably and I've never required CONTAINS. To me, any simplification/improvement that CONTAINS provides appears trivial.
It frustrates me that these new structures may be available but do not appear to improve either the functionality or reliability of the resulting code.
John |
|
Back to top |
|
 |
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 8211 Location: Salford, UK
|
Posted: Wed Aug 17, 2011 11:22 am Post subject: |
|
|
I have fix this particular bug for the next release.
However, you may get more false errors of this kind in this general area.
For safety it is better to avoid redundant USE statements.
Also, where more than one inter-related module is USEd, it is better
to order them in their natural order of dependency. |
|
Back to top |
|
 |
simon
Joined: 05 Jul 2006 Posts: 299
|
Posted: Wed Sep 14, 2011 11:45 am Post subject: |
|
|
Super. Thanks for working on that Paul.
I think I still need a bit of help understanding exactly what to use. Consider the following program in which module m1 defines derived type t1, plus some other variable(s) that I don't need right now. The module also defines a procedure for initializing t1. Module t2, then defines a second derived type, t2, that is defined in terms of t1. There is again a procedure for initializing t2. I have to use t1 upfront in module m2, and so include the relevant use statement, but I don't want the useless character variable, so add "ONLY: t1". I would think that I need to use assign_t1 in subroutine s2, but I still get a compilation error message. And then even if it did compile, I'm not sure what I should be using in program p.
Code: | MODULE m1
TYPE t1
INTEGER :: 1
END TYPE t1
CHARACTER(LEN=1) :: useless
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE assign_t1
END INTERFACE
CONTAINS
SUBROUTINE assign_t1 (t,i)
INTEGER, INTENT(IN) :: i
TYPE(t1), INTENT(OUT) :: t
t%i1=i
RETURN
END SUBROUTINE assign_t1
END MODULE m1
!
MODULE m2
USE m1, ONLY: t1
TYPE t2
INTEGER :: i2
TYPE(t1) :: ta
END TYPE t2
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE assign_t2
END INTERFACE
CONTAINS
SUBROUTINE assign_t2 (t,i)
USE m1, ONLY: assign_t1
INTEGER, INTENT(IN) :: i
TYPE(t2), INTENT(OUT) :: t
t%i2=i
t%ta=i
RETURN
END SUBROUTINE assign_t2
END MODULE m2
PROGRAM p
USE m2, ONLY: t2
TYPE(t2) :: tt
tt=0
END PROGRAM p |
|
|
Back to top |
|
 |
davidb
Joined: 17 Jul 2009 Posts: 560 Location: UK
|
Posted: Wed Sep 14, 2011 4:16 pm Post subject: |
|
|
You need to use the PRIVATE statement (you may use it with ONLY). Consider the following code.
Code: |
MODULE MOD1
REAL :: A
END MODULE MOD1
MODULE MOD2
USE MOD1 !\ MOD1 is used by MOD2 but its "contents" are not
PRIVATE !/ visible to a subprogram that uses MOD2.
REAL, PUBLIC :: X
PUBLIC FOO
CONTAINS
SUBROUTINE FOO
...
END SUBROUTINE FOO
END MODULE MOD2
SUBROUTINE AAAA
USE MOD2
! Only X and FOO are imported.
! A in MOD1 is hidden behind PRIVATE
END SUBROUTINE AAA
PROGRAM ANON
USE MOD1, ONLY: A !\ No duplicates!
USE MOD2, ONLY, X, FOO !/
...
END PROGRAM ANON
|
My preference is to "Hide most things" behind private and I nearly always use ONLY with USE.
Fortran 2003 has a useful submodule feature which is also helpful to resolve the kind of conflicts you have reported. But this is not part of Fortran 95.
Notwithstanding this comment, the original code was correct and should not have generated errors since duplicate USE statements are allowed in Fortran 95, but it looks like Paul has fixed this BUG in the next release. _________________ Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl
Last edited by davidb on Wed Sep 14, 2011 4:35 pm; edited 2 times in total |
|
Back to top |
|
 |
davidb
Joined: 17 Jul 2009 Posts: 560 Location: UK
|
Posted: Wed Sep 14, 2011 4:29 pm Post subject: Re: |
|
|
JohnCampbell wrote: | My comment is probably showing my age, but why use CONTAINS ?
John |
CONTAINS is Required syntax if you want to put subroutines or functions inside modules. This makes the interfaces to these explicit. If you don't do this you have to put your subroutines and functions in separate files (like in Fortram 77) and either need to declare the interface using INTERFACE or don't declare the interface (aside from a functions type) as you wish.
With FTN95 you're a bit spoilt since it checks the interface for you anyway (with /CHECK), but with other compilers explicit interfaces are a very good idea.
If you only use modules to store variables, parameters and derived types you won't need CONTAINS. _________________ Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl
Last edited by davidb on Wed Sep 14, 2011 11:10 pm; edited 1 time in total |
|
Back to top |
|
 |
simon
Joined: 05 Jul 2006 Posts: 299
|
Posted: Wed Sep 14, 2011 9:25 pm Post subject: |
|
|
Thanks for all the inputs. Perhaps my problem is best illustrated by the following code in which there is one module that defines a derived type and a procedure for initializing the derived type. The derived type and the procedure are declared as public, but a private statement is included in the module in case there is other stuff included that is not meant to be accessed. The program uses the derived type and the procedure, but an error message is generated. I don't know whether this is a bug or a programming error, but partly for because of this error (but primarily because of laziness!) I have avoided using blanket private declarations. If the private statement is deleted the program compiles.
Code: | MODULE m1
PRIVATE
PUBLIC :: t1
TYPE t1
INTEGER :: i1
END TYPE t1
PUBLIC :: assign_t1
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE assign_t1
END INTERFACE
CONTAINS
SUBROUTINE assign_t1 (t,i)
INTEGER, INTENT(IN) :: i
TYPE(t1), INTENT(OUT) :: t
t%i1=i
RETURN
END SUBROUTINE assign_t1
END MODULE m1
PROGRAM p
USE m1, ONLY: t1,assign_t1
TYPE(t1) :: tt
tt=0
END PROGRAM p |
|
|
Back to top |
|
 |
davidb
Joined: 17 Jul 2009 Posts: 560 Location: UK
|
Posted: Wed Sep 14, 2011 10:41 pm Post subject: |
|
|
OK I can see what you're trying to do.
Your code isn't correct (and it shouldn't compile even when PRIVATE is commented out).
The correct syntax is as follows.
Code: |
MODULE m1
PRIVATE
PUBLIC :: t1
TYPE :: t1
INTEGER :: i1
END TYPE t1
PUBLIC :: ASSIGNMENT(=)
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE assign_t1
END INTERFACE
CONTAINS
SUBROUTINE assign_t1 (t,i)
INTEGER, INTENT(IN) :: i
TYPE(t1), INTENT(OUT) :: t
t%i1=i
RETURN
END SUBROUTINE assign_t1
END MODULE m1
PROGRAM p
USE m1, ONLY: t1, ASSIGNMENT(=)
TYPE(t1) :: tt
tt=0
END PROGRAM p
|
I just checked this and it works with FTN95 and NAG's compiler. This nicely hides the subroutine assign_t1 from USErs (in this code p is a USEr) while exposing the ability to assign integers to type(t1) variables (which is what you want).
Having ASSIGNMENT(=) on the USE line and with PUBLIC is, perhaps, not well known and hard to find online. It is in the Fortran 2003 Handbook, however, so it must be right. _________________ Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl |
|
Back to top |
|
 |
simon
Joined: 05 Jul 2006 Posts: 299
|
Posted: Thu Sep 15, 2011 10:40 am Post subject: |
|
|
Thanks so much. I have not seen that syntax anywhere before so I cannot imagine that I would ever have worked that out. One last question (hopefully!): what if you had two derived types in module m1, both of which have interface assignments - how would the USE statement be modified to point to the one module procedure but not to the second? In practice, I doubt it will matter since the overloading should handle things. But now you all have me declaring everything as private in my modules, I'm trying to go the full hog! |
|
Back to top |
|
 |
davidb
Joined: 17 Jul 2009 Posts: 560 Location: UK
|
Posted: Thu Sep 15, 2011 10:35 pm Post subject: |
|
|
There can only be one generic interface. If there is more than one derived type, then USE, ONLY: ASSIGNMENT(=) will import ALL of the assignment operators for each type listed in the only-list.
Types not listed can't be used in assignments, so you just leave off the ones you don't need to use.
In the code below, the program p uses t1 (and its assignment interface) but not t2. Another subroutine might use t2 but not t1. A third subroutine might want to use both.
Code: |
MODULE m1
PRIVATE
PUBLIC :: t1, t2
TYPE :: t1
INTEGER :: i1
END TYPE t1
TYPE :: t2
REAL :: r1
END TYPE t2
PUBLIC :: assignment(=)
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE assign_t1
MODULE PROCEDURE assign_t2
END INTERFACE
CONTAINS
SUBROUTINE assign_t1 (t,i)
INTEGER, INTENT(IN) :: i
TYPE(t1), INTENT(OUT) :: t
t%i1=i
RETURN
END SUBROUTINE assign_t1
SUBROUTINE assign_t2 (t,r)
REAL, INTENT(IN) :: r
TYPE(t2), INTENT(OUT) :: t
t%r1=r
RETURN
END SUBROUTINE assign_t2
END MODULE m1
PROGRAM p
USE m1, ONLY: t1, assignment(=)
TYPE(t1) :: tt
tt=0
END PROGRAM p
|
_________________ Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl |
|
Back to top |
|
 |
JohnCampbell
Joined: 16 Feb 2006 Posts: 2615 Location: Sydney
|
Posted: Fri Sep 16, 2011 1:43 am Post subject: |
|
|
I've indicated that I have taken a more basic approach to defined types and not defined an assignment operation. My typical approach is to define a zero value parameter for each type, as shown below. You could also define a unit value parameter. This covers the initialisation and then I typically then operate on components of the type.
Code: | !
! Define type
TYPE TIDE_RECORD ! for each time unit
integer*4 tide_status ! 0=ebb, 1=flood, 3=low-60:+60 4=high-90:-30 5=high-30:0 6=high1:+30
real*4 day_time ! real hours
real*4 tide_height ! metres
real*4 tide_flow ! metres per hour
real*4 tide_range ! this tide range to slack +ve flood; -ve ebb
real*4 draft_limit(2) ! draft metres allowable for nominal swell
integer*4 tide_id ! high tide offset (+ve past last high water) (-ve to next high water)
integer*4 next_slack ! number of next slack water (=-99:low;=-98:high)
END TYPE TIDE_RECORD
!
! Define zero operator
type (Tide_Record), parameter :: &
Tide_zero = tide_record (0, 0., 0., 0., 0., (/0.,0./), 0, 0)
!
! Allocate type
type (tide_record) tide_info(min_tide_times:max_tide_times)
!
! Initialise
tide_info = Tide_zero
! |
As for CONTAINS, I've preferred a static library approach and use INTERFACE when rarely required. For transfering variables, I limit myself to an argument list or USE module or INCLUDE common. Minimises the source of obscure bugs.
John |
|
Back to top |
|
 |
simon
Joined: 05 Jul 2006 Posts: 299
|
Posted: Fri Sep 16, 2011 8:08 pm Post subject: |
|
|
John, That's fine if all you want to do with the module procedure is to use it to initialize the various elements of a derived type, but there are more interesting things one can do with these interfaces, particularly with the operators. As, a fairly trivial example, below is a derived type that defines the date, and then the operator > is defined to compare whether one date is after another date.
Code: | MODULE dates
TYPE pdate
INTEGER :: iyr ! - year -
INTEGER :: imn ! - month -
INTEGER :: idy ! - day -
END TYPE pdate
!
INTERFACE OPERATOR(>)
MODULE PROCEDURE gt_pdate
END INTERFACE
!
CONTAINS
FUNCTION gt_pdate(d1,d2)
! Checks whether first date is greater than second date
LOGICAL :: gt_pdate
TYPE(pdate), INTENT(IN) :: d1,d2
!
gt_pdate=.true.
IF (d1%iyr>d2%iyr) THEN
RETURN
ELSE IF (d1%iyr==d2%iyr) THEN
IF (d1%imn>d2%imn) THEN
RETURN
ELSE IF (d1%imn==d2%imn) THEN
IF (d1%idy>d2%idy) RETURN
END IF
END IF
gt_pdate=.false.
RETURN
END FUNCTION gt_pdate
END MODULE dates |
Yes, you could just call the required function to give the desired answer, but it can be very handy to use a consistent syntax in a program. For example, imagine a simple test for whether somebody was born in the USA after 9/11. We set an integer idc, which indicates what country the person was born in (in this case based on international dialing codes), while their birthday is stored in dbirth. I think the first test in the programme below that uses the operator is easier to read than the second test that calls the function directly.
Code: | PROGRAM p
USE dates
TYPE(pdate) :: d911,dbirth
INTEGER :: idc
d911%iyr=2001
d911%imn=9
d911%idy=11
:
IF ((dbirth>d911).AND.(idc==1)) THEN
PRINT *, 'Born in post-911 USA'
END IF
IF (gt_pdate(dbirth,d911).AND.(idc==1)) THEN
PRINT *, 'Born in post-911 USA'
END IF
END PROGRAM p |
Similarly, if we define a procedure for the operators + and -, then it becomes easy to change dates using simple arithmetic syntax rather than having to spell function calls out in full. Granted, one could argue that none of this provides new functionality, but at the cost of 3 lines in the module to define the interface operator, I think it makes for some elegance and simplicity.
One further comment is that there are numerous advantages to packaging functions on derived types with the definitions of those derived types in a single module - hence the need for "contains", for which you did not see much appeal. The module then becomes very similar to a "class" of object-oriented languages. Of course, it is easy to work without using these features, but I do think these language features make for easier management of code and structuring of libraries. |
|
Back to top |
|
 |
|
|
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|