Changeset 236 for IOIPSL

Timestamp:

01/21/08 14:44:35 (17 years ago)

Author:

bellier

Message:

calendar :

• modification of tests to get rid of a truncation error in the determination of the date change.
• addition in "itau2ymds" of a message to inform usage of undefined elements (call with "ioconf_startdate" not done)

restcom :

• some orthographic correction

JB

Location:

IOIPSL/trunk/src

Files:

• calendar.f90 (modified) (9 diffs)
• restcom.f90 (modified) (11 diffs)

IOIPSL/trunk/src/calendar.f90

@@ -5 +5 @@
 !- This is the calendar which going to be used to do all
 !- calculations on time. Three types of calendars are possible :
-!-  - gregorian : The normal calendar. The time origin for the
-!-                julian day in this case is 24 Nov -4713
-!-  - nolap : A 365 day year without leap years.
-!-            The origin for the julian days is in this case 1 Jan 0
-!-  - xxxd : Year of xxx days with month of equal length.
-!-           The origin for the julian days is then also 1 Jan 0
+!-
+!-  - gregorian :
+!-      The normal calendar. The time origin for the
+!-      julian day in this case is 24 Nov -4713
+!-      (other names : 'standard','proleptic_gregorian')
+!-  - noleap :
+!-      A 365 day year without leap years.
+!-      The origin for the julian days is in this case 1 Jan 0
+!-      (other names : '365_day','365d')
+!-  - all_leap :
+!-      A 366 day year with leap years.
+!-      The origin for the julian days is in this case ????
+!-      (other names : '366_day','366d'
+!-  - julian :
+!-      same as gregorian, but with all leap century years
+!-  - xxxd :
+!-      Year of xxx days with month of equal length.
+!-      The origin for the julian days is then also 1 Jan 0
+!-
 !- As one can see it is difficult to go from one calendar to the other.
 !- All operations involving julian days will be wrong.
 !- This calendar will lock as soon as possible
-!- the length of the year and  forbid any further modification.
+!- the length of the year and forbid any further modification.
 !-
 !- For the non leap-year calendar the method is still brute force.
@@ -235 +248 @@
   INTEGER :: l,n,i,jd,j,d,m,y,ml
   INTEGER :: add_day
+  REAL :: eps_day = SPACING(one_day)
 !---------------------------------------------------------------------
   lock_one_year = .TRUE.
@@ -240 +254 @@
   jd = julian_day
   sec = julian_sec
-  IF (sec > one_day) THEN
+  IF (sec > (one_day-eps_day)) THEN
     add_day = INT(sec/one_day)
     sec = sec-add_day*one_day
     jd = jd+add_day
   ENDIF
-  IF (sec < 0.) THEN
+  IF (sec < -eps_day) THEN
     sec = sec+one_day
     jd = jd-1
@@ -295 +309 @@
 SUBROUTINE tlen2itau (input_str,dt,date,itau)
 !---------------------------------------------------------------------
-!- This subroutine transforms a sting containing a time length
+!- This subroutine transforms a string containing a time length
 !- into a number of time steps.
 !- To do this operation the date (in julian days is needed as the
@@ -388 +402 @@
 REAL FUNCTION itau2date (itau,date0,deltat)
 !---------------------------------------------------------------------
-!- This function transforms itau into a date. The date whith which
+!- This function transforms itau into a date. The date with which
 !- the time axis is going to be labeled
 !-
@@ -410 +424 @@
 !===
 !-
-SUBROUTINE itau2ymds (itau,deltat,year,month,date,sec)
-!---------------------------------------------------------------------
-!- This subroutine transforms itau into a date. The date whith which
+SUBROUTINE itau2ymds (itau,deltat,year,month,day,sec)
+!---------------------------------------------------------------------
+!- This subroutine transforms itau into a date. The date with which
 !- the time axis is going to be labeled
 !-
@@ -420 +434 @@
 !-
 !- OUTPUT
-!-   year : year
+!-   year  : year
 !-   month : month
-!-   date : date
-!-   sec  : seconds since midnight
+!-   day   : day
+!-   sec   : seconds since midnight
 !---------------------------------------------------------------------
   IMPLICIT NONE
@@ -430 +444 @@
   REAL,INTENT(IN)    :: deltat
 !-
-  INTEGER,INTENT(OUT) :: year,month,date
+  INTEGER,INTENT(OUT) :: year,month,day
   REAL,INTENT(OUT)    :: sec
 !-
@@ -436 +450 @@
   REAL    :: julian_sec
 !---------------------------------------------------------------------
+  IF (.NOT.lock_startdate) THEN
+    CALL ipslerr (2,'itau2ymds', &
+ &   'You try to call this function, itau2ymds, but you didn''t', &
+ &   ' call ioconf_startdate to initialize date0 in calendar.', &
+ &   ' Please call ioconf_startdate before itau2ymds.')
+  ENDIF
   julian_day = start_day
   julian_sec = start_sec+REAL(itau)*deltat
-!-
-  CALL ju2ymds_internal (julian_day,julian_sec,year,month,date,sec)
+  CALL ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)
 !-----------------------
 END SUBROUTINE itau2ymds

IOIPSL/trunk/src/restcom.f90

@@ -37 +37 @@
 !-
   INTEGER,PARAMETER :: &
- &  max_var=200, max_file=50, max_dim=NF90_MAX_VAR_DIMS
+ &  max_var=500, max_file=50, max_dim=NF90_MAX_VAR_DIMS
 !-
   CHARACTER(LEN=9),SAVE :: calend_str='unknown'
@@ -45 +45 @@
 !-
   INTEGER,SAVE :: nbfiles = 0 
-  INTEGER,SAVE :: netcdf_id(max_file,2) = -1
+  INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1
 !-
 ! Description of the content of the 'in' files and the 'out' files.
@@ -67 +67 @@
 ! Time step and time origine in the input file.
 !-
-  REAL,SAVE :: deltat(max_file), timeorig(max_file)
+  REAL,DIMENSION(max_file),SAVE :: deltat,timeorig
 !-
 ! Description of the axes in the output file
@@ -74 +74 @@
 !   itau_out  : Time step which is written on this index of the file
 !-
-  INTEGER,SAVE :: tstp_out(max_file)
-  INTEGER,SAVE :: itau_out(max_file)
+  INTEGER,DIMENSION(max_file),SAVE :: tstp_out,itau_out
 !-
 ! Description of the axes in the output file
 !-
+! For the ?ax_infs variable the following order is used :
+!   ?ax_infs (if,in,1) = size of axis
+!   ?ax_infs (if,in,2) = id of dimension
 ! Number of x,y and z axes in the output file : 
 !   ?ax_nb(if)
-! For the ?ax_infs variable the following order is used :
-!   ?ax_infs (if, in,1) = size of axis
-!   ?ax_infs (if, in,2) = id of dimension
-!-
-  INTEGER,SAVE :: &
- &  xax_infs(max_file,max_dim,2), yax_infs(max_file,max_dim,2),&
- &  zax_infs(max_file,max_dim,2), qax_infs(max_file,max_dim,2)
-  INTEGER,SAVE :: &
- &  xax_nb(max_file)=0, yax_nb(max_file)=0, &
- &  zax_nb(max_file)=0, qax_nb(max_file)=0
+!-
+  INTEGER,DIMENSION(max_file,max_dim,2),SAVE :: &
+ &  xax_infs,yax_infs,zax_infs
+  INTEGER,DIMENSION(max_file),SAVE :: &
+ &  xax_nb=0,yax_nb=0,zax_nb=0
 !-
 ! Description of the time axes in the input and output files
@@ -656 +653 @@
   INTEGER :: ncfid,iret,it,iax,iv,tszij
   INTEGER,ALLOCATABLE :: tmp_index(:,:)
-  REAL,ALLOCATABLE  :: tmp_julian(:,:)
-  CHARACTER(LEN=80)  ::  itau_orig,tax_orig,calendar
+  REAL,ALLOCATABLE :: tmp_julian(:,:)
+  CHARACTER(LEN=80) :: itau_orig,tax_orig,calendar
   CHARACTER(LEN=9) :: tmp_cal
   INTEGER :: year0,month0,day0,hours0,minutes0,seci
-  REAL ::sec0,un_jour,un_an,date0_ju,ttmp
+  REAL :: sec0,un_jour,un_an,date0_ju,ttmp
   CHARACTER :: strc
 !-
@@ -718 +715 @@
     itau_orig = &
       itau_orig(INDEX(itau_orig,'since')+6:LEN_TRIM(itau_orig))
-    iret = NF90_GET_ATT &
- &           (ncfid,tind_varid_in(fid),'tstep_sec',timestep)
-!---
-!-- This time origine will dominate as it is linked to the time steps.
+    iret = &
+ &    NF90_GET_ATT(ncfid,tind_varid_in(fid),'tstep_sec',timestep)
+!---
+!-- This time origin will dominate as it is linked to the time steps.
 !---
     READ (UNIT=itau_orig,FMT='(I4.4,5(a,I2.2))') &
@@ -1662 +1659 @@
     IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
   ELSE
-    CALL ipslerr (3,'resput_opp_r1d', &
+    CALL ipslerr (3,'restput_opp_r1d', &
       'Unable to performe an operation on this variable as it has', &
       'a second and third dimension',vname_q)
@@ -1711 +1708 @@
        scal,req_sz,buff_tmp2)
   ELSE
-    CALL ipslerr (3,'resput_opp_r1d', &
+    CALL ipslerr (3,'restput_opp_r1d', &
       'The operation you wish to do on the variable for the ', &
        & 'restart file is not allowed.',topp)
@@ -1765 +1762 @@
     IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
   ELSE
-    CALL ipslerr (3,'resput_opp_r2d', &
+    CALL ipslerr (3,'restput_opp_r2d', &
       'Unable to performe an operation on this variable as it has', &
       'a second and third dimension',vname_q)
@@ -1771 +1768 @@
 !-
   IF (jjm < 1) THEN
-    CALL ipslerr (3,'resput_opp_r2d', &
+    CALL ipslerr (3,'restput_opp_r2d', &
       'Please specify a second dimension which is the', &
       'layer on which the operations are performed',vname_q)
@@ -1824 +1821 @@
     ENDDO
   ELSE
-    CALL ipslerr (3,'resput_opp_r2d', &
+    CALL ipslerr (3,'restput_opp_r2d', &
       'The operation you wish to do on the variable for the ', &
       'restart file is not allowed.',topp)