! makemodelref.f90
! main program written by Tim Mitchell on 07.12.99
! last modification on 07.12.99
! generates and saves a model .ref file
! f90 -o makemodelref makemodelref.f90

program MakeModelRef

implicit none

integer, dimension (:,:), allocatable 	:: MapIDLRaw
real, dimension (:), allocatable 	:: GridAlignLong, GridAlignLat

character (len=80)	:: FilePath, GivenFile
character (len=10) 	:: Title

integer :: LongN, LatN, DataN
integer	:: XLong, XLat, XDatum
integer :: Lat0, Lat1, LatStep
integer :: Long0, Long1
integer :: LongHalfTime0, LongHalfTime1
integer :: LongSelect, LatSelect
integer :: LatEightN, LongEightN, XEight
integer	:: AllocStat
integer :: NorthSouth		! 1=northwards, 2=southwards
integer :: GreenDate		! start: 1=Greenwich, 2=DateLine
integer :: ReadStatus		! status of input from user
integer :: QType		! which type of ref file to generate

!*******************************************************************************

call Intro
call MakeBasics
call MakeMapIDLRaw
call SaveModelRef
print*

contains

!*******************************************************************************

subroutine Intro

print*
print*, "  > MakeRef: generate a model reference file"
print*

end subroutine Intro

!*******************************************************************************

subroutine MakeBasics

do
	do
		print*, "  > Enter the FILEPATH of the model file: "
		read (*,*,iostat=ReadStatus), GivenFile
		if (ReadStatus.LE.0) exit
	end do
	
	inquire (file=GivenFile, name=FilePath)
	open (1, file=FilePath, status="new", iostat=ReadStatus)
	if (ReadStatus .EQ. 0) close (1)
	if (ReadStatus .EQ. 0) exit
end do

do
	print*, "  > Enter the NAME of the model: "
	read (*,*,iostat=ReadStatus), Title
	if (ReadStatus.LE.0 .AND. Title.NE."") exit
end do
	
do
	print*, "  > Enter the no. of LONG and LAT cells: "
	read (*,*,iostat=ReadStatus), LongN, LatN
	if (ReadStatus.LE.0 .AND. (LongN*LatN).GT.1) exit
end do
	
DataN = LongN * LatN

allocate (MapIDLRaw (LongN, LatN), GridAlignLong (LongN), GridAlignLat (LatN), &
		stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: allocation failure #####"

end subroutine MakeBasics

!*******************************************************************************

subroutine MakeMapIDLRaw

print*, "  > Model grid details: "
do
	print*, "  >   northwards (=1) or southwards (=2) ? "
	read (*,*,iostat=ReadStatus), NorthSouth
	if (ReadStatus.LE.0 .AND. NorthSouth.GE.1 .AND. NorthSouth.LE.2) exit
end do
do
	print*, "  >   start: Greenwich (=1) or DateLine (=2) ? "
	read (*,*,iostat=ReadStatus), GreenDate
	if (ReadStatus.LE.0 .AND. GreenDate.GE.1 .AND. GreenDate.LE.2) exit
end do

							! fill MapIDLRaw array
if (NorthSouth.EQ.1) then
  Lat0 = 1 	; Lat1 = LatN 	; LatStep = 1
else
  Lat0 = LatN 	; Lat1 = 1	; LatStep = -1
end if

if (GreenDate.EQ.2) then
  Long0 = 1 			; Long1 = LongN
  LongHalfTime0 = (LongN/2) 	; LongHalfTime1 = LongHalfTime0 + 1
else
  Long1 = (LongN/2) 		; Long0 = Long1 + 1
  LongHalfTime0 = LongN 	; LongHalfTime1 = 1
end if

XDatum = 1

do XLat = Lat0, Lat1, LatStep
  do XLong = Long0, LongHalfTime0
    MapIDLRaw (XLong, XLat) = XDatum
    XDatum = XDatum + 1
  end do
  do XLong = LongHalfTime1, Long1
    MapIDLRaw (XLong, XLat) = XDatum
    XDatum = XDatum + 1
  end do
end do

end subroutine MakeMapIDLRaw

!*******************************************************************************

subroutine SaveModelRef

open (4, file=FilePath, status="replace", access="sequential", action="write")

write (4, fmt="(A10)"), 	Title
write (4, fmt="(2(I4),I6)"),	LongN, LatN, DataN

LongEightN = LongN / 8
LatEightN  = LatN  / 8

do XLat = 1, LatN
  do XEight = 1, LongEightN
    Long0 = ((XEight - 1) * 8) + 1
    Long1 =  Long0 + 7
    write (4, fmt="(8(I6))"), MapIDLRaw (Long0:Long1,XLat)
  end do
end do

close (4)

end subroutine SaveModelRef

!*******************************************************************************

end program MakeModelRef