INTEGER FUNCTION GETFILE( NAME, DO_OPEN, FORM, ALL_PES, &
BLOCKSIZE, NUMBUFFERS, RC )
IMPLICIT NONE
character(LEN=*), intent(in ) :: Name
integer , intent(in ), OPTIONAL :: DO_OPEN
character(LEN=*), intent(in ), OPTIONAL :: Form
logical , intent(in ), OPTIONAL :: ALL_PES
integer , intent(in ), OPTIONAL :: BLOCKSIZE
integer , intent(in ), OPTIONAL :: NUMBUFFERS
integer , intent( out), OPTIONAL :: RC
INTEGER I
integer :: DO_OPEN_
logical :: ALL_PES_
integer :: status
LOGICAL FILEOPEN, UNITOPEN, FOUND
if(INDEX(NAME,'*') /= 0) then
getfile = getfilemem(name,rc=status)
_VERIFY(STATUS)
_RETURN(ESMF_SUCCESS)
endif
if (NAME == "stdout" .or. NAME== "STDOUT") then
GETFILE = STD_OUT_UNIT_NUMBER
_RETURN(ESMF_SUCCESS)
end if
if (.not. present(DO_OPEN)) then
DO_OPEN_ = 1
else
DO_OPEN_ = DO_OPEN
end if
ALL_PES_ = .false.
if (present(ALL_PES)) then
ALL_PES_ = ALL_PES
end if
if (.not. MAPL_AM_I_ROOT() .and. .not. ALL_PES_) then
GETFILE = UNDEF
_RETURN(ESMF_SUCCESS)
end if
! Check if the file is already open
INQUIRE ( FILE=NAME, NUMBER=GETFILE, OPENED=FILEOPEN )
! If the file isnt already open THEN
IF ( .NOT. FILEOPEN ) THEN
I = 20
FOUND = .FALSE.
DO WHILE ( I.LE.LAST_UNIT .AND. .NOT.FOUND )
IF ( .NOT. TAKEN(I) ) THEN
TAKEN(I) = .TRUE.
INQUIRE ( UNIT=I, OPENED=UNITOPEN )
IF ( .NOT. UNITOPEN ) THEN
status = 0
if ( DO_OPEN_ .NE. 0 ) then
call MAPL_open(UNIT=i,FILE=Name,FORM=FORM, &
BLOCKSIZE= BLOCKSIZE, NUMBUFFERS=NUMBUFFERS, RC=STATUS)
endif
if ( status /= 0 ) then
write (0,*) 'ERROR opening "',trim(Name),'" using GETFILE'
write (0,*) ' IOSTAT = ',status
_RETURN(ESMF_FAILURE)
endif
GETFILE = I
FOUND = .TRUE.
ENDIF
ENDIF
I = I + 1
ENDDO
!
! IF there are no available logical units THEN
! Write an error message
! Return Error status
! ENDIF there are no available logical units
!
IF ( .NOT. FOUND ) THEN
WRITE (0,*) ' COULD NOT FIND ANY AVAILABLE UNITS '
_RETURN(ESMF_FAILURE)
ENDIF
ENDIF ! the file isnt already open
_RETURN(ESMF_SUCCESS)
END FUNCTION GETFILE