File: RELATIVE:/../../../mfix.git/model/machine_mod.f

1           MODULE machine
2     
3     
4     !      Use param
5     !      Use param1
6     
7     
8     !              record length used in open statement for unformatted,
9     !              direct access file, with 512 bytes per record
10           INTEGER  OPEN_N1
11     !
12     !              number of DOUBLE PRECISION words in 512 bytes
13           INTEGER  NWORDS_DP
14     !
15     !              number of REAL words in 512 bytes
16           INTEGER  NWORDS_R
17     !
18     !              number of INTEGER words in 512 bytes
19           INTEGER  NWORDS_I
20     !
21           LOGICAL :: JUST_FLUSH = .TRUE.
22     
23     ! computer node name/id
24           CHARACTER(LEN=64) :: ID_NODE
25     
26     ! RUN ID info
27           INTEGER :: ID_MONTH
28           INTEGER :: ID_DAY
29           INTEGER :: ID_YEAR
30           INTEGER :: ID_HOUR
31           INTEGER :: ID_MINUTE
32           INTEGER :: ID_SECOND
33     
34         CONTAINS
35     
36     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
37     !                                                                      C
38     !  Module name: MACHINE_CONS                                           C
39     !  Purpose: set the machine constants    ( SGI ONLY )                  C
40     !                                                                      C
41     !  Author: P. Nicoletti                               Date: 28-JAN-92  C
42     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date:            C
43     !                                                                      C
44     !  Revision Number:                                                    C
45     !  Purpose:                                                            C
46     !  Author:                                            Date: dd-mmm-yy  C
47     !  Reviewer:                                          Date: dd-mmm-yy  C
48     !                                                                      C
49     !  Literature/Document References:                                     C
50     !                                                                      C
51     !  Variables referenced: None                                          C
52     !  Variables modified: OPEN_N1, NWORDS_DP, NWORDS_R, N_WORDS_I         C
53     !                                                                      C
54     !  Local variables: None                                               C
55     !                                                                      C
56     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
57     !
58           SUBROUTINE MACHINE_CONS
59     
60           IMPLICIT NONE
61     
62           OPEN_N1   = 512
63           NWORDS_DP =  64
64           NWORDS_R  = 128
65           NWORDS_I  = 128
66           JUST_FLUSH = .TRUE.
67     
68           RETURN
69           END SUBROUTINE MACHINE_CONS
70     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
71     !                                                                      C
72     !  Module name: GET_RUN_ID                                             C
73     !  Purpose: get the run id for this run                                C
74     !                                                                      C
75     !  Author: P. Nicoletti                               Date: 16-DEC-91  C
76     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date:            C
77     !                                                                      C
78     !  Revision Number: 1                                                  C
79     !  Purpose: add ndoe name                                              C
80     !  Author: P.Nicoletti                                Date: 07-FEB-92  C
81     !  Reviewer:                                          Date: dd-mmm-yy  C
82     !                                                                      C
83     !  Literature/Document References:                                     C
84     !                                                                      C
85     !  Variables referenced: None                                          C
86     !  Variables modified: ID_MONTH, ID_DAY, ID_YEAR, ID_HOUR, ID_MINUTE   C
87     !                      ID_SECOND, ID_NODE                              C
88     !                                                                      C
89     !  Local variables: TIME_ARRAY                                         C
90     !                                                                      C
91     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
92     !
93           SUBROUTINE GET_RUN_ID
94     !
95           USE param
96           IMPLICIT NONE
97     !
98     !             temporary array to hold time data
99           INTEGER DAT(8)
100           CHARACTER(LEN=10) DATE, TIM, ZONE
101     
102           CALL DATE_AND_TIME(DATE, TIM, ZONE, DAT)
103           ID_YEAR   = DAT(1)
104           ID_MONTH  = DAT(2)
105           ID_DAY    = DAT(3)
106           ID_HOUR   = DAT(5)
107           ID_MINUTE = DAT(6)
108           ID_SECOND = DAT(7)
109     
110     !     For SGI only
111     !      CALL GETHOSTNAME(ID_NODE,64)
112     !     For Linux with Portland Group compilers
113           CALL GET_ENVIRONMENT_VARIABLE('HOSTNAME',ID_NODE)
114     !
115           RETURN
116           END SUBROUTINE GET_RUN_ID
117     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
118     !                                                                      C
119     !  Function name: WALL_TIME (CPU)                                      C
120     !  Purpose: returns wall time since start of the run                   C
121     !                                                                      C
122     !  Author: P. Nicoletti                               Date: 10-JAN-92  C
123     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date:            C
124     !                                                                      C
125     !  Revision Number:                                                    C
126     !  Purpose:                                                            C
127     !  Author:                                            Date: dd-mmm-yy  C
128     !  Reviewer:                                          Date: dd-mmm-yy  C
129     !                                                                      C
130     !  Literature/Document References:                                     C
131     !                                                                      C
132     !  Variables referenced: None                                          C
133     !  Variables modified: None                                            C
134     !                                                                      C
135     !  Local variables: TA, XT                                             C
136     !                                                                      C
137     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
138     !
139           DOUBLE PRECISION FUNCTION WALL_TIME()
140     !
141           IMPLICIT NONE
142     
143           INTEGER, SAVE :: COUNT_OLD=0, WRAP=0
144     !
145     ! local variables
146     !                       clock cycle
147           INTEGER           COUNT
148     
149     !                       number of cycles per second
150           INTEGER           COUNT_RATE
151     
152     !                       max number of cycles, after which count is reset to 0
153           INTEGER           COUNT_MAX
154     
155           CALL SYSTEM_CLOCK(COUNT, COUNT_RATE, COUNT_MAX)
156           IF(COUNT_OLD .GT. COUNT) THEN
157             WRAP = WRAP + 1
158           ENDIF
159           COUNT_OLD = COUNT
160     
161           WALL_TIME      = DBLE(COUNT)/DBLE(COUNT_RATE) &
162                          + DBLE(WRAP) * DBLE(COUNT_MAX)/DBLE(COUNT_RATE)
163           END FUNCTION WALL_TIME
164     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
165     !                                                                      C
166     !  Module name: START_LOG                                              C
167     !  Purpose: does nothing ... for VAX/VMS compatibility (SGI ONLY)      C
168     !                                                                      C
169     !  Author: P. Nicoletti                               Date: 28-JAN-92  C
170     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date:            C
171     !                                                                      C
172     !  Revision Number:                                                    C
173     !  Purpose:                                                            C
174     !  Author:                                            Date: dd-mmm-yy  C
175     !  Reviewer:                                          Date: dd-mmm-yy  C
176     !                                                                      C
177     !  Literature/Document References:                                     C
178     !                                                                      C
179     !  Variables referenced: None                                          C
180     !  Variables modified: None                                            C
181     !                                                                      C
182     !  Local variables: None                                               C
183     !                                                                      C
184     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
185     !
186           SUBROUTINE START_LOG
187           IMPLICIT NONE
188           RETURN
189           END SUBROUTINE START_LOG
190     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
191     !                                                                      C
192     !  Module name: END_LOG                                                C
193     !  Purpose: flushes the log file                                       C
194     !                                                                      C
195     !  Author: P. Nicoletti                               Date: 28-JAN-92  C
196     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date:            C
197     !                                                                      C
198     !  Revision Number:                                                    C
199     !  Purpose:                                                            C
200     !  Author:                                            Date: dd-mmm-yy  C
201     !  Reviewer:                                          Date: dd-mmm-yy  C
202     !                                                                      C
203     !  Literature/Document References:                                     C
204     !                                                                      C
205     !  Variables referenced: None                                          C
206     !  Variables modified: None                                            C
207     !                                                                      C
208     !  Local variables: None                                               C
209     !                                                                      C
210     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
211     !
212           SUBROUTINE END_LOG
213           USE funits
214           IMPLICIT NONE
215           IF(DMP_LOG) FLUSH(UNIT_LOG)
216           RETURN
217           END SUBROUTINE END_LOG
218     
219           subroutine slumber
220           return
221           end subroutine slumber
222     
223           subroutine pc_quickwin
224           return
225           end subroutine pc_quickwin
226     
227           subroutine ran
228           return
229           end subroutine ran
230     
231           subroutine flush_bin(iunit)
232           implicit none
233           integer :: iunit
234     
235           flush(iunit)
236           return
237           end subroutine flush_bin
238     
239           subroutine flush_res(iunit)
240           implicit none
241           integer :: iunit
242           flush(iunit)
243           return
244           end subroutine flush_res
245     
246           END MODULE machine
247