forked from HYCOM/HYCOM-src
-
Notifications
You must be signed in to change notification settings - Fork 0
/
machine.F90
97 lines (97 loc) · 1.94 KB
/
machine.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
!
! --- machine-specific Fortran routines
!
subroutine machine()
!
! --- always called once at the start of the program.
!
#if defined(SGI)
call zunder() ! C-wrapper to flush underflow to zero on R10000
#endif
end
#if defined(AIX)
subroutine flush(iunit)
implicit none
integer iunit
!
! --- wrapper for flush system call under AIX.
!
integer*4 iunit4
!
iunit4=iunit
call flush_(iunit4)
return
end
#endif /* AIX */
#if defined(X1)
subroutine x1flush(iunit)
implicit none
integer iunit
!
! --- wrapper for flush system call on the Cray X1.
!
integer ierr
!
call FLUSH(iunit,ierr)
return
end
#endif /* X1 */
#if defined(IFC)
subroutine flush(iunit)
implicit none
integer iunit
!
! --- disable the flush system call under Intel's IFC compiler.
!
return
end
#endif /* IFC */
#if defined(SUN)
subroutine ieee_retrospective()
!
! dummy routine to turn off ieee warning messages on a Sun.
!
end
#endif /* SUN */
#if defined(T3E) || defined(YMP) || defined(X1)
subroutine getenv(cname, cvalue)
implicit none
!
character*(*) cname,cvalue
!
! this subroutine provides getenv functionality
! on the t3e, using pxfgetenv.
!
integer iname,ivalue,ierr
!
iname = 0
ierr = 0
call pxfgetenv(cname,iname, cvalue,ivalue, ierr)
if (ierr.ne.0) then
cvalue = ' '
endif
return
! end of getenv.
end
#endif /* T3E || YMP || X1 */
#if defined(NAGFOR)
subroutine flush(iunit)
implicit none
integer iunit
!
! --- a wrapper for Fortran 2003's FLUSH statement
!
flush(iunit)
return
end
subroutine getenv(cname, cvalue)
implicit none
!
character*(*) cname,cvalue
!
! --- a wrapper for Fortran 2003's GET_ENVIRONMENT_VARIABLE
!
call get_environment_variable(cname,cvalue)
return
end
#endif /* NAGFOR */