SUBROUTINE mail2 ( address )
  implicit none
  CHARACTER*(*) address
  integer k, urlbegin, urlende, urllength
  
  urlbegin=0
  
  ! Suche nach dem @ in der URL
  do k=1, LEN(address)
    if (address(k:k) == '@') then
      urlbegin = k
      EXIT
    endif    
  enddo
  
  ! es wurde nicht oder an der 1. Stelle gefunden
  if (urlbegin==1) then
    stop "@ steht an der ersten Stelle, oder wurde nicht gefunden"
  endif
  
  ! Berechnung des Beginns / Ende der URL im String
  urlbegin=urlbegin+1
  urlende = LEN_TRIM(address)
  urllength = (urlende-urlbegin+1)
  
  ! Kopieren der URL an den Anfang und auffüllen mit Leerzeichen
  address(1:urllength) = address(urlbegin:urlende)
  address(urllength+1:LEN(address)) = ' '
END SUBROUTINE

SUBROUTINE mail ( address )
  implicit none
  CHARACTER*(*) address
  INTEGER k, urlbegin, urlende,urllength
  
  urlbegin = index (address, "@", .TRUE.) +1
  
  if (urlbegin <= 0) then
    stop "@ wurde nicht gefunden"
  endif
  
  urlende = LEN_TRIM(address)
  urllength = (urlende-urlbegin+1)
  
  address(1:urllength) = address(urlbegin:urlende)
  address(urllength+1:LEN(address)) = ' '
END SUBROUTINE

program main
  implicit none
  CHARACTER*32 :: m = "fortran@proggen.org"
  CHARACTER*32 :: m2 = "fortran@proggen.org"
  
  write (*,*) len_trim(m), m
  call mail ( m )
  write (*,*) len_trim(m), m
  
  write (*,*) len_trim(m2), m2
  call mail2 ( m2 )
  write (*,*) len_trim(m2), m2
end program