subroutine calendg (idatjul,nd,nm,na,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.01 - V 2.0 c*VER 03.01.06 - V 2.1 c* c*AUT spec. CNES - JC KOSIK - janvier 1991 c*AUT port. CISI c* c*ROL Theme : Calculs de dates c*ROL Calcul d'une date calendaire a partir du jour julien c*ROL CNES. c* c*PAR idatjul (I) : jour julien CNES (depuis le 01/01/1950) c* c*PAR nd (O) : jour c*PAR nm (O) : mois c*PAR na (O) : annee 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.01 - 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 des parametres c -------------------------- c integer idatjul integer nd, nm, na integer ier c c --------------------------------- c*FON Declaration des variables locales c --------------------------------- c integer n(12) c*LOC n : nombre de jours par mois c integer njul,nb,nj,j,nm1,m,nj3,ndj 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 Debut de programme c ****************** c ier = 0 c c -------------------------- c*FON Affectation des constantes c -------------------------- c c* Nombre de jours par mois c data n /31,28,31,30,31,30,31,31,30,31,30,31/ c c ------------------------------------- c*FON Calculs preliminaires annee,mois,jour c ------------------------------------- c njul = idatjul + 1 na = njul / 365 nj = njul - na * 365 nb = (na + 1) / 4 nj = nj - nb c c --------------------------------------- c*FON Traitements si l'on est au dela de 1950 c --------------------------------------- c if (nj .gt. 0) then c j = na - 2 - nb * 4 na = na + 1950 c if (j .lt. 0) go to 20 c if (60 - nj) 10, 40, 20 c 10 continue c nm1 = 60 m = 3 go to 30 c 20 continue c nm1 = 0 m = 1 c 30 continue c ndj = nm1 + n(m) nj3 = nj - ndj c if (nj3 .le. 0) go to 50 c m = m + 1 nm1 = ndj go to 30 c 40 continue c nm = 2 nd = 29 go to 100 c 50 continue c nm = m nd = nj - nm1 c else c na = na + 1949 nm = 12 nd = nj + 31 c endif 100 continue c c **************** c Fin de programme c **************** c return end