function julg (iday,imonth,iyear,ier) c* c*********************************************************************** c* c* "Copyright [c] CNES 98 - tous droits reserves" c* ********************************************** c* c*PRO MAGLIB c* c*VER 99.03.31 - V 1.0 c*VER 01.06.05 - V 2.0 c*VER 03.01.06 - V 2.1 c* c*AUT spec. CNES - JC KOSIK - juin 1995 c*AUT port. CISI c* c*ROL Theme : Calculs de dates c*ROL Calcul du nombre de jours juliens ecoules depuis le c*ROL 1/1/1950 a 0 heure, en fonction d'une date calendaire. c* c*PAR iday (I) : jour c*PAR imonth (I) : mois c*PAR iyear (I) : annee >= 1950 c* c*PAR julg (O) : resultat de la fonction : jour julien CNES c* : (depuis le 01/01/1950) c* c*PAR ier (O) : code de retour c* c*NOT ier : sans objet c* c*INF utilise : sans objet c* c*HST version 1.0 - 99.03.31 - creation de la maglib au CDPP c*HST version 2.0 - 01.06.05 - correction de commentaires de code c*HST version 2.1 - 03.01.06 - corrections en compilation avec g77 c* c*********************************************************************** c* implicit none c c --------------------------------- c*FON Declaration identificateur rcs_id c --------------------------------- c character rcs_id*100 c c -------------------------- c*FON Declaration de la fonction c -------------------------- c integer julg c c -------------------------- c*FON Declaration des parametres c -------------------------- c integer iday, imonth, iyear integer ier c c --------------------------------- c*FON Declaration des variables locales c --------------------------------- c integer m(12) c*LOC m : nombre de jours par mois c integer ia,ix,iy,jy,n c*LOC Variables de travail intermediaires c SAVE c c --------------------------------- c*FON Affectation identificateur rcs_id c --------------------------------- c data rcs_id /" >$Id$"/ c c -------------------------- c*FON Affectation des constantes c -------------------------- c c* Nombre de jours par mois c data m /-1,31,28,31,30,31,30,31,31,30,31,30/ c c ****************** c Debut de programme c ****************** c ier = 0 c c ----------------- c*FON Calcul de l'annee c ----------------- c iy = iyear - 1948 ia = (iy - 1) / 4 c julg = ia + 365 * iy - 730 c c --------------------------------- c*FON Totalisation des jours de l'annee c*FON jusqu'au mois imonth c --------------------------------- c do 10 n = 1, imonth julg = julg + m(n) 10 continue c c --------------------------------------- c*FON Calcul du jour julien tenant compte des c*FON annees bisextiles c --------------------------------------- c if (imonth .le. 2) then c julg = julg + iday c else c jy = iyear / 4 ix = iyear - jy * 4 c if (ix .ne. 0) then julg = julg + iday else julg = julg + 1 julg = julg + iday endif c endif c c **************** c Fin de programme c **************** c return end