Changeset 5159 for LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dates.F90

Timestamp:

Aug 2, 2024, 9:58:25 PM (7 weeks ago)

Author:

abarral

Message:

Put dimensions.h and paramet.h into modules

File:

• LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dates.F90 (modified) (38 diffs)

LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/dates.F90

@@ -1 +1 @@
 subroutine dates_demo
 ! --------------------------------------------------------------
-!
+
 ! Conseils a l'utilisateur:
-!
+
 ! 1. VOUS COMPILEZ LES ENTIERS EN 32 BITS:
 ! Utilisez alors les routines
@@ -17 +17 @@
 ! les parametres subsequents assurant que seuls des entiers
 ! representables en 32 bits y soient utilises.
-!
+
 ! 2. VOUS COMPILEZ LES ENTIERS EN 64 BITS:
 ! Vous pouvez alors utiliser toutes les routines ci-dessus
@@ -30 +30 @@
 ! - amqhmsree_vers_dj: Conversion date gr�gorienne (en un seul r�el) > date julienne.
 ! - dj_vers_amqhmsree: Conversion date julienne > date gr�gorienne (en un seul r�el).
-!
-! --------------------------------------------------------------
-!
+
+! --------------------------------------------------------------
+
 ! D�finition des dates employ�es ci-dessous:
-!
+
 ! Date julienne DJ:
 !       Elle est compos�e d'un r�el.
 !       R1: Ce r�el cro�t de 1 tous les jours,
 !               et vaut 2451545.0 le 1er janvier 2000 � 12 UTC.
-!
+
 ! Date gr�gorienne "en clair" AMQHMS:
 !       Elle est compos�e de 5 entiers et d'un r�el.
@@ -80 +80 @@
 character*200 clzue,clze,clech
 character *(*) cdtit
-!
+
 !-------------------------------------------------
 ! Date de validit�.
 !-------------------------------------------------
-!
+
 zs=0.
 zsssss=psssss/3600.
@@ -95 +95 @@
 call dj_vers_amqhms(zdj,ianv,imov,iquv,ihev,imiv,zsv) ! date gr�gorienne de validit�.
 if(pstati < 3600.) then
-!
+
 !-------------------------------------------------
 ! Ech�ance en minutes.
 !-------------------------------------------------
-!
+
     zech=pstati/60. ; clzue='mn'
 elseif(pstati < 259200.) then
-!
+
 !-------------------------------------------------
 ! Ech�ance en heures.
 !-------------------------------------------------
-!
+
     zech=pstati/3600. ; clzue='h'
 else
-!
+
 !-------------------------------------------------
 ! Ech�ance en jours.
 !-------------------------------------------------
-!
+
     zech=pstati/86400. ; clzue='j'
 endif
-!
+
 ! Affichage de l'echeance avec deux chiffres apres la virgule.
-!
+
 write(clze,fmt='(f9.2)') zech
-!
+
 ! Si l'echeance est voisine d'un entier a mieux que 10**-2 pres,
 ! on l'affiche au format entier.
-!
+
 if(clze(len_trim(clze)-2:len_trim(clze)) == '.00') then
     clze=clze(1:len_trim(clze)-3)
@@ -130 +130 @@
 ilze=len_trim(clze)
 clech=clze(1:ilze)//clzue
-!
+
 !-------------------------------------------------
 ! Titre 3, de type
 ! BASE 2000.01.15 00:00 +72H VALID 2000.01.18 15:00.
 !-------------------------------------------------
-!
+
 if(imi == 0 .and. imiv == 0) then
-!
+
 !-------------------------------------------------
 ! Les minutes de base et validit� sont nulles.
 ! On ne les affiche pas.
 !-------------------------------------------------
-!
+
     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)')&
     &'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,'h UTC + ',clech(1:len_trim(clech))&
     &,', VALID ',iquv,'.',imov,'.',ianv,' ',ihev,'h UTC'
 else
-!
+
 !-------------------------------------------------
 ! Les minutes de base ou validit� sont non nulles.
 ! On les affiche.
 !-------------------------------------------------
-!
+
     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)')&
     &'BASE ',kqu,'.',kmo,'.',kan,' ',ihe,':',imi,' UTC + ',clech(1:len_trim(clech))&
@@ -207 +207 @@
 character*3 cljour(0:6)
 data cljour/'Dim','Lun','Mar','Mer','Jeu','Ven','Sam'/
-!
+
 !-------------------------------------------------
 ! Date courante � la f90.
 !-------------------------------------------------
-!
+
 clgol1=' '
 clgol2=' '
 clgol3=' '
 call date_and_time(clgol1,clgol2,clgol3,idatat)
-!
+
 !-------------------------------------------------
 ! clgol1 est du type "AAAAMMQQ".
 !-------------------------------------------------
-!
+
 read(clgol1,fmt='(i4,2i2)') kaaaa,kmm,kqq
-!
+
 !-------------------------------------------------
 ! clgol2 est du type "HHMMSS.SSS".
 !-------------------------------------------------
-!
+
 read(clgol2,fmt='(2i2)') khh,kmi
 read(clgol2(5:),fmt=*) zs
 kss=nint(zs)
 read(clgol1,fmt='(i8)') iaaaammqq
-!
+
 !-------------------------------------------------
 ! Jour de la semaine.
 !-------------------------------------------------
-!
+
 kjs=ijoursem(iaaaammqq)
 cdjs=cljour(kjs)
-!
+
 !-------------------------------------------------
 ! Date totale.
 !-------------------------------------------------
-!
+
 write(cddt,fmt='(i4.4,a,2(i2.2,a),2a,i2.2,a,i2.2,a,i2.2)') &
 &kaaaa,'_',kmm,'_',kqq,'_',cdjs,'_',khh,':',kmi,':',kss
@@ -253 +253 @@
 ! -------
 ! 1999-08-17, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree:
@@ -284 +284 @@
 idate1=20000101
 idate2=kaaaa*10000+kmm*100+kqq
-!
+
 !-------------------------------------------------
 ! Nombre de jours �coul�s entre la date
 ! d'entr�e � 0h UTC et le 1er janvier 2000 � 0h UTC.
 !-------------------------------------------------
-!
+
 call ecartdj(idate1,idate2,iecart)
-!
+
 !-------------------------------------------------
 ! Date julienne.
 !-------------------------------------------------
-!
+
 pdj=2451545.0- 0.5 +real(iecart)+real(khh)/24. &
 & +real(kmn)/1440.+ps/86400.
@@ -306 +306 @@
 ! -------
 ! 94-10-31, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree:
@@ -326 +326 @@
 ! En sortie:
 ! kdat2 date finale.
-!
+
 ! --------------------------------------------------------------------------
 ! Exemple: call DAPLUS(19940503,1,456,ires) fournira
@@ -373 +373 @@
 ! Cette routine est utilisable avec des entiers 32 bits ou 64 bits.
 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!
+
 ! -------------------------------------------------
 ! Date d'arrivee au jour pres.
@@ -409 +409 @@
 ! si l'ecart entre les deux dates est inferieur a 2**31 secondes,
 ! soit 68 ans!...
-!
+
 ! Au-dela de cette duree, les entiers doivent etre 64 bits.
 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -429 +429 @@
 INTEGER(KIND=4) :: KEC
 character*(*) cd1,cd2
-!
+
 ! -------------------------------------------------
 ! On lit les dates sur des entiers.
 ! -------------------------------------------------
-!
+
 read(cd1,fmt='(i8,3i2)') iamq1,ih1,im1,is1
-!
+
 ! -------------------------------------------------
 ! Calculs d'ecarts et de leur partition
 ! en multiples de 86400 et sous-multiples.
 ! -------------------------------------------------
-!
+
 isec=ih1*3600+im1*60+is1 ! nombre de secondes ecoulees depuis cd10h.
 idelta=kec+isec ! nombre de secondes entre cd10h et cd2.
 ireste=modulo(idelta,86400) ! nombre de secondes entre cd20h et cd2.
 iecjours=(idelta-ireste)/86400 ! nombre de jours entre cd10h et cd20h.
-!
+
 ! -------------------------------------------------
 ! Date d'arrivee au jour pres.
 ! -------------------------------------------------
-!
+
 call daplus(iamq1,1,iecjours,iamq2)
-!
+
 ! -------------------------------------------------
 ! Date finale a la seconde pres.
 ! -------------------------------------------------
-!
+
 ih2=ireste/3600
 ireste=ireste-3600*ih2
@@ -470 +470 @@
 ! -------
 ! 1999-08-17, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree:
@@ -485 +485 @@
 ! ps    seconde
 ! --------------------------------------------------------------------------
-!
+
 !-------------------------------------------------
 ! Nombre de jours entre le 1er janvier 2000 � 0 UTC
@@ -508 +508 @@
 REAL(KIND=8) :: ZFRAC
 zecart=pdj-2451544.5
-!
+
 !-------------------------------------------------
 ! Nombre entier de jours.
 !-------------------------------------------------
-!
+
 zfrac=modulo(zecart, 1._8 )
 iecart=nint(zecart-zfrac)
-!
+
 !-------------------------------------------------
 ! Date gr�gorienne associ�e.
 !-------------------------------------------------
-!
+
 idate1=20000101
 call daplusj(idate1,iecart,idate2)
@@ -526 +526 @@
 kmm=mod(knouv,100)
 kaaaa=knouv/100
-!
+
 !-------------------------------------------------
 ! Calcul de des heure, minute et seconde.
 !-------------------------------------------------
-!
+
 zfrac=(zecart-real(iecart))*24.
 khh=int(zfrac)
@@ -544 +544 @@
 ! -------
 ! 2002-11, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree:
@@ -561 +561 @@
 REAL(KIND=8) :: ZS
 INTEGER(KIND=4) :: iaaaa,imm,iqq,ihh,imn
-!
+
 !-------------------------------------------------
 ! Conversion gr�gorien julien; cible 5 entiers et un r�el.
 !-------------------------------------------------
-!
+
 call dj_vers_amqhms(pdj,iaaaa,imm,iqq,ihh,imn,zs)
-!
+
 !-------------------------------------------------
 ! On passe de ces 5 entiers et un r�el � un seul r�el.
 !-------------------------------------------------
-!
+
 pgrer=real(iaaaa)*10000.+real(imm)*100. &
 & + real(iqq)+real(ihh)/100. &
@@ -583 +583 @@
 ! -------
 ! 2002-11, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree:
@@ -600 +600 @@
 REAL(KIND=8) :: ZS,zloc
 INTEGER(KIND=4) :: iaaaa,imm,iqq,ihh,imn,iloc
-!
+
 !-------------------------------------------------
 ! On passe de cette date gr�gorienne donn�e
 ! comme un seul r�el � 5 entiers et un r�el.
 !-------------------------------------------------
-!
+
 iloc=int(pgrer)
 iqq=mod(iloc,100)
@@ -617 +617 @@
 imn=mod(iloc,100)
 ihh=iloc/100
-!
+
 !-------------------------------------------------
 ! Conversion gr�gorien julien; cible 5 entiers et un r�el.
 !-------------------------------------------------
-!
+
 call amqhms_vers_dj(iaaaa,imm,iqq,ihh,imn,zs,pdj)
 end
@@ -631 +631 @@
 ! -------
 ! 97-01-09, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree: kopt option de precision sur les dates:
@@ -703 +703 @@
 ! si l'ecart entre les deux dates est inferieur a 2**31 jours,
 ! soit 5879489 ans!...
-!
+
 ! Au-dela de cette duree, les entiers doivent etre 64 bits.
 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!
+
 ! -------------------------------------------------
 ! Ecart entre les deux dates au jour pres.
@@ -742 +742 @@
 ! si l'ecart entre les deux dates est inferieur a 2**31 secondes,
 ! soit 68 ans!...
-!
+
 ! Au-dela de cette duree, les entiers doivent etre 64 bits.
 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@@ -759 +759 @@
 INTEGER(KIND=4) :: KECQ
 character*(*) cd1,cd2
-!
+
 ! -------------------------------------------------
 ! On lit les dates sur des entiers.
 ! -------------------------------------------------
-!
+
 read(cd1,fmt='(i8,3i2)') iamq1,ih1,im1,is1
 read(cd2,fmt='(i8,3i2)') iamq2,ih2,im2,is2
-!
+
 ! -------------------------------------------------
 ! Ecart entre les deux dates au jour pres.
 ! -------------------------------------------------
-!
+
 call ecartd(iamq1,iamq2,1,kecq)
-!
+
 ! -------------------------------------------------
 ! Ecart en secondes.
 ! -------------------------------------------------
-!
+
 kec=kecq*86400+(ih2-ih1)*3600+(im2-im1)*60+is2-is1
 end
@@ -786 +786 @@
 ! -------
 ! 92-05-27, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree: kopt option de precision sur les dates:
@@ -837 +837 @@
 INTEGER(KIND=4) :: KOPT
 data idebm/0,31,59,90,120,151,181,212,243,273,304,334/
-!
+
 ! --------------------------------------------------------------------------
 ! **      1. Calcul du nb de jours separant ki2 du 1er janv 1900
-!
+
 ! *       1.1 Extraction des quantieme, mois et annee
 if(kopt == 1) then
@@ -909 +909 @@
 ! --------------------------------------------------------------------------
 ! **      2. Calcul du nb de jours separant ii1 du 1er janv 1900
-!
+
 ! *       2.1 Extraction des quantieme, mois et annee
 ii1=19000101
@@ -952 +952 @@
 ! -------
 ! 92-05-27, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree: kopt option de precision sur les dates:
@@ -1004 +1004 @@
 ! --------------------------------------------------------------------------
 ! **   On determine la date approximative d'arrivee en annees decimales
-!
+
 if(kopt == 1) then
   ! Date de type AAAAMMQQ
@@ -1026 +1026 @@
 ! --------------------------------------------------------------------------
 ! **   On determine la date en clair ii2p associee a la date decimale
-!
+
 iaaaa=int(zarrdec)
 zarrdec=12.*(zarrdec-real(iaaaa))
@@ -1035 +1035 @@
 ! --------------------------------------------------------------------------
 ! **   On calcule le nombre de jours separant 19000101 de ii2p
-!
+
 call gregod(ii2p,1,igii2p)
 imod=mod(kgre,iconv)
@@ -1042 +1042 @@
 ! --------------------------------------------------------------------------
 ! **   On avance de iec jours par rapport a ii2p
-!
+
 ! *       L'annee est-elle bissextile?
 ! Une annee est bissextile ssi elle est
@@ -1071 +1071 @@
 ! --------------------------------------------------------------------------
 ! **   On met en forme la date finale
-!
+
 idat=iqq+imm*100+iaaaa*10000
 if(kopt == 2) then
@@ -1101 +1101 @@
 ! -------
 ! 94-10-31, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------
 ! En entree:
@@ -1133 +1133 @@
 ! -------
 ! 92-05-27, J.M. Piriou.
-!
+
 ! Modifications:
 ! --------------
-!
+
 ! --------------------------------------------------------------------------