Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

dates.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

File size: 35.0 KB

Line
1	subroutine dates_demo
2	! --------------------------------------------------------------
3	!
4	! Conseils a l'utilisateur:
5	!
6	! 1. VOUS COMPILEZ LES ENTIERS EN 32 BITS:
7	! Utilisez alors les routines
8	! - ecartds: Ecart en secondes entre deux dates.
9	! - ecartdj: Ecart en jours entre deux dates.
10	! - dapluss: Date dans n secondes.
11	! - daplusj: Date dans n jours.
12	! - qqmmaa: Conversion d'un entier type AAAAQQMM vers une date en clair.
13	! - ijoursem: Jour de la semaine de la date d'entree.
14	! - quant: quantieme de l'annee d'une date donnee.
15	! Ces routines sont compatibles avec des entiers 32 bits.
16	! En effet elles appelent les routines citees ci-dessous, mais avec
17	! les parametres subsequents assurant que seuls des entiers
18	! representables en 32 bits y soient utilises.
19	!
20	! 2. VOUS COMPILEZ LES ENTIERS EN 64 BITS:
21	! Vous pouvez alors utiliser toutes les routines ci-dessus
22	! plus les suivantes, qui traitent des formats de dates
23	! en entree/sortie en JOURS, HEURES, MINUTES ou SECONDES:
24	! - ecartd: Ecart entre deux dates.
25	! - gregod: Conversion Date > Ecart par rapport a une date fixe.
26	! - gregoi: Conversion Ecart par rapport a une date fixe > Date.
27	! - daplus: Quelle sera la date dans n jours (ou heures, etc...)?
28	! - amqhms_vers_dj: Conversion date grégorienne (en 5 entiers et un réel) > date julienne.
29	! - dj_vers_amqhms: Conversion date julienne > date grégorienne (en 5 entiers et un réel).
30	! - amqhmsree_vers_dj: Conversion date grégorienne (en un seul réel) > date julienne.
31	! - dj_vers_amqhmsree: Conversion date julienne > date grégorienne (en un seul réel).
32	!
33	! --------------------------------------------------------------
34	!
35	! Définition des dates employées ci-dessous:
36	!
37	! Date julienne DJ:
38	! Elle est composée d'un réel.
39	! R1: Ce réel croît de 1 tous les jours,
40	! et vaut 2451545.0 le 1er janvier 2000 à 12 UTC.
41	!
42	! Date grégorienne "en clair" AMQHMS:
43	! Elle est composée de 5 entiers et d'un réel.
44	! E1: Année (4 chiffres!)
45	! E2: Mois
46	! E3: Jour
47	! E4: Heure
48	! E5: Minute
49	! R1: Seconde
50	! --------------------------------------------------------------
51
52
53	IMPLICIT NONE
54	end
55	subroutine date_plus_ech(kan,kmo,kqu,psssss,pstati,cdtit)
56	! --------------------------------------------------------------
57	! Ecriture en clair d'une date de type BASE 2000.01.15 00:00 +72H VALID 2000.01.18 15:00.
58	! --------------------------------------------------------------
59	! Sujet:
60	! Arguments explicites:
61	! Arguments implicites:
62	! Methode:
63	! Externes:
64	! Auteur: 2000-09, J.M. Piriou.
65	! Modifications:
66	! --------------------------------------------------------------
67	! En entree:
68	! kan,kmo,kqu,psssss,pstati
69	! En sortie:
70	! cdtit
71	! --------------------------------------------------------------
72
73
74	IMPLICIT NONE
75	INTEGER(KIND=4) :: kan,kmo,kqu,ihe,imi,imiv,ihev,iquv,imov,ianv,ilze
76	REAL(KIND=8) :: psssss,pstati
77	REAL(KIND=8) :: zs
78	REAL(KIND=8) :: zsssss,zdj,zsv
79	REAL(KIND=8) :: zech
80	character*200 clzue,clze,clech
81	character () cdtit
82	!
83	!-------------------------------------------------
84	! Date de validité.
85	!-------------------------------------------------
86	!
87	zs=0.
88	zsssss=psssss/3600.
89	ihe=int(zsssss) ! heure de la base.
90	zsssss=(zsssss-real(ihe))*60.
91	imi=int(zsssss) ! minute de la base.
92	zsssss=zsssss-real(imi)
93	call amqhms_vers_dj(kan,kmo,kqu,ihe,imi,zs,zdj)
94	zdj=zdj+pstati/86400. ! date julienne de validité.
95	call dj_vers_amqhms(zdj,ianv,imov,iquv,ihev,imiv,zsv) ! date grégorienne de validité.
96	if(pstati < 3600.) then
97	!
98	!-------------------------------------------------
99	! Echéance en minutes.
100	!-------------------------------------------------
101	!
102	zech=pstati/60. ; clzue='mn'
103	elseif(pstati < 259200.) then
104	!
105	!-------------------------------------------------
106	! Echéance en heures.
107	!-------------------------------------------------
108	!
109	zech=pstati/3600. ; clzue='h'
110	else
111	!
112	!-------------------------------------------------
113	! Echéance en jours.
114	!-------------------------------------------------
115	!
116	zech=pstati/86400. ; clzue='j'
117	endif
118	!
119	! Affichage de l'echeance avec deux chiffres apres la virgule.
120	!
121	write(clze,fmt='(f9.2)') zech
122	!
123	! Si l'echeance est voisine d'un entier a mieux que 10**-2 pres,
124	! on l'affiche au format entier.
125	!
126	if(clze(len_trim(clze)-2:len_trim(clze)) == '.00') then
127	clze=clze(1:len_trim(clze)-3)
128	endif
129	clze=adjustl(clze)
130	ilze=len_trim(clze)
131	clech=clze(1:ilze)//clzue
132	!
133	!-------------------------------------------------
134	! Titre 3, de type
135	! BASE 2000.01.15 00:00 +72H VALID 2000.01.18 15:00.
136	!-------------------------------------------------
137	!
138	if(imi == 0 .and. imiv == 0) then
139	!
140	!-------------------------------------------------
141	! Les minutes de base et validité sont nulles.
142	! On ne les affiche pas.
143	!-------------------------------------------------
144	!
145	write(cdtit,fmt='(a,i2,a,i2.2,a,i4.4,a,i2.2,3a,i2,a,i2.2,a,i4.4,a,i2.2,a)')&
146	&'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,'h UTC + ',clech(1:len_trim(clech))&
147	&,', VALID ',iquv,'.',imov,'.',ianv,' ',ihev,'h UTC'
148	else
149	!
150	!-------------------------------------------------
151	! Les minutes de base ou validité sont non nulles.
152	! On les affiche.
153	!-------------------------------------------------
154	!
155	write(cdtit,fmt='(a,i2,a,i2.2,a,i4.4,a,i2.2,a,i2.2,3a,i2,a,i2.2,a,i4.4,a,i2.2,a,i2.2,a)')&
156	&'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,':',imi,' UTC + ',clech(1:len_trim(clech))&
157	&,' VALID ',iquv,'.',imov,'.',ianv,' ',ihev,':',imiv,' UTC'
158	endif
159	end
160	subroutine datc(kaaaa,kmm,kqq,khh,kmi,kss,kjs,cdjs,cddt)
161	! --------------------------------------------------------------
162	! **** datc Date courante machine.
163	! --------------------------------------------------------------
164	! Sujet:
165	! ------
166	! Arguments explicites:
167	! ---------------------
168	! Arguments implicites:
169	! ---------------------
170	! Methode:
171	! --------
172	! Externes:
173	! ---------
174	! Auteur: 95-05, J.M. Piriou.
175	! -------
176	! Modifications:
177	! --------------------------------------------------------------
178	! En entree:
179	! En sortie:
180	! kaaaa annee.
181	! kmm mois.
182	! kqq quantieme.
183	! khh heure.
184	! kmi minute.
185	! kss seconde.
186	! kjs jour de la semaine (0: dimanche, 6 samedi).
187	! cdjs jour de la semaine sur 3 caracteres (Dim, Lun, etc...).
188	! cddt date totale (19950301-Mer-16:56:32).
189	! --------------------------------------------------------------
190
191
192	IMPLICIT NONE
193	INTEGER(KIND=4) :: idatat(8)
194	INTEGER(KIND=4) :: kjs
195	INTEGER(KIND=4) :: kss
196	INTEGER(KIND=4) :: kmi
197	INTEGER(KIND=4) :: khh
198	INTEGER(KIND=4) :: kqq
199	INTEGER(KIND=4) :: kmm
200	INTEGER(KIND=4) :: kaaaa
201	INTEGER(KIND=4) :: iaaaammqq
202	INTEGER(KIND=4) :: ijoursem
203	REAL(KIND=8) :: zs
204	character*200 clgol1,clgol2,clgol3
205	character*3 cdjs
206	character() cddt
207	character*3 cljour(0:6)
208	data cljour/'Dim','Lun','Mar','Mer','Jeu','Ven','Sam'/
209	!
210	!-------------------------------------------------
211	! Date courante à la f90.
212	!-------------------------------------------------
213	!
214	clgol1=' '
215	clgol2=' '
216	clgol3=' '
217	call date_and_time(clgol1,clgol2,clgol3,idatat)
218	!
219	!-------------------------------------------------
220	! clgol1 est du type "AAAAMMQQ".
221	!-------------------------------------------------
222	!
223	read(clgol1,fmt='(i4,2i2)') kaaaa,kmm,kqq
224	!
225	!-------------------------------------------------
226	! clgol2 est du type "HHMMSS.SSS".
227	!-------------------------------------------------
228	!
229	read(clgol2,fmt='(2i2)') khh,kmi
230	read(clgol2(5:),fmt=*) zs
231	kss=nint(zs)
232	read(clgol1,fmt='(i8)') iaaaammqq
233	!
234	!-------------------------------------------------
235	! Jour de la semaine.
236	!-------------------------------------------------
237	!
238	kjs=ijoursem(iaaaammqq)
239	cdjs=cljour(kjs)
240	!
241	!-------------------------------------------------
242	! Date totale.
243	!-------------------------------------------------
244	!
245	write(cddt,fmt='(i4.4,a,2(i2.2,a),2a,i2.2,a,i2.2,a,i2.2)') &
246	&kaaaa,'_',kmm,'_',kqq,'_',cdjs,'_',khh,':',kmi,':',kss
247	end
248	subroutine amqhms_vers_dj(kaaaa,kmm,kqq,khh,kmn,ps,pdj)
249	! --------------------------------------------------------------------------
250	! **** amqhms_vers_dj
251	! --------------------------------------------------------------------------
252	! Auteur:
253	! -------
254	! 1999-08-17, J.M. Piriou.
255	!
256	! Modifications:
257	! --------------
258	!
259	! --------------------------------------------------------------------------
260	! En entree:
261	! kaaaa année (4 chiffres!)
262	! kmm mois
263	! kqq quantième du mois
264	! khh heure
265	! kmn minute
266	! ps seconde
267	! En sortie:
268	! pdj date julienne associée à la date grégorienne UTC d'entrée
269	! --------------------------------------------------------------------------
270
271
272	IMPLICIT NONE
273	INTEGER(KIND=4) :: IDATE1
274	INTEGER(KIND=4) :: IDATE2
275	INTEGER(KIND=4) :: IECART
276	INTEGER(KIND=4) :: KAAAA
277	INTEGER(KIND=4) :: KHH
278	INTEGER(KIND=4) :: KMM
279	INTEGER(KIND=4) :: KMN
280	INTEGER(KIND=4) :: KQQ
281	REAL(KIND=8) :: PDJ
282	REAL(KIND=8) :: PS
283
284	idate1=20000101
285	idate2=kaaaa10000+kmm100+kqq
286	!
287	!-------------------------------------------------
288	! Nombre de jours écoulés entre la date
289	! d'entrée à 0h UTC et le 1er janvier 2000 à 0h UTC.
290	!-------------------------------------------------
291	!
292	call ecartdj(idate1,idate2,iecart)
293	!
294	!-------------------------------------------------
295	! Date julienne.
296	!-------------------------------------------------
297	!
298	pdj=2451545.0- 0.5 +real(iecart)+real(khh)/24. &
299	& +real(kmn)/1440.+ps/86400.
300	end
301	subroutine daplus(kdat1,kopt,kdelt,kdat2)
302	! --------------------------------------------------------------------------
303	! **** DAPLUS Quelle sera la date dans n jours (ou heures, etc...)?
304	! --------------------------------------------------------------------------
305	! Auteur:
306	! -------
307	! 94-10-31, J.M. Piriou.
308	!
309	! Modifications:
310	! --------------
311	!
312	! --------------------------------------------------------------------------
313	! En entree:
314	! kdat1
315	! kopt option de precision sur les dates:
316	! 1 : au jour pres
317	! 2 : a l'heure pres
318	! 3 : a la minute pres
319	! 4 : a la seconde pres
320	! - si kopt=1 : kdat au format AAAAMMQQ
321	! - si kopt=2 : kdat au format AAAAMMQQHH
322	! - si kopt=3 : kdat au format AAAAMMQQHHMM
323	! - si kopt=4 : kdat au format AAAAMMQQHHMMSS
324	! (cf. GREGOD).
325	! kdelt duree a ajouter a kdat1, unite: celle imposee par kopt.
326	! En sortie:
327	! kdat2 date finale.
328	!
329	! --------------------------------------------------------------------------
330	! Exemple: call DAPLUS(19940503,1,456,ires) fournira
331	! dans ires la date au format AAAAMMQQ situee 456 jours apres
332	! le 3 mai 1994.
333	! --------------------------------------------------------------------------
334	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
335	! ATTENTION A LA PRECISION:
336	! 1. Vous compilez les entiers sur 32 bits:
337	! Vous devez alors vous limiter a kopt <= 2.
338	! 2. Vous compilez les entiers sur 64 bits:
339	! Vous pouvez utiliser toutes les valeurs de kopt.
340	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
341
342
343	IMPLICIT NONE
344	INTEGER(KIND=4) :: IGRE
345	INTEGER(KIND=4) :: KDAT1
346	INTEGER(KIND=4) :: KDAT2
347	INTEGER(KIND=4) :: KDELT
348	INTEGER(KIND=4) :: KOPT
349	call gregod(kdat1,kopt,igre)
350	igre=igre+kdelt
351	call gregoi(igre,kopt,kdat2)
352	end
353	subroutine daplusj(k1,kec,k2)
354	! --------------------------------------------------------------
355	! **** daplusj Date dans n jours.
356	! --------------------------------------------------------------
357	! Sujet:
358	! Arguments explicites:
359	! Arguments implicites:
360	! Methode:
361	! Externes:
362	! Auteur: 97-11, J.M. Piriou.
363	! Modifications:
364	! --------------------------------------------------------------
365	! En entree:
366	! k1 date de depart au format AAAAMMQQ.
367	! kec nombre de jours ecoules.
368	! En sortie:
369	! k2 date d'arrivee au format AAAAMMQQ.
370	! --------------------------------------------------------------
371	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
372	! PRECISION:
373	! Cette routine est utilisable avec des entiers 32 bits ou 64 bits.
374	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
375	!
376	! -------------------------------------------------
377	! Date d'arrivee au jour pres.
378	! -------------------------------------------------
379	!
380
381
382	IMPLICIT NONE
383	INTEGER(KIND=4) :: K1
384	INTEGER(KIND=4) :: K2
385	INTEGER(KIND=4) :: KEC
386	call daplus(k1,1,kec,k2)
387	end
388	subroutine dapluss(cd1,kec,cd2)
389	! --------------------------------------------------------------
390	! **** dapluss Date dans n secondes.
391	! --------------------------------------------------------------
392	! Sujet:
393	! Arguments explicites:
394	! Arguments implicites:
395	! Methode:
396	! Externes:
397	! Auteur: 97-11, J.M. Piriou.
398	! Modifications:
399	! --------------------------------------------------------------
400	! En entree:
401	! cd1 date de depart au format 'AAAAMMQQHHNNSS'.
402	! kec nombre de secondes ecoulees.
403	! En sortie:
404	! cd2 date d'arrivee au format 'AAAAMMQQHHNNSS'.
405	! --------------------------------------------------------------
406	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
407	! ATTENTION A LA PRECISION:
408	! Cette routine est utilisable avec des entiers 32 bits,
409	! si l'ecart entre les deux dates est inferieur a 2**31 secondes,
410	! soit 68 ans!...
411	!
412	! Au-dela de cette duree, les entiers doivent etre 64 bits.
413	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
414
415
416	IMPLICIT NONE
417	INTEGER(KIND=4) :: IAMQ1
418	INTEGER(KIND=4) :: IAMQ2
419	INTEGER(KIND=4) :: IDELTA
420	INTEGER(KIND=4) :: IECJOURS
421	INTEGER(KIND=4) :: IH1
422	INTEGER(KIND=4) :: IH2
423	INTEGER(KIND=4) :: IM1
424	INTEGER(KIND=4) :: IM2
425	INTEGER(KIND=4) :: IRESTE
426	INTEGER(KIND=4) :: IS1
427	INTEGER(KIND=4) :: IS2
428	INTEGER(KIND=4) :: ISEC
429	INTEGER(KIND=4) :: KEC
430	character() cd1,cd2
431	!
432	! -------------------------------------------------
433	! On lit les dates sur des entiers.
434	! -------------------------------------------------
435	!
436	read(cd1,fmt='(i8,3i2)') iamq1,ih1,im1,is1
437	!
438	! -------------------------------------------------
439	! Calculs d'ecarts et de leur partition
440	! en multiples de 86400 et sous-multiples.
441	! -------------------------------------------------
442	!
443	isec=ih13600+im160+is1 ! nombre de secondes ecoulees depuis cd10h.
444	idelta=kec+isec ! nombre de secondes entre cd10h et cd2.
445	ireste=modulo(idelta,86400) ! nombre de secondes entre cd20h et cd2.
446	iecjours=(idelta-ireste)/86400 ! nombre de jours entre cd10h et cd20h.
447	!
448	! -------------------------------------------------
449	! Date d'arrivee au jour pres.
450	! -------------------------------------------------
451	!
452	call daplus(iamq1,1,iecjours,iamq2)
453	!
454	! -------------------------------------------------
455	! Date finale a la seconde pres.
456	! -------------------------------------------------
457	!
458	ih2=ireste/3600
459	ireste=ireste-3600*ih2
460	im2=ireste/60
461	ireste=ireste-60*im2
462	is2=ireste
463	write(cd2,fmt='(i8,3i2.2)') iamq2,ih2,im2,is2
464	end
465	subroutine dj_vers_amqhms(pdj,kaaaa,kmm,kqq,khh,kmn,ps)
466	! --------------------------------------------------------------------------
467	! **** dj_vers_amqhms
468	! --------------------------------------------------------------------------
469	! Auteur:
470	! -------
471	! 1999-08-17, J.M. Piriou.
472	!
473	! Modifications:
474	! --------------
475	!
476	! --------------------------------------------------------------------------
477	! En entree:
478	! pdj date julienne associée à la date grégorienne UTC d'entrée
479	! En sortie:
480	! kaaaa année (4 chiffres!)
481	! kmm mois
482	! kqq quantième du mois
483	! khh heure
484	! kmn minute
485	! ps seconde
486	! --------------------------------------------------------------------------
487	!
488	!-------------------------------------------------
489	! Nombre de jours entre le 1er janvier 2000 à 0 UTC
490	! et la date julienne courante.
491	!-------------------------------------------------
492	!
493
494
495	IMPLICIT NONE
496	INTEGER(KIND=4) :: IDATE1
497	INTEGER(KIND=4) :: IDATE2
498	INTEGER(KIND=4) :: IECART
499	INTEGER(KIND=4) :: KAAAA
500	INTEGER(KIND=4) :: KHH
501	INTEGER(KIND=4) :: KMM
502	INTEGER(KIND=4) :: KMN
503	INTEGER(KIND=4) :: KNOUV
504	INTEGER(KIND=4) :: KQQ
505	REAL(KIND=8) :: PDJ
506	REAL(KIND=8) :: PS
507	REAL(KIND=8) :: ZECART
508	REAL(KIND=8) :: ZFRAC
509	zecart=pdj-2451544.5
510	!
511	!-------------------------------------------------
512	! Nombre entier de jours.
513	!-------------------------------------------------
514	!
515	zfrac=modulo(zecart, 1._8 )
516	iecart=nint(zecart-zfrac)
517	!
518	!-------------------------------------------------
519	! Date grégorienne associée.
520	!-------------------------------------------------
521	!
522	idate1=20000101
523	call daplusj(idate1,iecart,idate2)
524	kqq=mod(idate2,100)
525	knouv=idate2/100
526	kmm=mod(knouv,100)
527	kaaaa=knouv/100
528	!
529	!-------------------------------------------------
530	! Calcul de des heure, minute et seconde.
531	!-------------------------------------------------
532	!
533	zfrac=(zecart-real(iecart))*24.
534	khh=int(zfrac)
535	zfrac=(zfrac-real(khh))*60.
536	kmn=int(zfrac)
537	ps=(zfrac-real(kmn))*60.
538	end
539	subroutine dj_vers_amqhmsree(pdj,pgrer)
540	! --------------------------------------------------------------------------
541	! **
542	! --------------------------------------------------------------------------
543	! Auteur:
544	! -------
545	! 2002-11, J.M. Piriou.
546	!
547	! Modifications:
548	! --------------
549	!
550	! --------------------------------------------------------------------------
551	! En entree:
552	! pdj date julienne
553	! En sortie:
554	! pgrer date en clair au format AAAAMMQQ.HHMMSS
555	! --------------------------------------------------------------------------
556	!
557
558	IMPLICIT NONE
559	REAL(KIND=8), intent(in) :: PDJ
560	REAL(KIND=8), intent(out) :: pgrer
561	REAL(KIND=8) :: ZS
562	INTEGER(KIND=4) :: iaaaa,imm,iqq,ihh,imn
563	!
564	!-------------------------------------------------
565	! Conversion grégorien julien; cible 5 entiers et un réel.
566	!-------------------------------------------------
567	!
568	call dj_vers_amqhms(pdj,iaaaa,imm,iqq,ihh,imn,zs)
569	!
570	!-------------------------------------------------
571	! On passe de ces 5 entiers et un réel à un seul réel.
572	!-------------------------------------------------
573	!
574	pgrer=real(iaaaa)10000.+real(imm)100. &
575	& + real(iqq)+real(ihh)/100. &
576	& + real(imn)/10000.+zs/1.E+06
577	end
578	subroutine amqhmsree_vers_dj(pgrer,pdj)
579	! --------------------------------------------------------------------------
580	! **
581	! --------------------------------------------------------------------------
582	! Auteur:
583	! -------
584	! 2002-11, J.M. Piriou.
585	!
586	! Modifications:
587	! --------------
588	!
589	! --------------------------------------------------------------------------
590	! En entree:
591	! pgrer date en clair au format AAAAMMQQ.HHMMSS
592	! En sortie:
593	! pdj date julienne associée à la date grégorienne
594	! --------------------------------------------------------------------------
595	!
596
597	IMPLICIT NONE
598	REAL(KIND=8), intent(out) :: PDJ
599	REAL(KIND=8), intent(in) :: pgrer
600	REAL(KIND=8) :: ZS,zloc
601	INTEGER(KIND=4) :: iaaaa,imm,iqq,ihh,imn,iloc
602	!
603	!-------------------------------------------------
604	! On passe de cette date grégorienne donnée
605	! comme un seul réel à 5 entiers et un réel.
606	!-------------------------------------------------
607	!
608	iloc=int(pgrer)
609	iqq=mod(iloc,100)
610	iloc=iloc/100
611	imm=mod(iloc,100)
612	iaaaa=iloc/100
613
614	iloc=nint((pgrer-real(int(pgrer)))*1.E+06)
615	zs=real(mod(iloc,100))
616	iloc=iloc/100
617	imn=mod(iloc,100)
618	ihh=iloc/100
619	!
620	!-------------------------------------------------
621	! Conversion grégorien julien; cible 5 entiers et un réel.
622	!-------------------------------------------------
623	!
624	call amqhms_vers_dj(iaaaa,imm,iqq,ihh,imn,zs,pdj)
625	end
626	subroutine ecartd(kdat1,kdat2,kopt,kgre)
627	! --------------------------------------------------------------------------
628	! **** ECART Ecart entre deux dates.
629	! --------------------------------------------------------------------------
630	! Auteur:
631	! -------
632	! 97-01-09, J.M. Piriou.
633	!
634	! Modifications:
635	! --------------
636	!
637	! --------------------------------------------------------------------------
638	! En entree: kopt option de precision sur les dates:
639	! 1 : au jour pres
640	! 2 : a l'heure pres
641	! 3 : a la minute pres
642	! 4 : a la seconde pres
643	! - si kopt=1 : kdat au format AAAAMMQQ
644	! - si kopt=2 : kdat au format AAAAMMQQHH
645	! - si kopt=3 : kdat au format AAAAMMQQHHMM
646	! - si kopt=4 : kdat au format AAAAMMQQHHMMSS
647	! kdat1 et kdat2 dates au format ci-dessus.
648	! En sortie:
649	! - si kopt=1 : kgre nombre de jours entre kdat1 et kdat2
650	! - si kopt=2 : kgre nombre d'heures entre kdat1 et kdat2
651	! - si kopt=3 : kgre nombre de minutes entre kdat1 et kdat2
652	! - si kopt=4 : kgre nombre de secondes entre kdat1 et kdat2
653	! --------------------------------------------------------------------------
654	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
655	! ATTENTION A LA PRECISION:
656	! 1. Vous compilez les entiers sur 32 bits:
657	! Vous devez alors vous limiter a kopt <= 2.
658	! L'ecart entre les deux dates doit etre inferieur a
659	! - 2**31 heures si kopt=2
660	! - 2**31 jours si kopt=1
661	! 2. Vous compilez les entiers sur 64 bits:
662	! Vous pouvez utiliser toutes les valeurs de kopt.
663	! L'ecart entre les deux dates doit etre inferieur a
664	! - 2**63 secondes si kopt=4
665	! - 2**63 minutes si kopt=3
666	! - 2**63 heures si kopt=2
667	! - 2**63 jours si kopt=1
668	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
669
670
671	IMPLICIT NONE
672	INTEGER(KIND=4) :: IGRE1
673	INTEGER(KIND=4) :: IGRE2
674	INTEGER(KIND=4) :: KDAT1
675	INTEGER(KIND=4) :: KDAT2
676	INTEGER(KIND=4) :: KGRE
677	INTEGER(KIND=4) :: KOPT
678	call gregod(kdat1,kopt,igre1)
679	call gregod(kdat2,kopt,igre2)
680	kgre=igre2-igre1
681	end
682	subroutine ecartdj(k1,k2,kec)
683	! --------------------------------------------------------------
684	! **** ecartdj Ecart en jours entre deux dates.
685	! --------------------------------------------------------------
686	! Sujet:
687	! Arguments explicites:
688	! Arguments implicites:
689	! Methode:
690	! Externes:
691	! Auteur: 97-11, J.M. Piriou.
692	! Modifications:
693	! --------------------------------------------------------------
694	! En entree:
695	! k1 date de depart au format AAAAMMQQ.
696	! k2 date d'arrivee au format AAAAMMQQ.
697	! En sortie:
698	! kec: nombre de jours entre les deux dates.
699	! --------------------------------------------------------------
700	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
701	! ATTENTION A LA PRECISION:
702	! Cette routine est utilisable avec des entiers 32 bits,
703	! si l'ecart entre les deux dates est inferieur a 2**31 jours,
704	! soit 5879489 ans!...
705	!
706	! Au-dela de cette duree, les entiers doivent etre 64 bits.
707	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
708	!
709	! -------------------------------------------------
710	! Ecart entre les deux dates au jour pres.
711	! -------------------------------------------------
712	!
713
714
715	IMPLICIT NONE
716	INTEGER(KIND=4) :: K1
717	INTEGER(KIND=4) :: K2
718	INTEGER(KIND=4) :: KEC
719	call ecartd(k1,k2,1,kec)
720	end
721	subroutine ecartds(cd1,cd2,kec)
722	! --------------------------------------------------------------
723	! **** ecartds Ecart en secondes entre deux dates.
724	! --------------------------------------------------------------
725	! Sujet:
726	! Arguments explicites:
727	! Arguments implicites:
728	! Methode:
729	! Externes:
730	! Auteur: 97-11, J.M. Piriou.
731	! Modifications:
732	! --------------------------------------------------------------
733	! En entree:
734	! cd1 date de depart au format 'AAAAMMQQHHNNSS'.
735	! cd2 date d'arrivee au format 'AAAAMMQQHHNNSS'.
736	! En sortie:
737	! kec: nombre de secondes entre les deux dates.
738	! --------------------------------------------------------------
739	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
740	! ATTENTION A LA PRECISION:
741	! Cette routine est utilisable avec des entiers 32 bits,
742	! si l'ecart entre les deux dates est inferieur a 2**31 secondes,
743	! soit 68 ans!...
744	!
745	! Au-dela de cette duree, les entiers doivent etre 64 bits.
746	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
747
748
749	IMPLICIT NONE
750	INTEGER(KIND=4) :: IAMQ1
751	INTEGER(KIND=4) :: IAMQ2
752	INTEGER(KIND=4) :: IH1
753	INTEGER(KIND=4) :: IH2
754	INTEGER(KIND=4) :: IM1
755	INTEGER(KIND=4) :: IM2
756	INTEGER(KIND=4) :: IS1
757	INTEGER(KIND=4) :: IS2
758	INTEGER(KIND=4) :: KEC
759	INTEGER(KIND=4) :: KECQ
760	character() cd1,cd2
761	!
762	! -------------------------------------------------
763	! On lit les dates sur des entiers.
764	! -------------------------------------------------
765	!
766	read(cd1,fmt='(i8,3i2)') iamq1,ih1,im1,is1
767	read(cd2,fmt='(i8,3i2)') iamq2,ih2,im2,is2
768	!
769	! -------------------------------------------------
770	! Ecart entre les deux dates au jour pres.
771	! -------------------------------------------------
772	!
773	call ecartd(iamq1,iamq2,1,kecq)
774	!
775	! -------------------------------------------------
776	! Ecart en secondes.
777	! -------------------------------------------------
778	!
779	kec=kecq86400+(ih2-ih1)3600+(im2-im1)*60+is2-is1
780	end
781	subroutine gregod(kdat,kopt,kgre)
782	! --------------------------------------------------------------------------
783	! **** GREGOD - Conversion Date > Ecart par rapport a une date fixe.
784	! --------------------------------------------------------------------------
785	! Auteur:
786	! -------
787	! 92-05-27, J.M. Piriou.
788	!
789	! Modifications:
790	! --------------
791	!
792	! --------------------------------------------------------------------------
793	! En entree: kopt option de precision sur les dates:
794	! 1 : au jour pres
795	! 2 : a l'heure pres
796	! 3 : a la minute pres
797	! 4 : a la seconde pres
798	! - si kopt=1 : kdat au format AAAAMMQQ
799	! - si kopt=2 : kdat au format AAAAMMQQHH
800	! - si kopt=3 : kdat au format AAAAMMQQHHMM
801	! - si kopt=4 : kdat au format AAAAMMQQHHMMSS
802	! En sortie:
803	! - si kopt=1 : kgre nombre de jours entre 19000101 et kdat
804	! - si kopt=2 : kgre nombre d'heures entre 1900010100 et kdat
805	! - si kopt=3 : kgre nombre de minutes entre 190001010000 et kdat
806	! - si kopt=4 : kgre nombre de secondes entre 19000101000000 et kdat
807	! --------------------------------------------------------------------------
808	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
809	! ATTENTION A LA PRECISION:
810	! 1. Vous compilez les entiers sur 32 bits:
811	! Vous devez alors vous limiter a kopt <= 2.
812	! 2. Vous compilez les entiers sur 64 bits:
813	! Vous pouvez utiliser toutes les valeurs de kopt.
814	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
815
816
817	IMPLICIT NONE
818	INTEGER(KIND=4) :: idebm(12)
819	INTEGER(KIND=4) :: I0
820	INTEGER(KIND=4) :: IA100
821	INTEGER(KIND=4) :: IA4
822	INTEGER(KIND=4) :: IA400
823	INTEGER(KIND=4) :: IAAAA
824	INTEGER(KIND=4) :: IBISSEXT
825	INTEGER(KIND=4) :: ICONV
826	INTEGER(KIND=4) :: IFRJOUR
827	INTEGER(KIND=4) :: II
828	INTEGER(KIND=4) :: II1
829	INTEGER(KIND=4) :: IJOURP
830	INTEGER(KIND=4) :: IMM
831	INTEGER(KIND=4) :: IN
832	INTEGER(KIND=4) :: IN1
833	INTEGER(KIND=4) :: IN2
834	INTEGER(KIND=4) :: IQQ
835	INTEGER(KIND=4) :: KDAT
836	INTEGER(KIND=4) :: KGRE
837	INTEGER(KIND=4) :: KOPT
838	data idebm/0,31,59,90,120,151,181,212,243,273,304,334/
839	!
840	! --------------------------------------------------------------------------
841	! ** 1. Calcul du nb de jours separant ki2 du 1er janv 1900
842	!
843	! * 1.1 Extraction des quantieme, mois et annee
844	if(kopt == 1) then
845	! Date de type AAAAMMQQ
846	iconv=1
847	ifrjour=0
848	ii=kdat
849	elseif(kopt == 2) then
850	! Date de type AAAAMMQQHH
851	iconv=24
852	ifrjour=mod(kdat,100)
853	ii=kdat/100
854	elseif(kopt == 3) then
855	! Date de type AAAAMMQQHHMM
856	iconv=1440
857	ifrjour=mod(kdat,100)
858	ii=kdat/100
859	ifrjour=ifrjour+mod(ii,100)*60
860	ii=ii/100
861	elseif(kopt == 4) then
862	! Date de type AAAAMMQQHHMMSS
863	iconv=86400
864	ifrjour=mod(kdat,100)
865	ii=kdat/100
866	ifrjour=ifrjour+mod(ii,100)*60
867	ii=ii/100
868	ifrjour=ifrjour+mod(ii,100)*3600
869	ii=ii/100
870	else
871	! Cas d'entree erronee de l'utilisateur.
872	print*,'GREGODR/ERREUR: argument kopt errone!...'
873	print*,kopt
874	stop 'call abort'
875	endif
876	iqq=ii-(ii/100)*100
877	in=(ii-iqq)/100
878	imm=in-(in/100)*100
879	iaaaa=(in-imm)/100
880	! * 1.2 L'annee est-elle bissextile?
881	! Une annee est bissextile ssi elle est
882	! (mult de 4 et non mult de 100) ou (mult de 400)
883	iaaaa=iaaaa
884	ia400=400*(iaaaa/400)
885	ia100=100*(iaaaa/100)
886	ia4=4*(iaaaa/4)
887	if((iaaaa == ia400).or.((iaaaa == ia4).and.(iaaaa /= ia100)))then
888	ibissext=1
889	else
890	ibissext=0
891	endif
892	if ((ibissext == 1).and.(imm > 2)) then
893	ijourp=1
894	else
895	ijourp=0
896	endif
897	! * 1.3 Nombre de jours ecoules depuis le 1er janv
898	if(imm > 12) then
899	print*,'GREGODR/ERREUR: mois errone.'
900	print*,imm
901	stop 'call abort'
902	endif
903	in2=idebm(imm)+ijourp+iqq-1
904	! * 1.4 Calcul du nb de jours separant les 1er janvier de ii et 1900
905	i0=1900
906	in2=in2+365*(iaaaa-i0)+int((iaaaa-1)/4)-int((i0-1)/4)&
907	&-int((iaaaa-1)/100)+int((i0-1)/100)&
908	&+int((iaaaa-1)/400)-int((i0-1)/400)
909	! --------------------------------------------------------------------------
910	! ** 2. Calcul du nb de jours separant ii1 du 1er janv 1900
911	!
912	! * 2.1 Extraction des quantieme, mois et annee
913	ii1=19000101
914	ii=ii1
915	iqq=ii-(ii/100)*100
916	in=(ii-iqq)/100
917	imm=in-(in/100)*100
918	iaaaa=(in-imm)/100
919	! * 2.2 L'annee est-elle bissextile?
920	! Une annee est bissextile ssi elle est
921	! (mult de 4 et non mult de 100) ou (mult de 400)
922	iaaaa=iaaaa
923	ia400=400*(iaaaa/400)
924	ia100=100*(iaaaa/100)
925	ia4=4*(iaaaa/4)
926	if((iaaaa == ia400).or.((iaaaa == ia4).and.(iaaaa /= ia100)))then
927	ibissext=1
928	else
929	ibissext=0
930	endif
931	if ((ibissext == 1).and.(imm > 2)) then
932	ijourp=1
933	else
934	ijourp=0
935	endif
936	! * 2.3 Nombre de jours ecoules depuis le 1er janv
937	in1=idebm(imm)+ijourp+iqq-1
938	! * 2.4 Calcul du nb de jours separant les 1er janvier de ii et 1900
939	i0=1900
940	in1=in1+365*(iaaaa-i0)+int((iaaaa-1)/4)-int((i0-1)/4)&
941	&-int((iaaaa-1)/100)+int((i0-1)/100)&
942	&+int((iaaaa-1)/400)-int((i0-1)/400)
943	! --------------------------------------------------------------------------
944	! ** 3. Difference in2-in1
945	kgre=(in2-in1)*iconv+ifrjour
946	end
947	subroutine gregoi(kgre,kopt,kdat)
948	! --------------------------------------------------------------------------
949	! **** GREGOI - Conversion Ecart par rapport a une date fixe > Date.
950	! --------------------------------------------------------------------------
951	! Auteur:
952	! -------
953	! 92-05-27, J.M. Piriou.
954	!
955	! Modifications:
956	! --------------
957	!
958	! --------------------------------------------------------------------------
959	! En entree: kopt option de precision sur les dates:
960	! 1 : au jour pres
961	! 2 : a l'heure pres
962	! 3 : a la minute pres
963	! 4 : a la seconde pres
964	! - si kopt=1 : kgre nombre de jours entre 19000101 et kdat
965	! - si kopt=2 : kgre nombre d'heures entre 1900010100 et kdat
966	! - si kopt=3 : kgre nombre de minutes entre 190001010000 et kdat
967	! - si kopt=4 : kgre nombre de secondes entre 19000101000000 et kdat
968	! En sortie:
969	! - si kopt=1 : kdat au format AAAAMMQQ
970	! - si kopt=2 : kdat au format AAAAMMQQHH
971	! - si kopt=3 : kdat au format AAAAMMQQHHMM
972	! - si kopt=4 : kdat au format AAAAMMQQHHMMSS
973	! --------------------------------------------------------------------------
974	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
975	! ATTENTION A LA PRECISION:
976	! 1. Vous compilez les entiers sur 32 bits:
977	! Vous devez alors vous limiter a kopt <= 2.
978	! 2. Vous compilez les entiers sur 64 bits:
979	! Vous pouvez utiliser toutes les valeurs de kopt.
980	! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
981
982
983	IMPLICIT NONE
984	INTEGER(KIND=4) :: ijours(12)
985	INTEGER(KIND=4) :: IA100
986	INTEGER(KIND=4) :: IA4
987	INTEGER(KIND=4) :: IA400
988	INTEGER(KIND=4) :: IAAAA
989	INTEGER(KIND=4) :: IBISSEXT
990	INTEGER(KIND=4) :: ICONV
991	INTEGER(KIND=4) :: IDAT
992	INTEGER(KIND=4) :: IEC
993	INTEGER(KIND=4) :: IECI
994	INTEGER(KIND=4) :: IGII2P
995	INTEGER(KIND=4) :: II2P
996	INTEGER(KIND=4) :: IMM
997	INTEGER(KIND=4) :: IMOD
998	INTEGER(KIND=4) :: IQQ
999	INTEGER(KIND=4) :: KDAT
1000	INTEGER(KIND=4) :: KGRE
1001	INTEGER(KIND=4) :: KOPT
1002	REAL(KIND=8) :: ZARRDEC
1003	data ijours/31,28,31,30,31,30,31,31,30,31,30,31/
1004	! --------------------------------------------------------------------------
1005	! ** On determine la date approximative d'arrivee en annees decimales
1006	!
1007	if(kopt == 1) then
1008	! Date de type AAAAMMQQ
1009	iconv=1
1010	elseif(kopt == 2) then
1011	! Date de type AAAAMMQQHH
1012	iconv=24
1013	elseif(kopt == 3) then
1014	! Date de type AAAAMMQQHHMM
1015	iconv=1440
1016	elseif(kopt == 4) then
1017	! Date de type AAAAMMQQHHMMSS
1018	iconv=86400
1019	else
1020	! Cas d'entree erronee de l'utilisateur.
1021	print*,'GREGOI/ERREUR: argument kopt errone!...'
1022	print*,kopt
1023	stop 'call abort'
1024	endif
1025	zarrdec=1900.+(real(kgre)/real(iconv)-5.)/365.2425
1026	! --------------------------------------------------------------------------
1027	! ** On determine la date en clair ii2p associee a la date decimale
1028	!
1029	iaaaa=int(zarrdec)
1030	zarrdec=12.*(zarrdec-real(iaaaa))
1031	imm=int(zarrdec)+1
1032	zarrdec=28.*(zarrdec-real(imm-1))
1033	iqq=int(zarrdec)+1
1034	ii2p=iqq+imm100+iaaaa10000
1035	! --------------------------------------------------------------------------
1036	! ** On calcule le nombre de jours separant 19000101 de ii2p
1037	!
1038	call gregod(ii2p,1,igii2p)
1039	imod=mod(kgre,iconv)
1040	if(imod < 0) imod=imod+iconv
1041	iec=(kgre-imod)/iconv-igii2p
1042	! --------------------------------------------------------------------------
1043	! ** On avance de iec jours par rapport a ii2p
1044	!
1045	! * L'annee est-elle bissextile?
1046	! Une annee est bissextile ssi elle est
1047	! (mult de 4 et non mult de 100) ou (mult de 400)
1048	iaaaa=iaaaa
1049	ia400=400*(iaaaa/400)
1050	ia100=100*(iaaaa/100)
1051	ia4=4*(iaaaa/4)
1052	if((iaaaa == ia400).or.((iaaaa == ia4).and.(iaaaa /= ia100)))then
1053	ibissext=1
1054	else
1055	ibissext=0
1056	endif
1057	! Si oui, 29 jours en fevrier
1058	if(ibissext == 1) ijours(2)=29
1059	! * Boucle sur les jours
1060	do ieci=1,iec
1061	iqq=iqq+1
1062	if(iqq > ijours(imm)) then
1063	iqq=1
1064	imm=imm+1
1065	endif
1066	if(imm > 12) then
1067	imm=1
1068	iaaaa=iaaaa+1
1069	endif
1070	enddo
1071	! --------------------------------------------------------------------------
1072	! ** On met en forme la date finale
1073	!
1074	idat=iqq+imm100+iaaaa10000
1075	if(kopt == 2) then
1076	imod=mod(kgre,iconv)
1077	if(imod < 0) imod=imod+iconv
1078	idat=idat*100+imod
1079	elseif(kopt == 3) then
1080	imod=mod(kgre,iconv)
1081	if(imod < 0) imod=imod+iconv
1082	idat=idat*100+imod/60
1083	imod=mod(imod,60)
1084	idat=idat*100+imod
1085	elseif(kopt == 4) then
1086	imod=mod(kgre,iconv)
1087	if(imod < 0) imod=imod+iconv
1088	idat=idat*100+imod/3600
1089	imod=mod(imod,3600)
1090	idat=idat*100+imod/60
1091	imod=mod(imod,60)
1092	idat=idat*100+imod
1093	endif
1094	kdat=idat
1095	end
1096	function ijoursem(kdat)
1097	! --------------------------------------------------------------------------
1098	! **** IJOURSEM Jour de la semaine de la date d'entree.
1099	! --------------------------------------------------------------------------
1100	! Auteur:
1101	! -------
1102	! 94-10-31, J.M. Piriou.
1103	!
1104	! Modifications:
1105	! --------------
1106	!
1107	! --------------------------------------------------------------------------
1108	! En entree:
1109	! kdat1 au format AAAAMMQQ
1110	! En sortie:
1111	! ijour=0 si dimanche, 1 lundi, ..., 6 samedi.
1112	! --------------------------------------------------------------------------
1113
1114
1115	IMPLICIT NONE
1116	INTEGER(KIND=4) :: IDATDIM
1117	INTEGER(KIND=4) :: IECART
1118	INTEGER(KIND=4) :: IGRE
1119	INTEGER(KIND=4) :: IGREDIM
1120	INTEGER(KIND=4) :: KDAT
1121	INTEGER(KIND=4) :: ijoursem
1122	call gregod(kdat,1,igre)
1123	idatdim=19941030 ! cette date etait un dimanche.
1124	call gregod(idatdim,1,igredim)
1125	iecart=igre-igredim
1126	ijoursem=modulo(iecart,7)
1127	end
1128	subroutine qqmmaa(kdatd,cdresd)
1129	! --------------------------------------------------------------------------
1130	! **** QQMMAA - Conversion d'un entier type AAAAQQMM vers une date en clair.
1131	! --------------------------------------------------------------------------
1132	! Auteur:
1133	! -------
1134	! 92-05-27, J.M. Piriou.
1135	!
1136	! Modifications:
1137	! --------------
1138	!
1139	! --------------------------------------------------------------------------
1140
1141
1142	IMPLICIT NONE
1143	INTEGER(KIND=4) :: IAN
1144	INTEGER(KIND=4) :: IGRE
1145	INTEGER(KIND=4) :: ILOC
1146	INTEGER(KIND=4) :: IMM
1147	INTEGER(KIND=4) :: IQQ
1148	INTEGER(KIND=4) :: KDATD
1149	character() cdresd
1150	character*03 cljour
1151	iqq=mod(kdatd,100)
1152	iloc=kdatd/100
1153	imm=mod(iloc,100)
1154	ian=iloc/100
1155	call gregod(kdatd,1,igre)
1156	igre=mod(igre,7)
1157	if(igre == 0) then
1158	cljour='Lun'
1159	elseif(igre == 1) then
1160	cljour='Mar'
1161	elseif(igre == 2) then
1162	cljour='Mer'
1163	elseif(igre == 3) then
1164	cljour='Jeu'
1165	elseif(igre == 4) then
1166	cljour='Ven'
1167	elseif(igre == 5) then
1168	cljour='Sam'
1169	elseif(igre == 6) then
1170	cljour='Dim'
1171	endif
1172	write(cdresd,fmt='(a3,a1,i2,a1,i2.2,a1,i4.4)')&
1173	&cljour,' ',iqq,'.',imm,'.',ian
1174	end
1175	subroutine quant(kdate,kquant)
1176	! --------------------------------------------------------------
1177	! **** quant Quantieme de l'annee d'une date donnee.
1178	! --------------------------------------------------------------
1179	! Sujet:
1180	! Arguments explicites:
1181	! Arguments implicites:
1182	! Methode:
1183	! Externes:
1184	! Auteur: 1999-04, J.M. Piriou.
1185	! Modifications:
1186	! --------------------------------------------------------------
1187	! En entree:
1188	! kdate date au format AAAAMMQQ.
1189	! En sortie:
1190	! quantieme de l'annee (1 le 1er janvier, 32 le 1er fevrier, etc...)
1191	! --------------------------------------------------------------
1192
1193
1194	IMPLICIT NONE
1195	INTEGER(KIND=4) :: IBASE
1196	INTEGER(KIND=4) :: IEC
1197	INTEGER(KIND=4) :: KDATE
1198	INTEGER(KIND=4) :: KQUANT
1199	ibase=10000*(kdate/10000)+0101 ! 1er janvier de l'annee courante.
1200	call ecartdj(ibase,kdate,iec)
1201	kquant=iec+1
1202	end

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format