Open64 (mfef90, whirl2f, and IR tools)  TAG: version-openad; SVN changeset: 916
jdate.c
Go to the documentation of this file.
00001 /*
00002 
00003   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00004 
00005   This program is free software; you can redistribute it and/or modify it
00006   under the terms of version 2.1 of the GNU Lesser General Public License 
00007   as published by the Free Software Foundation.
00008 
00009   This program is distributed in the hope that it would be useful, but
00010   WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00012 
00013   Further, this software is distributed without any warranty that it is
00014   free of the rightful claim of any third person regarding infringement 
00015   or the like.  Any license provided herein, whether implied or 
00016   otherwise, applies only to this software file.  Patent licenses, if
00017   any, provided herein do not apply to combinations of this program with 
00018   other software, or any other product whatsoever.  
00019 
00020   You should have received a copy of the GNU Lesser General Public 
00021   License along with this program; if not, write the Free Software 
00022   Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 
00023   USA.
00024 
00025   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00026   Mountain View, CA 94043, or:
00027 
00028   http://www.sgi.com
00029 
00030   For further information regarding this notice, see:
00031 
00032   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00033 
00034 */
00035 
00036 
00037 #pragma ident "@(#) libfi/element/jdate.c       92.1    06/16/99 15:47:23"
00038 #include <fortran.h> 
00039 #include <stdio.h>
00040 #include <string.h>
00041 #include <time.h>
00042 #include <sys/types.h>
00043 
00044 /*
00045  *      JDATE   Returns the current date in "YYDDD   " format.
00046  *              YY = Year modulus 100 (00 - 99).
00047  *              DDD = Julian day (001 - 366).
00048  *
00049  *              May be called as either a function or a subroutine.
00050  *              If called as a subroutine, the parameter may be
00051  *              either CHARACTER or INTEGER type.
00052  */
00053 
00054 /*
00055  *      Duplicate names
00056  *
00057  *      _JDATE_         - for f90 intrinsic
00058  *      JDATE           - if called as a subroutine
00059  *      $JDATE          - for cf77 intrinsic
00060  *      _JDATE          - for f90 3.0? and previous on PVP systems 
00061  */
00062 #if     !defined(__mips) && !defined(_LITTLE_ENDIAN)
00063 #pragma _CRI duplicate _JDATE_ as JDATE
00064 #pragma _CRI duplicate _JDATE_ as $JDATE
00065 #pragma _CRI duplicate _JDATE_ as _JDATE
00066 #endif
00067 
00068 /*
00069  *      NOTE:   For 32-bit architectures, the JDATE function is quite
00070  *              different from the 64-bit version.   Two parms vs. one,
00071  *              pointer to a parameter vs. not, and differnt return values.
00072  */
00073 
00074 #ifdef _UNICOS
00075 
00076 _f_int
00077 _JDATE_(julianday)
00078 _fcd    julianday;
00079 {
00080  
00081         long            jdate; 
00082         struct tm       *sp;
00083         time_t          now;
00084         char            str[sizeof(long) + 1];
00085  
00086         now     = time((time_t *) NULL);
00087         sp      = localtime(&now);
00088 
00089         /*
00090          * Mod the year by 100 so it will be correct after year 1999;
00091          * user is required to know the century.
00092          */
00093 
00094         (void) sprintf(str, "%02d%03d   ", sp->tm_year % 100, sp->tm_yday + 1);
00095 
00096         jdate   = *(long *)str;
00097 
00098         if (_numargs() > 0)
00099 #ifdef _ADDR64
00100                 if (_numargs() > 1) {           /* If Fortran character */
00101 #else
00102                 if (_isfcd(julianday)) {        /* If Fortran character */
00103 #endif
00104                         unsigned int    len;
00105                         char            *cp;
00106 
00107                         cp      = _fcdtocp(julianday);
00108                         len     = _fcdlen (julianday);
00109 
00110                         (void) strncpy(cp, str, len);
00111 
00112                         if (len > sizeof(long))
00113                                 (void) memset(cp + sizeof(long), (_f_int) ' ',
00114                                                 len - sizeof(long));
00115                 }
00116                 else                            /* Hollerith */
00117                         **(long **) &julianday  = jdate;
00118 
00119         return ( (_f_int) jdate);
00120 }
00121 #else
00122 
00123 #define DATE_CHRS       8
00124 
00125 _fcd
00126 _JDATE_(julianday, iffcd)
00127         void    *julianday;             /* address of result, unless NULL    */
00128         int     iffcd;                  /* zero     if 1st parm is long long */
00129                                         /* non-zero if 1st parm is _fcd      */
00130 {
00131         struct tm       *sp;
00132         time_t          now;
00133         char            str[DATE_CHRS + 1];
00134 
00135         now = time((time_t *) NULL);
00136         sp = localtime(&now);
00137 
00138 /*
00139  *      Mod the year by 100 so it will be correct after 1999.  User will be
00140  *      required to know the century.
00141  */
00142 
00143         (void) sprintf (str, "%02d%03d   ", sp->tm_year % 100, sp->tm_yday + 1);
00144 
00145         if (julianday != NULL)                  /* a paramter was passed */
00146             if (iffcd != 0) {                   /* if Fortran character  */
00147                 unsigned int    len;
00148                 char            *cp;
00149 
00150                 cp = (char *) julianday;
00151                 len = iffcd;
00152                 (void) strncpy (cp, str, len);
00153                 if (len > DATE_CHRS)
00154                     (void) memset (cp + DATE_CHRS, (int) ' ', len - DATE_CHRS);
00155             }
00156 
00157         return (_cptofcd (str, strlen(str)));
00158 }
00159 #endif
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines