program calendar

  integer :: iconv
  
  print *, "=============================================="
  print *, "           Simple Calendar Conversion         "
  print *, "=============================================="
  print *, "  Hijri(Islamic Calendar) <-> Solar Calendar  "
  print *, "----------------------------------------------"
  print *, "  CAUTION: There is the Islamic Date Line     "
  print *, "  which causes this calculation may differ    "
  print *, "  about (+/-) 1 day                           "
  print *, "----------------------------------------------"
  print *, "  Original version : 6 August 1991            "
  print *, "  Programmer       : T. Djamaluddin           "
  print *, "  Dept. of Astronomy, Kyoto University        "
  print *, "----------------------------------------------"
  print *, "  Fortran version  : 18 August 2012           "
  print *, "  Programmer       : ART Nugraha              "
  print *, "  Dept. of Physics, Tohoku University         "
  print *, "----------------------------------------------"

1 print *

  print *, "Options:"
  print *, "1. Hijri to Solar Calendar"
  print *, "2. Solar to Hijri Calendar"

  print *

  print "(a\)", "Choose 1 or 2 (0 to exit): "; read *, iconv

  select case(iconv)
     case(1)
        call hijriToSolarMenu()
     case(2)
        call solarToHijriMenu()
     case default
        stop "Bye!"
  end select
  
  goto 1

contains

!====================================================================!
  subroutine hijriToSolarMenu()
!--------------------------------------------------------------------!
    integer :: ihd, ihm, ihy, isd, ism, isy
    character(20) :: csm

	print *
    print *, "----------------------------------------------"
    print *, "   Conversion from Hijri to Solar Calendar    "
    print *, "----------------------------------------------"

    print *

    print "(a\)", "Hijri date : "; read *, ihd
    print *

    print *, "1. Muharram      5. Jumadil Awwal   9. Ramadhan"
    print *, "2. Safar         6. Jumadil Akhir  10. Syawwal"
    print *, "3. Rabiul Awwal  7. Rajab          11. Dzulqaidah"
    print *, "4. Rabiul Akhir  8. Syaban         12. Dzulhijjah"

    print "(a\)", "Hijri month: "; read *, ihm
    print "(a\)", "Hijri year : "; read *, ihy
  
    call hijriToSolarCalc(ihd,ihm,ihy,isd,ism,isy)
    select case(ism)
       case(1)
          csm = "January"
       case(2)
          csm = "February"
       case(3)
          csm = "March"
       case(4)
          csm = "April"
       case(5)
          csm = "May"
       case(6)
          csm = "June"
       case(7)
          csm = "July"
       case(8)
          csm = "August"
       case(9)
          csm = "September"
       case(10)
          csm = "October"
       case(11)
          csm = "November"
       case(12)
          csm = "December"
       case default
          stop "Solar month number is out of range!"
    end select

    print *
	print "(a)", "Result: "
    print 101, ihd, "/", ihm, "/", ihy, " Hijri is "
    print 102, isd, "/", ism, "/", isy, " A.D. " , "(", trim(csm), ")"

101 format(i3,a,i2,a,i4,10a\)
102 format(i3,a,i2,a,i4,6a,a,a,a)
  end subroutine hijriToSolarMenu

!====================================================================!
  subroutine hijriToSolarCalc(ihd,ihm,ihy,isd,ism,isy)
!--------------------------------------------------------------------!
  ! Converts a given Hijri date to Solar date   
 
    integer, intent(in)  :: ihd, ihm, ihy
    integer, intent(out) :: isd, ism, isy

    integer :: nhd, gc, mn, mn1
    real    :: rhd, rsd

    rhd = (ihy - 1) * 354.3671 + (ihm - 1) * 29.5306 + ihd
    nhd = int(rhd)
    rsd = rhd + 227016
    
    if (nhd > 350721) then
       gc = 10
    else
       gc = 0
    end if
    
    if (nhd > 393898) gc = 11
    if (nhd > 430422) gc = 12
    if (nhd > 466946) gc = 13

    isy = int( (rsd + gc)/365.25 ) + 1
    mn = nint( rsd + gc - (isy - 1)*365.25 )
 
    mn1 = 0
    ism = 1

    if (mn > 31) then
       mn1 = 31
       ism = 2
    end if

    if (int(isy/4) == isy/4) then
       call leapYear(mn,mn1,ism)
    else
       call ordinaryYear(mn,mn1,ism)
    end if

    if (isy == 1700 .or. isy == 1800) then
       call ordinaryYear(mn,mn1,ism)
    end if

    if (isy == 1900) then
       call ordinaryYear(mn,mn1,ism)
    end if

    isd = int(mn - mn1)

  end subroutine hijriToSolarCalc

!====================================================================     
  subroutine leapYear(mn,mn1,ism)
!--------------------------------------------------------------------
  ! Leap (Kabisat) Year

    integer :: mn, mn1, ism

    if (mn > 335) then
       mn1 = 335
       ism = 12
    else if (mn > 305) then
       mn1 = 305
       ism = 11
    else if (mn > 274) then
       mn1 = 274
       ism = 10
    else if (mn > 244) then
       mn1 = 244
       ism = 9
    else if (mn > 213) then
       mn1 = 213
       ism = 8
    else if (mn > 182) then
       mn1 = 182
       ism = 7
    else if (mn > 152) then
       mn1 = 152
       ism = 6
    else if (mn > 121) then
       mn1 = 121
       ism = 5
    else if (mn > 91) then
       mn1 = 91
       ism = 4
    else if (mn > 60) then
       mn1 = 60
       ism = 3
    else
       stop "Error in subroutine leapYear!"
    end if

  end subroutine leapYear

!====================================================================!
  subroutine ordinaryYear(mn,mn1,ism)
!--------------------------------------------------------------------!
  ! Ordinary (Basitah) Year

    if (mn > 334) then
       mn1 = 334
       ism = 12
    else if (mn > 304) then
       mn1 = 304
       ism = 11
    else if (mn > 273) then
       mn1 = 273
       ism = 10
    else if (mn > 243) then
       mn1 = 243
       ism = 9
    else if (mn > 212) then
       mn1 = 212
       ism = 8
    else if (mn > 181) then
       mn1 = 181
       ism = 7
    else if (mn > 151) then
       mn1 = 151
       ism = 6
    else if (mn > 120) then
       mn1 = 120
       ism = 5
    else if (mn > 90) then
       mn1 = 90
       ism = 4
    else if (mn > 59) then
       mn1 = 59
       ism = 3
    else
       stop "Error in subroutine ordinaryYear!"
    end if

  end subroutine ordinaryYear

!====================================================================
  subroutine solarToHijriMenu()
!--------------------------------------------------------------------

    integer :: isd, ism, isy, ihd, ihm, ihy
    character(20) :: chm

    print *
    print *, "----------------------------------------------"
    print *, "   Conversion from Solar to Hijri Calendar    "
    print *, "----------------------------------------------"

    print *

    print "(a\)", "Solar date : "; read *, isd
    print *
    print *, "1. January   5. May      9. September"
    print *, "2. February  6. June    10. October"
    print *, "3. March     7. July    11. November"
    print *, "4. April     8. August  12. December"

    print "(a\)", "Solar month: "; read *, ism
    print "(a\)", "Solar year : "; read *, isy
  
    call solarToHijriCalc(isd,ism,isy,ihd,ihm,ihy)
    select case(ihm)
       case(0)
          chm = "Dzulhijjah"
          ihy = ihy - 1
       case(1)
          chm = "Muharram"
       case(2)
          chm = "Safar"
       case(3)
          chm = "Rabiul Awwal"
       case(4)
          chm = "Rabiul Akhir"
       case(5)
          chm = "Jumadil Awwal"
       case(6)
          chm = "Jumadil Akhir"
       case(7)
          chm = "Rajab"
       case(8)
          chm = "Syaban"
       case(9)
          chm = "Ramadhan"
       case(10)
          chm = "Syawwal"
       case(11)
          chm = "Dzulqaidah"
       case(12)
          chm = "Dzulhijjah"
       case default
          stop "Hijri month number is out of range!"
    end select

    print *
    print "(a)", "Result: "
    print 201, isd, "/", ism, "/", isy, " A.D. is "
    print 202, ihd, "/", ihm, "/", ihy, " Hijri " , "(", trim(chm), ")"

201 format(i3,a,i2,a,i4,9a\)
202 format(i3,a,i2,a,i4,7a,a,a,a)
  end subroutine solarToHijriMenu

!====================================================================!
  subroutine solarToHijriCalc(isd,ism,isy,ihd,ihm,ihy)
!--------------------------------------------------------------------!
  ! Converts a given Solar date to Hijri date   
 
    integer, intent(in)  :: isd, ism, isy
    integer, intent(out) :: ihd, ihm, ihy

    integer :: mn, hm1, gc
    real    :: y, ydn, rsd, rhd

    if (ism == 1)  mn = 0
    if (ism == 2)  mn = 31
    if (ism == 3)  mn = 59
    if (ism == 4)  mn = 90
    if (ism == 5)  mn = 120
    if (ism == 6)  mn = 151
    if (ism == 7)  mn = 181
    if (ism == 8)  mn = 212
    if (ism == 9)  mn = 243
    if (ism == 10) mn = 273
    if (ism == 11) mn = 304
    if (ism == 12) mn = 334

    y = isy + (mn + isd) / 365.25
    if ( (y > 1582.76) .and. (y < 1582.788) ) then
       print *, "Gregorian: Omitted"
       stop "Try again!"
    else
       if (y > 1582.76) then
          gc = 10
       else
          gc = 0
       end if
       if (y > 1701) gc = 11
       if (y > 1801) gc = 12
       if (y > 1901) gc = 13
       ydn = (isy - 1) * 365.25
           
       if (ism < 3) then
          goto 2
       else
          if (int(isy/4) == isy/4) mn = mn + 1
          if (isy == 1700) mn = mn - 1
          if ( (isy == 1800) .or. (isy == 1900) ) mn = mn - 1
       end if
2      rsd = ydn + mn + isd - gc
       rhd = rsd - 227016
       ihy = int(rhd/354.3671 + 1)
       hm1 = nint(rhd - (ihy - 1) * 354.3671)
       ihm = int(hm1/29.5306) + 1
       ihd = int(nint(hm1 - (ihm - 1) * 29.5306))

       if (ihd == 0) then
          ihm = ihm - 1
          ihd = 30
       end if
    end if
    
  end subroutine solarToHijriCalc
   
end program calendar
