replica nfl jerseysreplica nfl jerseyssoccer jerseyreplica nfl jerseys forums.silverfrost.com :: View topic - Compiling and linking taking too long!
forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Compiling and linking taking too long!

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
pban92



Joined: 23 Nov 2009
Posts: 38

PostPosted: Fri May 13, 2011 12:52 pm    Post subject: Compiling and linking taking too long! Reply with quote

Previously my program compiled and linked very fast. But for unknown reasons, now this is taking ages. What usually causes such lengthy compiling and linking? Pls comment. Here is the code,





Code:

PROGRAM corespectra
IMPLICIT NONE

INTEGER::n,seqnum,ierr,length
DOUBLE PRECISION::avg
DOUBLE PRECISION,DIMENSION(11000000)::vdata,nvdata,fluctuation,histdata
DOUBLE PRECISION,DIMENSION(4*4096)::core
DOUBLE PRECISION,DIMENSION(8*8192)::data
CHARACTER (LEN=11)::seqfilein
length = 2048
ierr = 0                                          
seqfilein = 'caseXXX.fil'
DO seqnum = 940,942   
WRITE(seqfilein(5:7),'(I3.3)')seqnum
WRITE(*,*)seqfilein
OPEN (UNIT=10,FILE=seqfilein,STATUS='OLD',ACTION='READ',IOSTAT=ierr)
CALL READDATA(vdata,n,seqfilein)
CALL MEAN(vdata,avg,n,seqfilein)
CALL VFLUCTUATION(vdata,avg,n,fluctuation,seqfilein)
CALL AUTOCORRELATION(fluctuation,n,length,core,seqfilein)
CLOSE(UNIT=10)
ENDDO
STOP
END

Back to top
View user's profile Send private message
pban92



Joined: 23 Nov 2009
Posts: 38

PostPosted: Fri May 13, 2011 1:09 pm    Post subject: Reply with quote

Here are the subroutines as they did not fit in one post.

Code:

SUBROUTINE READDATA(y,n,seqfname)
   IMPLICIT NONE
   INTEGER::i,ierr
   INTEGER,INTENT(out)::n
   DOUBLE PRECISION,INTENT(INOUT),DIMENSION(n)::y
   CHARACTER(LEN=11),INTENT(IN)::seqfname
   
   ierr = 0
   OPEN (UNIT=3, FILE=seqfname, STATUS='OLD', ACTION='READ', IOSTAT=ierr)
      DO i = 1, size(y)
         READ (3,*,IOSTAT=ierr) y(i) 
         if (ierr /=0) exit
   END DO
    n=i-1
   CLOSE (UNIT = 3)

RETURN
END SUBROUTINE

!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
SUBROUTINE MEAN(vdata,avg,n,seqfileout)
   IMPLICIT NONE
   INTEGER :: i, ierr
   DOUBLE PRECISION :: sum1
   INTEGER, INTENT(IN) :: n
   DOUBLE PRECISION, INTENT(IN), DIMENSION(n) :: vdata
   DOUBLE PRECISION, INTENT(OUT) :: avg
    CHARACTER(LEN=11),INTENT(IN)::seqfileout
    CHARACTER (LEN=11)::seqfout   
   ierr = 0
   seqfout = seqfileout(1:7)   
   sum1 = 0
   DO i = 1, n
   sum1 = sum1 + vdata(i)
   END DO
   avg = sum1/REAL(n)
RETURN
END SUBROUTINE

!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

SUBROUTINE VFLUCTUATION (vdata,avg,n,fluctuation,seqfileout)
   IMPLICIT NONE
   INTEGER,INTENT(in):: n
   DOUBLE PRECISION,INTENT(in)::avg
   DOUBLE PRECISION,DIMENSION(n),INTENT(in)::vdata
   DOUBLE PRECISION,DIMENSION(n),INTENT(out)::fluctuation
   CHARACTER(LEN=11),INTENT(IN)::seqfileout
   CHARACTER(LEN=11)::seqfout   
   INTEGER::i, ierr
   ierr = 0
   seqfout = seqfileout(1:7)                        

     DO i=1,n
   fluctuation(i) = vdata(i)-avg
   ENDDO

RETURN
END SUBROUTINE VFLUCTUATION

!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

SUBROUTINE AUTOCORRELATION(fluctuation,n,length,newcore,seqfileout)
   IMPLICIT NONE
   INTEGER,INTENT(IN)::n,length
   DOUBLE PRECISION,DIMENSION(n),INTENT(IN)::fluctuation
    DOUBLE PRECISION,DIMENSION(length)::core
    DOUBLE PRECISION,DIMENSION(2*length),INTENT(OUT)::newcore
   CHARACTER(LEN=11),INTENT(IN)::seqfileout
   CHARACTER (LEN=11)::seqfout
    INTEGER::i,j, ierr
   DOUBLE PRECISION::container
   
    core = 0.
   ierr = 0
    seqfout = seqfileout(1:7)

   do i=1,length
      do j=1,(n-i)
         core(i)=core(i)+(fluctuation(j)*fluctuation(j+i-1))
      end do
      core(i)=(core(i)/(n-i))
      if (i==1)then
         container=core(1)
      end if
      core(i)=core(i)/container
   end do
do i = 1,length
newcore(i) = core(length-i+1)
end do

do i = 1,length
newcore(length+i) = core(i)
end do
   
OPEN (UNIT=14,FILE=trim(seqfout)//'.crr',STATUS='REPLACE',ACTION='WRITE',IOSTAT=ierr)
DO i = 1,2*length     
WRITE(14,*)(i-length)*0.0001,newcore(i)
ENDDO
CLOSE (UNIT=14)

RETURN
END SUBROUTINE AUTOCORRELATION
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2615
Location: Sydney

PostPosted: Fri May 13, 2011 1:14 pm    Post subject: Reply with quote

do not compile with /check as the .exe file is then 300mb in size.
I'm not sure why it is taking so long to write it out.
If you use /debug then it compiles much quicker.

Also, your use of variable names "core" and "data" is a bit risky as these can be reserved words.
I'd use my_core and my_data, unless you are accessing the FTN95 memory addressing routines ?
Back to top
View user's profile Send private message
pban92



Joined: 23 Nov 2009
Posts: 38

PostPosted: Fri May 13, 2011 1:32 pm    Post subject: Reply with quote

Thanks John! I changed \check and tried with both debug.net and debug win32 without knowing what they exactly do. But the compilation and linking worked really fast! (Now I am wondering if one of these option I used before). Also, thanks for the comment on data and core.
Back to top
View user's profile Send private message
KennyT



Joined: 02 Aug 2005
Posts: 318

PostPosted: Fri May 27, 2011 3:24 pm    Post subject: Reply with quote

Can I just comment that using "modules within modules within..." causes extremely slow compilation as well.

It used to take about 10 minutes to completely rebuild our application, but since we started using modules (within modules...) it now takes over an hour.

Just thought I'd say, in case anyone else has the same experience (or better still, a solution!!!)

K
Back to top
View user's profile Send private message Visit poster's website
JohnHorspool



Joined: 26 Sep 2005
Posts: 270
Location: Gloucestershire UK

PostPosted: Fri May 27, 2011 3:35 pm    Post subject: Reply with quote

Kenny,

With version 6.0.0 under XP 64bit I can compile 280881 lines of source code (probably over 250000 lines of actual code once comments and blank lines are discounted) in less than 25 seconds.

But I do not have any modules at all, common statements work fine for me.

cheers,
John
_________________
John Horspool
Roshaz Software Ltd.
Gloucestershire
Back to top
View user's profile Send private message Visit poster's website
KennyT



Joined: 02 Aug 2005
Posts: 318

PostPosted: Fri May 27, 2011 4:05 pm    Post subject: Reply with quote

Yep, we've got over 50Mb of source code.

One trick we've found is that we can overlap the compilation by using two DOS boxes and compiling about half the app in one and half in the other! Brings it down to about 40mins!

K
Back to top
View user's profile Send private message Visit poster's website
JohnHorspool



Joined: 26 Sep 2005
Posts: 270
Location: Gloucestershire UK

PostPosted: Fri May 27, 2011 4:13 pm    Post subject: Reply with quote

Okay I have only 7.3Mb of source code, but I see no reason while the compile time would not simply scale up linearly.

Cheers,
John
_________________
John Horspool
Roshaz Software Ltd.
Gloucestershire
Back to top
View user's profile Send private message Visit poster's website
KennyT



Joined: 02 Aug 2005
Posts: 318

PostPosted: Fri May 27, 2011 4:19 pm    Post subject: Reply with quote

Oh, it's completely down to having one module "USE"ing a definition from another module file. If I remember correctly, when we just had one set of files with module definitions, none of which "USE"d any of the others, it didn't make much, if any, difference, but as soon as we started building module definitions that "USE"d modules from other files, the compilation speed dropped like the proverbial!

K
Back to top
View user's profile Send private message Visit poster's website
JohnCampbell



Joined: 16 Feb 2006
Posts: 2615
Location: Sydney

PostPosted: Sat May 28, 2011 1:47 am    Post subject: Reply with quote

your comment surprises me.

You could consider redesigning your modules or at least grouping all the related modules in one file.

I've been using modules for at least 10 years, mainly to define my in-memory database and I find the heiractical structure very useful.
I have one for parameters, one for type structures and a number for different aspects of the modelling.

I find it an improvement on common / include files.
Back to top
View user's profile Send private message
KennyT



Joined: 02 Aug 2005
Posts: 318

PostPosted: Wed Apr 10, 2013 4:20 pm    Post subject: Reply with quote

thought i'd "bump" this thread to see if Paul fancied investigating our compilation speed problem...

I'm willing to upload our complete source folders if that will help!

K
Back to top
View user's profile Send private message Visit poster's website
davidb



Joined: 17 Jul 2009
Posts: 560
Location: UK

PostPosted: Wed Apr 10, 2013 5:13 pm    Post subject: Reply with quote

KennyT

What are you using to determine the order of compilation for the Fortran files?

If you are just using a simple command line (DOS) script which compiles files in the correct order then there shouldn't be any dependence on how you have nested your modules as all the compiler does is read the MOD files.

With nested modules, each MOD file should include the interface from any modules it uses, so there shouldn't be any unnecessary repeat reading of these.
_________________
Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl
Back to top
View user's profile Send private message
KennyT



Joined: 02 Aug 2005
Posts: 318

PostPosted: Wed Apr 10, 2013 5:50 pm    Post subject: Reply with quote

Yes, it's just a DOS script that compiles all the "modules" first, then the functional routines afterwards. But we might not be being super efficient in the order in which we compile the functional source files! As an example, one particular file (size 570k about 23000 lines) takes almost 10 minutes to compile on an i7 CPU! It USEs about a dozen different MODules (which themselves USE others, which, in turn...)

K
Back to top
View user's profile Send private message Visit poster's website
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 8210
Location: Salford, UK

PostPosted: Wed Apr 10, 2013 8:29 pm    Post subject: Reply with quote

I noted my name appearing in this thread.
Sorry but I don't fancy this one.

For large projects it is worth considering using an IDE and project with dependency checking or using your own MAKE file for something like MK32.exe. However, you may or may not find that Plato can cope.

The idea being that, during development, you only recompile those files that need to be recompiled because of the dependency chain.
Back to top
View user's profile Send private message AIM Address
KennyT



Joined: 02 Aug 2005
Posts: 318

PostPosted: Wed Apr 10, 2013 10:12 pm    Post subject: Reply with quote

Hi Paul,

I've isolated one source file and the associated MOD files that clearly illustrates the problem, drop me a line if you fancy trying it and I'll zip it up and send it to you.

K
Back to top
View user's profile Send private message Visit poster's website
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
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