Wrapper around Fortran open of files to take care of errors and improve the error message in case the opening goes wrong.
Use newunit to let tem_open provide a new file unit for the opened file.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | file | |||
integer, | intent(in), | optional | :: | unit | ||
integer, | intent(out), | optional | :: | newunit | ||
character(len=*), | intent(in), | optional | :: | status | ||
character(len=*), | intent(in), | optional | :: | position | ||
character(len=*), | intent(in), | optional | :: | action | ||
character(len=*), | intent(in), | optional | :: | form | ||
character(len=*), | intent(in), | optional | :: | access | ||
integer, | intent(in), | optional | :: | recl |
subroutine tem_open(file, unit, newunit, status, position, action, form, & & access, recl) character(len=*), intent(in) :: file character(len=*), intent(in), optional :: status character(len=*), intent(in), optional :: position character(len=*), intent(in), optional :: action character(len=*), intent(in), optional :: form character(len=*), intent(in), optional :: access integer, intent(in), optional :: recl integer, intent(in), optional :: unit integer, intent(out), optional :: newunit ! -------------------------------------------------------------------- ! character(len=labelLen) :: loc_status character(len=labelLen) :: loc_position character(len=labelLen) :: loc_action character(len=labelLen) :: loc_form character(len=labelLen) :: loc_access integer :: stat integer :: funit ! -------------------------------------------------------------------- ! ! Defaults: loc_status = 'unknown' loc_position = 'asis' loc_action = 'readwrite' loc_form = 'formatted' loc_access = 'sequential' if (present(status)) loc_status = upper_to_lower(status) if (present(position)) loc_position = upper_to_lower(position) if (present(action)) loc_action = upper_to_lower(action) if (present(access)) loc_access = upper_to_lower(access) ! Stream IO is by default unformatted. if (loc_access == 'stream') loc_form = 'unformatted' if (present(form)) loc_form = upper_to_lower(form) if (present(unit)) then funit = unit else funit = env_nu() if (present(newunit)) then newunit = funit end if end if rl_provided: if (present(recl)) then pos_provided: if (present(position)) then open( unit = funit, & & file = file, & & action = trim(loc_action), & & access = loc_access, & & status = loc_status, & & position = loc_position, & & form = loc_form, & & recl = recl, & & iostat = stat ) else pos_provided open( unit = funit, & & file = file, & & action = trim(loc_action), & & access = loc_access, & & status = loc_status, & & form = loc_form, & & recl = recl, & & iostat = stat ) end if pos_provided else rl_provided seqpos: if ( (loc_access == 'sequential') .and. present(position)) then open( unit = funit, & & file = file, & & action = trim(loc_action), & & access = loc_access, & & status = loc_status, & & position = loc_position, & & form = loc_form, & & iostat = stat ) else seqpos open( unit = funit, & & file = file, & & action = trim(loc_action), & & access = loc_access, & & status = loc_status, & & form = loc_form, & & iostat = stat ) end if seqpos end if rl_provided if (stat /= 0) then write(logUnit(1), *) 'Could not open file!' write(logUnit(1), *) 'iostat=', stat write(logUnit(1), *) 'File: ' // trim(file) if (present(action)) write(logUnit(1), *) 'Action: ' // trim(action) if (present(form)) write(logUnit(1), *) 'Form: ' // trim(form) if (present(access)) write(logUnit(1), *) 'Access: ' // trim(access) if (present(status)) write(logUnit(1), *) 'Status: ' // trim(status) if (present(recl)) write(logUnit(1), *) 'Recl: ', recl if (present(position)) write(logUnit(1), *) 'Position: ' // trim(position) write(logUnit(1), *) 'Aborting...' call tem_abort() end if end subroutine tem_open