This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Fully Functional Now


This program now appears to be functional:

[RadSurfer@centos fortran]$ gfortran jg3.f95

[RadSurfer@centos fortran]$ ./a.out 9 2 2007
 JD   2454345.50000000      Q   2454345.50000000     

[RadSurfer@centos fortran]$ ./a.out 2454345.5
   9.00000000000000      /   2.00000000000000      /   2007.00000000000  

Apparently, indeed unlike C, Fortran requires that the return value of
functions be assigned to a variable, or incorporated into another expression,
or its a syntax error.  Nature of Functions is to have an L-value :-)

I am also trying to understand the proper use of   _8  on certain constants
in expressions with variables declared as Real(8), for be consistant with
the precision of the calculations. I need more input on this.
So I'm just experimenting with things to see how it affects values displayed.

This is fun actually! And I have lots more astronomy-related stuff I will
be coding in Fortran over the Winter months. :-)

Thank you for the valued assistance.

! sat 01 sep 2007 09:11:37 pm edt 
! convert to/from gregorian/julian dates
! jgreg.f95   Now functional.

program jgreg
  implicit none

  real(8) JD, M, D, Y,q
  integer n,c
  character arg*80,astr*45,buffer*256

  n = iargc()

  if (n == 1) then
    call getarg(1, arg);
    read(arg,*) JD  ! get cmdline value (real8)
    q = JDtoMDY(JD,M,D,Y)
    write(*,*) M,'/',D,'/',Y
  else
    if (n == 3) then
      call getarg(1, arg);
      read(arg,*) M  ! get cmdline value (real8)
      call getarg(2, arg);
      read(arg,*) D  ! get cmdline value (real8)
      call getarg(3, arg);
      read(arg,*) Y  ! get cmdline value (real8)
      q = MDYtoJD(M,D,Y,JD)
      write(*,*) 'JD',JD,'Q',q
    else
      write(*,*) 'error: improper number of aruments!'
    end if
  end if

contains

function fix(x)
  real(8)               :: fix
  real(8), intent(in)   :: x

  if (x .lt. 0.0_8) then
    fix = ceiling(x)
  else
    fix = floor(x)
  end if
end function fix

function JDtoMDY(JD,M,D,Y)
  real(8)                :: JDtoMDY 
  real(8), intent(in)    :: JD    
  real(8), intent(in out):: M,D,Y 
  real(8) :: c,g,e,f
  
   c = fix(JD+0.5) + 1537.0;

   g = fix( (c-122.1)/365.25 );

   e = fix(365.25*g);

   f = fix((c-e)/30.6001);

   D = c - e - fix(30.6001*f) + ( (JD+0.5) - fix(JD+0.5));

   M = f - 1.0 - 12.0 * fix(f/14.0) ;

   Y = g - 4715.0 - fix( (7.0 + M )/10.0 );


  JDtoMDY = Y
end function JDtoMDY

function MDYtoJD(M,D,Y,JD)
  real(8) :: MDYtoJD 
  real(8) :: M,D,Y  
  real(8) :: JD 

  if (M<3.0_8) then 
    Y=Y-1
    M=M+12.0_8
  end if 

  JD = fix(Y/100.0_8)

  JD = ( 2.0_8 - JD + fix(JD/4.0_8))  + fix(365.25_8*Y)  &
        + fix(30.6001_8*(M+1.0_8)) + D + 1720994.5_8

  MDYtoJD = JD
end function MDYtoJD

end program jgreg



Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]