New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12080 for utils/tools/SIREN/src/date.f90 – NEMO

Ignore:
Timestamp:
2019-12-06T10:30:14+01:00 (5 years ago)
Author:
jpaul
Message:

update nemo trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • utils/tools/SIREN/src/date.f90

    r9598 r12080  
    33!---------------------------------------------------------------------- 
    44! 
    5 ! MODULE: date 
    6 ! 
    75! DESCRIPTION: 
    86!> @brief This module provide the calculation of Julian dates, and 
    … …  
    117115!> 
    118116!> @author J.Paul 
    119 ! REVISION HISTORY: 
     117!> 
    120118!> @date November, 2013 - Initial Version 
    121119! 
    122120!> @note This module is based on Perderabo's date calculator (ksh) 
    123 !> @note Software governed by the CeCILL licence     (./LICENSE) 
     121!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    124122!> 
    125123!> @todo 
    … …  
    127125!---------------------------------------------------------------------- 
    128126MODULE date 
     127 
    129128   USE global                          ! global variable 
    130129   USE kind                            ! F90 kind parameter 
    131130   USE fct                             ! basic useful function 
    132131   USE logger                          ! log file manager 
     132 
    133133   IMPLICIT NONE 
    134134   ! NOTE_avoid_public_variables_if_possible 
    … …  
    143143   PUBLIC :: date_today         !< return the date of the day at 12:00:00 
    144144   PUBLIC :: date_now           !< return the date and time 
     145   PUBLIC :: date_time          !< return the date and time in milliseconds 
    145146   PUBLIC :: date_init          !< initialized date structure form julian day or year month day 
    146147   PUBLIC :: date_print         !< print the date with format YYYY-MM-DD hh:mm:ss 
    … …  
    207208 
    208209CONTAINS 
     210   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     211   FUNCTION date_print(td_date, cd_fmt) & 
     212         & RESULT (cf_date) 
    209213   !------------------------------------------------------------------- 
    210214   !> @brief This function print the date and time with  
    211215   !> format YYYY/MM/DD hh:mm:ss. 
    212216   !> @details 
    213    !> Optionally, you could specify output format. However it will be only apply 
    214    !> to year, month, day. 
    215    !> 
    216    !> @author J.Paul 
    217    !> @date November, 2013 - Initial Version 
    218    ! 
     217   !> Optionally, you could specify output format. However it will be  
     218   !> only apply to year, month, day. 
     219   !> 
     220   !> @author J.Paul 
     221   !> @date November, 2013 - Initial Version 
     222   !> 
    219223   !> @param[in] td_date   date strutcutre 
    220224   !> @param[in] cd_fmt    ouput format (only for year,month,day) 
    221225   !> @return date in format YYYY-MM-DD hh:mm:ss 
    222226   !------------------------------------------------------------------- 
    223    CHARACTER(LEN=lc) FUNCTION date_print(td_date, cd_fmt) 
    224       IMPLICIT NONE 
     227 
     228      IMPLICIT NONE 
     229 
    225230      ! Argument    
    226231      TYPE(TDATE)     , INTENT(IN) :: td_date 
    227232      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_fmt 
     233 
     234      ! function 
     235      CHARACTER(LEN=lc)            :: cf_date  
    228236      !---------------------------------------------------------------- 
    229237 
    230238      IF( PRESENT(cd_fmt) )THEN 
    231          WRITE(date_print,TRIM(cd_fmt)) & 
    232          &    td_date%i_year,td_date%i_month,td_date%i_day 
     239         WRITE(cf_date,TRIM(cd_fmt)) & 
     240            &    td_date%i_year,td_date%i_month,td_date%i_day 
    233241      ELSE 
    234          WRITE(date_print,cm_fmtdate) & 
    235          &    td_date%i_year,td_date%i_month,td_date%i_day, & 
    236          &    td_date%i_hour,td_date%i_min,td_date%i_sec 
     242         WRITE(cf_date,cm_fmtdate) & 
     243            &    td_date%i_year,td_date%i_month,td_date%i_day, & 
     244            &    td_date%i_hour,td_date%i_min,td_date%i_sec 
    237245      ENDIF 
    238246 
    239247   END FUNCTION date_print 
     248   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     249   FUNCTION date_leapyear(td_date) & 
     250         & RESULT (lf_leap) 
    240251   !------------------------------------------------------------------- 
    241252   !> @brief This function check if year is a leap year. 
    … …  
    243254   !> @author J.Paul 
    244255   !> @date November, 2013 - Initial Version 
    245    ! 
     256   !> 
    246257   !> @param[in] td_date   date strutcutre 
    247258   !> @return true if year is leap year 
    248259   !------------------------------------------------------------------- 
    249    LOGICAL FUNCTION date_leapyear(td_date) 
    250       IMPLICIT NONE 
     260 
     261      IMPLICIT NONE 
     262 
    251263      ! Argument    
    252264      TYPE(TDATE), INTENT(IN) :: td_date 
    253       !---------------------------------------------------------------- 
    254  
    255       date_leapyear=.false. 
     265 
     266      ! function 
     267      LOGICAL                 :: lf_leap 
     268      !---------------------------------------------------------------- 
     269 
     270      lf_leap=.false. 
    256271      IF( (MOD(td_date%i_year,100_i4)==0) )THEN 
    257272         IF( (MOD(td_date%i_year,400_i4)==0) )THEN 
    258             date_leapyear=.true. 
     273            lf_leap=.true. 
    259274         ENDIF 
    260275      ELSE 
    261276         IF( (MOD(td_date%i_year,4_i4)==0) )THEN 
    262             date_leapyear=.true. 
     277            lf_leap=.true. 
    263278         ENDIF 
    264       ENDIF       
     279      ENDIF 
    265280 
    266281   END FUNCTION date_leapyear 
     282   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     283   FUNCTION date_now() & 
     284         & RESULT (tf_date) 
    267285   !------------------------------------------------------------------- 
    268286   !> @brief This function return the current date and time. 
    … …  
    270288   !> @author J.Paul 
    271289   !> @date November, 2013 - Initial Version 
    272    ! 
     290   !> 
    273291   !> @return current date and time in a date structure 
    274292   !------------------------------------------------------------------- 
    275    TYPE(TDATE) FUNCTION date_now() 
    276       IMPLICIT NONE 
     293 
     294      IMPLICIT NONE 
     295 
     296      ! function 
     297      TYPE(TDATE) :: tf_date 
     298 
    277299      ! local variable 
    278300      INTEGER(sp), DIMENSION(8) :: il_values 
    … …  
    281303      CALL DATE_AND_TIME( values= il_values) 
    282304 
    283       date_now=date_init( il_values(1), il_values(2), il_values(3), & 
    284       &                   il_values(5), il_values(6), il_values(7) ) 
     305      tf_date=date_init( il_values(1), il_values(2), il_values(3), & 
     306         &               il_values(5), il_values(6), il_values(7) ) 
    285307 
    286308   END FUNCTION date_now 
    287    !------------------------------------------------------------------- 
    288    !> @brief This function return the date of the day at 12:00:00. 
    289    !> 
    290    !> @author J.Paul 
    291    !> @date November, 2013 - Initial Version 
    292    ! 
    293    !> @return date of the day at 12:00:00 in a date structure 
    294    !------------------------------------------------------------------- 
    295    TYPE(TDATE) FUNCTION date_today() 
    296       IMPLICIT NONE 
     309   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     310   SUBROUTINE date_time() 
     311   !------------------------------------------------------------------- 
     312   !> @brief This subroutine print the current date and time in milliseconds. 
     313   !> 
     314   !> @author J.Paul 
     315   !> @date August, 2017 - Initial Version 
     316   !------------------------------------------------------------------- 
     317 
     318      IMPLICIT NONE 
     319 
    297320      ! local variable 
    298321      INTEGER(sp), DIMENSION(8) :: il_values 
     322      CHARACTER(LEN=lc)         :: cl_fmtdate = &  !< date and time format 
     323      &  "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2'.',i0.3)"       
    299324      !---------------------------------------------------------------- 
    300325 
    301326      CALL DATE_AND_TIME( values= il_values) 
    302327 
    303       date_today=date_init( il_values(1), il_values(2), il_values(3), 12_i4 ) 
     328      WRITE(*,cl_fmtdate) il_values(1),il_values(2),il_values(3),il_values(5),il_values(6),il_values(7),il_values(8) 
     329 
     330   END SUBROUTINE date_time 
     331   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     332   FUNCTION date_today() & 
     333         & RESULT (tf_date) 
     334   !------------------------------------------------------------------- 
     335   !> @brief This function return the date of the day at 12:00:00. 
     336   !> 
     337   !> @author J.Paul 
     338   !> @date November, 2013 - Initial Version 
     339   !> 
     340   !> @return date of the day at 12:00:00 in a date structure 
     341   !------------------------------------------------------------------- 
     342 
     343      IMPLICIT NONE 
     344       
     345      ! function 
     346      TYPE(TDATE) :: tf_date 
     347 
     348      ! local variable 
     349      INTEGER(sp), DIMENSION(8) :: il_values 
     350      !---------------------------------------------------------------- 
     351 
     352      CALL DATE_AND_TIME( values= il_values) 
     353 
     354      tf_date=date_init( il_values(1), il_values(2), il_values(3), 12_i4 ) 
    304355 
    305356   END FUNCTION date_today 
     357   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     358   FUNCTION date__init_fmtdate(cd_datetime, td_dateo) & 
     359         & RESULT (tf_date) 
    306360   !------------------------------------------------------------------- 
    307361   !> @brief This function initialized date structure from a character  
    … …  
    313367   !> @author J.Paul 
    314368   !> @date November, 2013 - Initial Version 
    315    ! 
     369   !> @date April, 2019 
     370   !> - check time units CF convention, raise error if not 
     371   !> 
    316372   !> @param[in] cd_date   date in format YYYY-MM-DD hh:mm:ss 
    317373   !> @param[in] td_dateo  new date origin for pseudo julian day 
    318374   !> @return date structure 
    319375   !------------------------------------------------------------------- 
    320    TYPE(TDATE) FUNCTION date__init_fmtdate(cd_datetime, td_dateo) 
    321       IMPLICIT NONE 
     376 
     377      IMPLICIT NONE 
     378 
    322379      ! Argument    
    323380      CHARACTER(LEN=*), INTENT(IN)  :: cd_datetime 
    324381      TYPE(TDATE),      INTENT(IN), OPTIONAL :: td_dateo 
     382 
     383      ! function 
     384      TYPE(TDATE)                   :: tf_date 
    325385 
    326386      ! local variable 
    … …  
    334394      CHARACTER(LEN=lc) :: cl_min 
    335395      CHARACTER(LEN=lc) :: cl_sec 
    336  
    337       INTEGER(i4) :: il_year 
    338       INTEGER(i4) :: il_month 
    339       INTEGER(i4) :: il_day 
    340       INTEGER(i4) :: il_hour 
    341       INTEGER(i4) :: il_min 
    342       INTEGER(i4) :: il_sec 
     396      CHARACTER(LEN=lc) :: cl_msg 
     397 
     398      INTEGER(i4)       :: il_year 
     399      INTEGER(i4)       :: il_month 
     400      INTEGER(i4)       :: il_day 
     401      INTEGER(i4)       :: il_hour 
     402      INTEGER(i4)       :: il_min 
     403      INTEGER(i4)       :: il_sec 
    343404      !---------------------------------------------------------------- 
    344405 
    … …  
    355416      READ(cl_day, *) il_day 
    356417      cl_hour = fct_split(cl_time,1,':') 
    357       READ(cl_hour, *) il_hour 
     418      IF( TRIM(cl_hour) /= '' )THEN 
     419         READ(cl_hour, *) il_hour 
     420      ELSE 
     421         WRITE(cl_msg,*) "time units not conform to CF conventions" 
     422         CALL logger_error(cl_msg) 
     423         il_hour=0 
     424      ENDIf 
    358425      cl_min  = fct_split(cl_time,2,':') 
    359       READ(cl_min, *) il_min 
     426      IF( TRIM(cl_min) /= '' )THEN 
     427         READ(cl_min, *) il_min 
     428      ELSE 
     429         WRITE(cl_msg,*) "time units not conform to CF conventions" 
     430         CALL logger_error(cl_msg) 
     431         il_min=0 
     432      ENDIf 
    360433      cl_sec  = fct_split(cl_time,3,':') 
    361       READ(cl_sec, *) il_sec 
    362  
    363       date__init_fmtdate = date_init( il_year, il_month, il_day, il_hour, & 
    364       &                               il_min, il_sec, td_dateo=td_dateo ) 
     434      IF( TRIM(cl_sec) /= '' )THEN 
     435         READ(cl_sec, *) il_sec 
     436      ELSE 
     437         WRITE(cl_msg,*) "time units not conform to CF conventions" 
     438         CALL logger_error(cl_msg) 
     439         il_sec=0 
     440      ENDIf 
     441 
     442      tf_date = date_init( il_year, il_month, il_day, il_hour, & 
     443         &                 il_min, il_sec, td_dateo=td_dateo ) 
    365444 
    366445   END FUNCTION date__init_fmtdate 
     446   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     447   FUNCTION date__init_jd(dd_jd, td_dateo) & 
     448         & RESULT (tf_date) 
    367449   !------------------------------------------------------------------- 
    368450   !> @brief This function initialized date structure from julian day.<br/> 
    … …  
    373455   !> @author J.Paul 
    374456   !> @date November, 2013 - Initial Version 
    375    ! 
     457   !> 
    376458   !> @param[in] dd_jd     julian day 
    377459   !> @param[in] td_dateo  new date origin for pseudo julian day 
    378    ! 
     460   !> 
    379461   !> @return date structure of julian day 
    380462   !------------------------------------------------------------------- 
    381    TYPE(TDATE) FUNCTION date__init_jd(dd_jd, td_dateo) 
    382       IMPLICIT NONE 
     463 
     464      IMPLICIT NONE 
     465 
    383466      !Argument 
    384467      REAL(dp),    INTENT(IN)  :: dd_jd 
    385468      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo 
     469 
     470      ! function 
     471      TYPE(TDATE)              :: tf_date 
    386472      !---------------------------------------------------------------- 
    387473      IF( PRESENT(td_dateo) )THEN 
    … …  
    389475 
    390476         ! pseudo julian day with origin dateo 
    391          date__init_jd%d_jc=dd_jd 
    392          date__init_jd%k_jcsec=date__jd2sec(dd_jd) 
     477         tf_date%d_jc=dd_jd 
     478         tf_date%k_jcsec=date__jd2sec(dd_jd) 
    393479 
    394480         ! convert to truly julian day 
    395          CALL date__jc2jd(date__init_jd, td_dateo) 
     481         CALL date__jc2jd(tf_date, td_dateo) 
    396482      ELSE 
    397          date__init_jd%d_jd=dd_jd 
    398          date__init_jd%k_jdsec=date__jd2sec(dd_jd) 
     483         tf_date%d_jd=dd_jd 
     484         tf_date%k_jdsec=date__jd2sec(dd_jd) 
    399485 
    400486         ! compute CNES julian day 
    401          CALL date__jd2jc(date__init_jd) 
     487         CALL date__jd2jc(tf_date) 
    402488      ENDIF 
    403489 
    404490      ! check input data 
    405       CALL date__check(date__init_jd) 
     491      CALL date__check(tf_date) 
    406492 
    407493      ! compute year month day hour min sec  
    408       CALL date__jd2ymd(date__init_jd) 
     494      CALL date__jd2ymd(tf_date) 
    409495 
    410496      ! compute day of the wekk 
    411       CALL date__jd2dow(date__init_jd) 
     497      CALL date__jd2dow(tf_date) 
    412498 
    413499      !compute last day of the month 
    414       date__init_jd%i_lday=date__lastday(date__init_jd) 
     500      tf_date%i_lday=date__lastday(tf_date) 
    415501 
    416502   END FUNCTION date__init_jd 
     503   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     504   FUNCTION date__init_nsec(kd_nsec, td_dateo) & 
     505         & RESULT (tf_date) 
    417506   !------------------------------------------------------------------- 
    418507   !> @brief This function initialized date structure from number of  
    … …  
    423512   !> @author J.Paul 
    424513   !> @date November, 2013 - Initial Version 
    425    ! 
     514   !> 
    426515   !> @param[in] kd_nsec   number of second since julian day origin 
    427516   !> @param[in] td_dateo  new date origin for pseudo julian day 
    428    ! 
     517   !> 
    429518   !> @return date structure of julian day 
    430519   !------------------------------------------------------------------- 
    431    TYPE(TDATE) FUNCTION date__init_nsec(kd_nsec, td_dateo) 
    432       IMPLICIT NONE 
     520 
     521      IMPLICIT NONE 
     522 
    433523      !Argument 
    434524      INTEGER(i8), INTENT(IN)  :: kd_nsec 
    435525      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo 
     526 
     527      ! function 
     528      TYPE(TDATE)              :: tf_date 
    436529      !---------------------------------------------------------------- 
    437530      IF( PRESENT(td_dateo) )THEN 
    438          date__init_nsec=date_init( date__sec2jd(kd_nsec), td_dateo ) 
     531         tf_date=date_init( date__sec2jd(kd_nsec), td_dateo ) 
    439532      ELSE 
    440          date__init_nsec=date_init( date__sec2jd(kd_nsec) ) 
     533         tf_date=date_init( date__sec2jd(kd_nsec) ) 
    441534      ENDIF 
    442535 
    443536   END FUNCTION date__init_nsec 
     537   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     538   FUNCTION date__init_ymd(id_year, id_month, id_day, & 
     539         &                 id_hour, id_min, id_sec,   & 
     540         &                 td_dateo) & 
     541         & RESULT (tf_date) 
    444542   !------------------------------------------------------------------- 
    445543   !> @brief This function initialized date structure form year month day 
    … …  
    458556   !> @param[in] id_sec 
    459557   !> @param[in] td_dateo  new date origin for pseudo julian day 
    460    ! 
     558   !> 
    461559   !> @return date structure of year month day 
    462560   !------------------------------------------------------------------- 
    463    TYPE(TDATE) FUNCTION date__init_ymd(id_year, id_month, id_day,  & 
    464    &                                   id_hour, id_min, id_sec, & 
    465    &                                   td_dateo) 
    466       IMPLICIT NONE 
     561 
     562      IMPLICIT NONE 
     563 
    467564      !Argument 
    468565      INTEGER(i4), INTENT(IN) :: id_year 
    … …  
    473570      INTEGER(i4), INTENT(IN), OPTIONAL :: id_sec 
    474571      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo 
    475       !---------------------------------------------------------------- 
    476       date__init_ymd%i_year=id_year 
    477       date__init_ymd%i_month=id_month 
    478       date__init_ymd%i_day=id_day 
     572 
     573      ! function 
     574      TYPE(TDATE)              :: tf_date 
     575      !---------------------------------------------------------------- 
     576      tf_date%i_year=id_year 
     577      tf_date%i_month=id_month 
     578      tf_date%i_day=id_day 
    479579      IF( PRESENT(id_hour) )THEN 
    480          date__init_ymd%i_hour=id_hour 
     580         tf_date%i_hour=id_hour 
    481581      ENDIF 
    482582      IF( PRESENT(id_min) )THEN 
    483          date__init_ymd%i_min=id_min 
     583         tf_date%i_min=id_min 
    484584      ENDIF    
    485585      IF( PRESENT(id_sec) )THEN    
    486          date__init_ymd%i_sec=id_sec 
     586         tf_date%i_sec=id_sec 
    487587      ENDIF    
    488588      ! check input data 
    489       CALL date__check(date__init_ymd) 
     589      CALL date__check(tf_date) 
    490590 
    491591      ! compute julian day 
    492       CALL date__ymd2jd(date__init_ymd) 
     592      CALL date__ymd2jd(tf_date) 
    493593 
    494594      IF( PRESENT(td_dateo) )THEN 
    495595         CALL date__check(td_dateo) 
    496596         ! compute julian day with origin dateo 
    497          CALL date__jd2jc(date__init_ymd, td_dateo)          
     597         CALL date__jd2jc(tf_date, td_dateo)          
    498598      ELSE 
    499599         ! compute CNES julian day 
    500          CALL date__jd2jc(date__init_ymd) 
     600         CALL date__jd2jc(tf_date) 
    501601      ENDIF       
    502602 
    503603      ! compute day of the week 
    504       CALL date__jd2dow(date__init_ymd) 
     604      CALL date__jd2dow(tf_date) 
    505605 
    506606      !compute last day of the month 
    507       date__init_ymd%i_lday=date__lastday(date__init_ymd) 
     607      tf_date%i_lday=date__lastday(tf_date) 
    508608 
    509609   END FUNCTION date__init_ymd 
     610   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     611   FUNCTION date__diffdate(td_date1, td_date2) & 
     612         & RESULT (df_diff) 
    510613   !------------------------------------------------------------------- 
    511614   !> @brief This function compute number of day between two dates:  
    512615   !> nday= date1 - date2 
    513    ! 
    514    !> @author J.Paul 
    515    !> @date November, 2013 - Initial Version 
    516    ! 
     616   !> 
     617   !> @author J.Paul 
     618   !> @date November, 2013 - Initial Version 
     619   !> 
    517620   !> @param[in] td_date1  first date strutcutre 
    518621   !> @param[in] td_date2  second date strutcutre 
    519622   !> @return nday 
    520623   !------------------------------------------------------------------- 
    521    REAL(dp) FUNCTION date__diffdate(td_date1, td_date2) 
     624 
    522625      IMPLICIT NONE 
    523626        
    … …  
    525628      TYPE(TDATE), INTENT(IN) :: td_date1 
    526629      TYPE(TDATE), INTENT(IN) :: td_date2 
     630 
     631      ! function 
     632      REAL(dp)                :: df_diff 
    527633      !---------------------------------------------------------------- 
    528634 
    … …  
    531637      CALL date__check(td_date2)    
    532638 
    533       date__diffdate = td_date1%d_jd - td_date2%d_jd 
     639      df_diff = td_date1%d_jd - td_date2%d_jd 
    534640 
    535641   END FUNCTION date__diffdate 
     642   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     643   FUNCTION date__subnday(td_date, dd_nday) & 
     644         & RESULT (tf_date) 
    536645   !------------------------------------------------------------------- 
    537646   !> @brief This function substract nday to a date: 
    … …  
    540649   !> @author J.Paul 
    541650   !> @date November, 2013 - Initial Version 
    542    ! 
     651   !> 
    543652   !> @param[in] td_date   date strutcutre 
    544653   !> @param[in] dd_nday   number of day 
    545654   !> @return date strutcutre of date - nday 
    546655   !------------------------------------------------------------------- 
    547    TYPE(TDATE) FUNCTION date__subnday(td_date, dd_nday) 
    548       IMPLICIT NONE 
    549       !Argument 
     656 
     657      IMPLICIT NONE 
     658 
     659      ! Argument 
    550660      TYPE(TDATE), INTENT(IN) :: td_date 
    551661      REAL(dp),    INTENT(IN) :: dd_nday 
     662 
     663      ! function 
     664      TYPE(TDATE)             :: tf_date 
    552665      !---------------------------------------------------------------- 
    553666 
    … …  
    555668      CALL date__check(td_date)    
    556669 
    557       date__subnday=date__init_jd(td_date%d_jd-dd_nday) 
     670      tf_date=date__init_jd(td_date%d_jd-dd_nday) 
    558671 
    559672   END FUNCTION date__subnday 
     673   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     674   FUNCTION date__addnday(td_date, dd_nday) & 
     675         & RESULT (tf_date) 
    560676   !------------------------------------------------------------------- 
    561677   !> @brief This function add nday to a date: 
    … …  
    564680   !> @author J.Paul 
    565681   !> @date November, 2013 - Initial Version 
    566    ! 
     682   !> 
    567683   !> @param[in] td_date   date strutcutre 
    568684   !> @param[in] dd_nday   number of day 
    569685   !> @return date strutcutre of date + nday 
    570686   !------------------------------------------------------------------- 
    571    TYPE(TDATE) FUNCTION date__addnday(td_date, dd_nday) 
    572       IMPLICIT NONE 
    573       !Argument 
     687 
     688      IMPLICIT NONE 
     689 
     690      ! Argument 
    574691      TYPE(TDATE), INTENT(IN) :: td_date 
    575692      REAL(dp),    INTENT(IN) :: dd_nday 
     693 
     694      ! function 
     695      TYPE(TDATE)             :: tf_date 
    576696      !---------------------------------------------------------------- 
    577697 
    … …  
    579699      CALL date__check(td_date)    
    580700 
    581       date__addnday=date__init_jd(td_date%d_jd+dd_nday) 
     701      tf_date=date__init_jd(td_date%d_jd+dd_nday) 
    582702 
    583703   END FUNCTION date__addnday 
     704   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     705   FUNCTION date__lastday(td_date) & 
     706         & RESULT (if_lday) 
    584707   !------------------------------------------------------------------- 
    585708   !> @brief This subroutine compute last day of the month 
    586    ! 
    587    !> @author J.Paul 
    588    !> @date November, 2013 - Initial Version 
    589    ! 
     709   !> 
     710   !> @author J.Paul 
     711   !> @date November, 2013 - Initial Version 
     712   !> 
    590713   !> @param[in] td_date   date strutcutre 
    591714   !> @return last day of the month 
    592715   !------------------------------------------------------------------- 
    593    INTEGER(i4) FUNCTION date__lastday(td_date) 
    594       IMPLICIT NONE 
     716 
     717      IMPLICIT NONE 
     718 
    595719      ! Argument    
    596720      TYPE(TDATE), INTENT(IN) :: td_date 
     721 
     722      ! function 
     723      INTEGER(i4) :: if_lday 
    597724 
    598725      ! local variable 
    … …  
    603730      ! general case 
    604731      IF( td_date%i_month /= 2 )THEN 
    605          date__lastday=il_lastdaytab(td_date%i_month) 
     732         if_lday=il_lastdaytab(td_date%i_month) 
    606733      ELSE 
    607734         IF( date_leapyear(td_date) )THEN 
    608             date__lastday=29 
     735            if_lday=29 
    609736         ELSE 
    610             date__lastday=il_lastdaytab(td_date%i_month) 
     737            if_lday=il_lastdaytab(td_date%i_month) 
    611738         ENDIF 
    612739      ENDIF 
    613740 
    614741   END FUNCTION date__lastday 
     742   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     743   SUBROUTINE date__ymd2jd(td_date) 
    615744   !------------------------------------------------------------------- 
    616745   !> @brief This subroutine compute julian day from year month day , and fill 
    … …  
    619748   !> @author J.Paul 
    620749   !> @date November, 2013 - Initial Version 
    621    ! 
     750   !> 
    622751   !> @param[inout] td_date   date strutcutre 
    623752   !------------------------------------------------------------------- 
    624    SUBROUTINE date__ymd2jd(td_date) 
    625       IMPLICIT NONE 
     753 
     754      IMPLICIT NONE 
     755 
    626756      ! Argument    
    627757      TYPE(TDATE), INTENT(INOUT) :: td_date 
    … …  
    647777 
    648778   END SUBROUTINE date__ymd2jd 
     779   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     780   SUBROUTINE date__jd2ymd(td_date) 
    649781   !------------------------------------------------------------------- 
    650782   !> @brief This subroutine compute year month day from julian day, and fill 
    … …  
    653785   !> @author J.Paul 
    654786   !> @date November, 2013 - Initial Version 
    655    ! 
     787   !> 
    656788   !> @param[inout] td_date   date strutcutre 
    657789   !------------------------------------------------------------------- 
    658    SUBROUTINE date__jd2ymd(td_date) 
    659       IMPLICIT NONE 
     790 
     791      IMPLICIT NONE 
     792 
    660793      ! Argument    
    661794      TYPE(TDATE), INTENT(INOUT) :: td_date 
    … …  
    690823 
    691824   END SUBROUTINE date__jd2ymd 
     825   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     826   SUBROUTINE date__jc2jd(td_date, td_dateo) 
    692827   !------------------------------------------------------------------- 
    693828   !> @brief This subroutine compute julian day from pseudo julian day  
    … …  
    696831   !> @author J.Paul 
    697832   !> @date November, 2013 - Initial Version 
    698    ! 
     833   !> 
    699834   !> @param[inout] td_date   date 
    700835   !> @param[in]    td_dateo  new date origin for pseudo julian day 
    701836   !------------------------------------------------------------------- 
    702    SUBROUTINE date__jc2jd(td_date, td_dateo) 
    703       IMPLICIT NONE 
     837 
     838      IMPLICIT NONE 
     839 
    704840      ! Argument    
    705841      TYPE(TDATE), INTENT(INOUT) :: td_date 
    … …  
    721857 
    722858   END SUBROUTINE date__jc2jd 
     859   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     860   SUBROUTINE date__jd2jc(td_date, td_dateo) 
    723861   !------------------------------------------------------------------- 
    724862   !> @brief This subroutine compute pseudo julian day with new date origin, and 
    … …  
    728866   !> @author J.Paul 
    729867   !> @date November, 2013 - Initial Version 
    730    ! 
     868   !> 
    731869   !> @param[inout] td_date   date 
    732870   !> @param[in] td_dateo     new origin date 
    733871   !------------------------------------------------------------------- 
    734    SUBROUTINE date__jd2jc(td_date, td_dateo) 
    735       IMPLICIT NONE 
     872 
     873      IMPLICIT NONE 
     874 
    736875      ! Argument    
    737876      TYPE(TDATE), INTENT(INOUT) :: td_date 
    … …  
    757896 
    758897   END SUBROUTINE date__jd2jc 
     898   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     899   SUBROUTINE date__jd2dow(td_date) 
    759900   !------------------------------------------------------------------- 
    760901   !> @brief This subroutine compute the day of week from julian day, and fill 
    … …  
    765906   !> @author J.Paul 
    766907   !> @date November, 2013 - Initial Version 
    767    ! 
     908   !> 
    768909   !> @param[inout] td_date   date strutcutre 
    769910   !------------------------------------------------------------------- 
    770    SUBROUTINE date__jd2dow(td_date) 
    771       IMPLICIT NONE 
     911 
     912      IMPLICIT NONE 
     913 
    772914      ! Argument    
    773915      TYPE(TDATE), INTENT(INOUT) :: td_date 
    … …  
    777919 
    778920   END SUBROUTINE date__jd2dow 
     921   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     922   FUNCTION date__hms2jd(td_date) & 
     923         & RESULT (df_frac) 
    779924   !------------------------------------------------------------------- 
    780925   !> @brief This function compute fraction of a day from  
    … …  
    783928   !> @author J.Paul 
    784929   !> @date November, 2013 - Initial Version 
    785    ! 
     930   !> 
    786931   !> @param[in] td_date   date strutcutre 
    787932   !> @return fraction of the day 
    788933   !------------------------------------------------------------------- 
    789    REAL(dp) FUNCTION date__hms2jd(td_date) 
    790       IMPLICIT NONE 
     934 
     935      IMPLICIT NONE 
     936 
    791937      ! Argument    
    792938      TYPE(TDATE), INTENT(IN) :: td_date 
     939 
     940      ! function 
     941      REAL(dp)                :: df_frac 
    793942      !---------------------------------------------------------------- 
    794943 
    795944      !  compute real seconds 
    796       date__hms2jd = REAL( td_date%i_sec, dp )    
     945      df_frac = REAL( td_date%i_sec, dp ) 
    797946      !  compute real minutes 
    798       date__hms2jd = REAL( td_date%i_min, dp ) + date__hms2jd/60.0 
     947      df_frac = REAL( td_date%i_min, dp ) + df_frac/60.0 
    799948      !  compute real hours 
    800       date__hms2jd = REAL( td_date%i_hour, dp ) + date__hms2jd/60.0 
     949      df_frac = REAL( td_date%i_hour, dp ) + df_frac/60.0 
    801950      !  julian fraction of a day 
    802       date__hms2jd = date__hms2jd/24.0 
     951      df_frac = df_frac/24.0 
    803952 
    804953   END FUNCTION date__hms2jd 
     954   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     955   SUBROUTINE date__jd2hms(td_date) 
    805956   !------------------------------------------------------------------- 
    806957   !> @brief This subroutine compute hour, minute, second from julian  
    … …  
    809960   !> @author J.Paul 
    810961   !> @date November, 2013 - Initial Version 
    811    ! 
     962   !> 
    812963   !> @param[inout] td_date   date strutcutre 
    813964   !------------------------------------------------------------------- 
    814    SUBROUTINE date__jd2hms(td_date) 
    815       IMPLICIT NONE 
     965 
     966      IMPLICIT NONE 
     967 
    816968      ! Argument    
    817969      TYPE(TDATE), INTENT(INOUT) :: td_date 
    … …  
    832984 
    833985   END SUBROUTINE date__jd2hms 
     986   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     987   SUBROUTINE date__check(td_date) 
    834988   !------------------------------------------------------------------- 
    835989   !> @brief This subroutine check date express in date structure 
    … …  
    837991   !> @author J.Paul 
    838992   !> @date November, 2013 - Initial Version 
    839    ! 
     993   !> 
    840994   !> @param[in] td_date   date strutcutre 
    841995   !------------------------------------------------------------------- 
    842    SUBROUTINE date__check(td_date) 
    843       IMPLICIT NONE 
     996       
     997      IMPLICIT NONE 
     998 
    844999      ! Argument    
    8451000      TYPE(TDATE), INTENT(IN) :: td_date 
    … …  
    9051060 
    9061061   END SUBROUTINE date__check 
     1062   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1063   SUBROUTINE date__adjust(td_date) 
    9071064   !------------------------------------------------------------------- 
    9081065   !> @brief This subroutine adjust date (correct hour, minutes, and seconds 
    … …  
    9111068   !> @author J.Paul 
    9121069   !> @date November, 2013 - Initial Version 
    913    ! 
     1070   !> 
    9141071   !> @param[inout] td_date   date strutcutre 
    9151072   !------------------------------------------------------------------- 
    916    SUBROUTINE date__adjust(td_date) 
    917       IMPLICIT NONE 
     1073 
     1074      IMPLICIT NONE 
     1075 
    9181076      ! Argument    
    9191077      TYPE(TDATE), INTENT(INOUT) :: td_date 
    … …  
    9361094 
    9371095   END SUBROUTINE date__adjust 
     1096   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1097   FUNCTION date__jd2sec(dd_jul) & 
     1098         & RESULT (if_sec) 
    9381099   !------------------------------------------------------------------- 
    9391100   !> @brief This function convert julian day in seconds 
    … …  
    9411102   !> @author J.Paul 
    9421103   !> @date November, 2013 - Initial Version 
    943    ! 
     1104   !> 
    9441105   !> @param[in] td_date   date strutcutre 
    9451106   !> @return number of seconds since julian day origin 
    9461107   !------------------------------------------------------------------- 
    947    INTEGER(i8) FUNCTION date__jd2sec(dd_jul) 
    948       IMPLICIT NONE 
     1108 
     1109      IMPLICIT NONE 
     1110 
    9491111      ! Argument    
    9501112      REAL(dp), INTENT(IN) :: dd_jul 
    951       !---------------------------------------------------------------- 
    952  
    953       date__jd2sec = NINT( dd_jul * im_secbyday, i8 ) 
     1113 
     1114      ! function 
     1115      INTEGER(i8)          :: if_sec 
     1116      !---------------------------------------------------------------- 
     1117 
     1118      if_sec = NINT( dd_jul * im_secbyday, i8 ) 
    9541119 
    9551120   END FUNCTION date__jd2sec 
     1121   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     1122   FUNCTION date__sec2jd(kd_nsec) & 
     1123         & RESULT (df_sec) 
    9561124   !------------------------------------------------------------------- 
    9571125   !> @brief This function convert seconds since julian day origin in  
    … …  
    9591127   !> @author J.Paul 
    9601128   !> @date November, 2013 - Initial Version 
    961    ! 
     1129   !> 
    9621130   !> @param[in] kd_nsec   number of second since julian day origin 
    9631131   !> @return julian day 
    9641132   !------------------------------------------------------------------- 
    965    REAL(dp) FUNCTION date__sec2jd(kd_nsec) 
    966       IMPLICIT NONE 
     1133 
     1134      IMPLICIT NONE 
     1135 
    9671136      ! Argument    
    9681137      INTEGER(i8), INTENT(IN) :: kd_nsec 
    969       !---------------------------------------------------------------- 
    970  
    971       date__sec2jd = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp ) 
     1138 
     1139      ! function 
     1140      REAL(dp)                :: df_sec 
     1141      !---------------------------------------------------------------- 
     1142 
     1143      df_sec = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp ) 
    9721144 
    9731145   END FUNCTION date__sec2jd 
     1146   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    9741147END MODULE date 
    9751148 
Note: See TracChangeset for help on using the changeset viewer.