← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to util/bench/whetstone/nosci.for

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
util/bench/whetstone/nosci.for
 
1
C @(#)nosci.for 19.1 (ES0-DMD) 02/25/03 14:36:00
 
2
C===========================================================================
 
3
C Copyright (C) 1995 European Southern Observatory (ESO)
 
4
C
 
5
C This program is free software; you can redistribute it and/or 
 
6
C modify it under the terms of the GNU General Public License as 
 
7
C published by the Free Software Foundation; either version 2 of 
 
8
C the License, or (at your option) any later version.
 
9
C
 
10
C This program is distributed in the hope that it will be useful,
 
11
C but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
C GNU General Public License for more details.
 
14
C
 
15
C You should have received a copy of the GNU General Public 
 
16
C License along with this program; if not, write to the Free 
 
17
C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
 
18
C MA 02139, USA.
 
19
C
 
20
C Corresponding concerning ESO-MIDAS should be addressed as follows:
 
21
C       Internet e-mail: midas@eso.org
 
22
C       Postal address: European Southern Observatory
 
23
C                       Data Management Division 
 
24
C                       Karl-Schwarzschild-Strasse 2
 
25
C                       D 85748 Garching bei Muenchen 
 
26
C                       GERMANY
 
27
C===========================================================================
 
28
C
 
29
c       "nosci" and "noscf" are nosc routines which
 
30
c       write run timing results to file "{directory_name}results"
 
31
c       in the current directory.  The environment
 
32
c       file "../environ",  containing the compiler
 
33
c       names and options, is copied to "*results",
 
34
c       along with any local "environ" file.  This local
 
35
c       "environ" defines info unique to the individual
 
36
c       benchmark , e.g. hspice.  The current date and 
 
37
c       wall clock time is also written to "*results".
 
38
c       The Timings are then referenced to our "baseline" machine.
 
39
c
 
40
c       The "*results" file is always appended to which
 
41
c       gives a benchmark history for this benchmark
 
42
c       using different compiler options.
 
43
c
 
44
c
 
45
c       "iu" is unit to use when writing to "*results".
 
46
c       Unit "iu+1" is also used to read in "environ" and "baseline" 
 
47
c       files.
 
48
c
 
49
c       Usage: call nosci(iu)           Initalize "results" file.
 
50
c              call noscf()             Finalize "results".
 
51
c
 
52
 
 
53
 
 
54
        subroutine nosci(iu)
 
55
c         This should be the 1st thing the program does!
 
56
c         set up file "results" and initialize timing
 
57
 
 
58
        character*24 fdate
 
59
        character*10 envir
 
60
        character line*80,path*80
 
61
        character *16 group,name
 
62
        character *25 results
 
63
        real t1(2),t2(2)
 
64
        external fdate
 
65
        save iout,t1,group
 
66
        iout=iu
 
67
c
 
68
c       get directory name
 
69
        call getcwd(path)
 
70
        i=1
 
71
c       strip path name from directory
 
72
        last=index(path,' ')-1
 
73
        do 40 j=1,6
 
74
          ii=index(path(i:last),'/')
 
75
          if(ii.lt.1)go to 45
 
76
          i=i+ii
 
77
40      continue
 
78
45      continue
 
79
        results=path(i:last)//'results'
 
80
c
 
81
c       open the 'results' file and position to end of file.
 
82
c       if file not there, create it.
 
83
c
 
84
        
 
85
        open(iout,file=results,status='old',err=20)
 
86
c       file exists - position to end of file
 
87
5       read(iout,*,end=30,err=5) line(1:1)
 
88
        go to 5
 
89
c       'results' doesn't exist - open new file
 
90
20      open(iout,file=results,status='new',err=300)
 
91
        call chmod(results,'ugo+rw')
 
92
30      continue
 
93
        write(iout,*)'*********************************'
 
94
        write(iout,*)path(i:last),'  ',fdate()
 
95
        group=path(i:last)
 
96
        in=iout + 1
 
97
c       copy "../environ" and "./environ" (if one exists)
 
98
c       files to "./*results" file
 
99
        envir = 'environ'
 
100
        ie = 1
 
101
        do 55 i=1,2
 
102
          open(in,file=envir(ie:10),status='old',err=55)
 
103
47        read(in,49,end=50)line
 
104
49        format(a80)
 
105
          write(iout,*)line
 
106
          go to 47
 
107
50        close(in,err=65)
 
108
55        ie=4
 
109
60      call etime(t1)
 
110
65      return
 
111
c
 
112
c
 
113
c       ****************** NOSCF ***********************        
 
114
        entry noscf()
 
115
c       This should be the last thing the program does!
 
116
c       get elapsed time for run and write to "*results"
 
117
        call etime(t2)
 
118
        u=t2(1)-t1(1)
 
119
        s=t2(2)-t1(2)
 
120
        t=u+s
 
121
        write(iout,*)'Total elapsed time (sec) =',t,' system  ='
 
122
     *  ,s,' user =',u
 
123
c
 
124
c       ***********************************************
 
125
c       reference to baseline   '../baseline'
 
126
        in=iout+1
 
127
        open (in,file='../baseline',status='old',err=90)
 
128
80      read(in,*,end=90,err=90)name,bt,bs,bu
 
129
        if (name.ne.group)go to 80
 
130
        bt1=0.
 
131
        bs1=0.
 
132
        bu1=0.
 
133
        if(t.ne.0.) bt1=bt/t
 
134
        if(s.ne.0.) bs1=bs/s
 
135
        if(u.ne.0.) bu1=bu/u
 
136
        write(iout,*)'BASELINED   total =',bt1,'  system =',bs1,
 
137
     1               '  user =',bu1
 
138
90      return
 
139
 
 
140
c         Come here on errors!
 
141
300     continue
 
142
c       call perror('nosci error')
 
143
        end