715IF (this == that)
THEN
717ELSE IF (this > that)
THEN
723END FUNCTION datetime_ge
726ELEMENTAL FUNCTION datetime_le(this, that)
RESULT(res)
727TYPE(
datetime),
INTENT(IN) :: this, that
730IF (this == that)
THEN
732ELSE IF (this < that)
THEN
738END FUNCTION datetime_le
741FUNCTION datetime_add(this, that)
RESULT(res)
746INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
748IF (this == datetime_miss .OR. that == timedelta_miss)
THEN
751 res%iminuti = this%iminuti + that%iminuti
752 IF (that%month /= 0)
THEN
753 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
754 minute=lminute, msec=lmsec)
755 CALL init(res, year=lyear, month=lmonth+that%month, day=lday, &
756 hour=lhour, minute=lminute, msec=lmsec)
760END FUNCTION datetime_add
763ELEMENTAL FUNCTION datetime_subdt(this, that)
RESULT(res)
764TYPE(
datetime),
INTENT(IN) :: this, that
767IF (this == datetime_miss .OR. that == datetime_miss)
THEN
770 res%iminuti = this%iminuti - that%iminuti
774END FUNCTION datetime_subdt
777FUNCTION datetime_subtd(this, that)
RESULT(res)
782INTEGER :: lyear, lmonth, lday, lhour, lminute, lmsec
784IF (this == datetime_miss .OR. that == timedelta_miss)
THEN
787 res%iminuti = this%iminuti - that%iminuti
788 IF (that%month /= 0)
THEN
789 CALL getval(res, year=lyear, month=lmonth, day=lday, hour=lhour, &
790 minute=lminute, msec=lmsec)
791 CALL init(res, year=lyear, month=lmonth-that%month, day=lday, &
792 hour=lhour, minute=lminute, msec=lmsec)
796END FUNCTION datetime_subtd
803SUBROUTINE datetime_read_unit(this, unit)
805INTEGER,
INTENT(in) :: unit
806CALL datetime_vect_read_unit((/this/), unit)
808END SUBROUTINE datetime_read_unit
815SUBROUTINE datetime_vect_read_unit(this, unit)
817INTEGER,
INTENT(in) :: unit
819CHARACTER(len=40) :: form
820CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
823ALLOCATE(dateiso(
SIZE(this)))
824INQUIRE(unit, form=form)
825IF (form ==
'FORMATTED')
THEN
826 READ(unit,
'(A23,1X)')dateiso
830DO i = 1,
SIZE(dateiso)
831 CALL init(this(i), isodate=dateiso(i))
835END SUBROUTINE datetime_vect_read_unit
842SUBROUTINE datetime_write_unit(this, unit)
844INTEGER,
INTENT(in) :: unit
846CALL datetime_vect_write_unit((/this/), unit)
848END SUBROUTINE datetime_write_unit
855SUBROUTINE datetime_vect_write_unit(this, unit)
857INTEGER,
INTENT(in) :: unit
859CHARACTER(len=40) :: form
860CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
863ALLOCATE(dateiso(
SIZE(this)))
864DO i = 1,
SIZE(dateiso)
865 CALL getval(this(i), isodate=dateiso(i))
867INQUIRE(unit, form=form)
868IF (form ==
'FORMATTED')
THEN
869 WRITE(unit,
'(A23,1X)')dateiso
875END SUBROUTINE datetime_vect_write_unit
878#include "arrayof_post.F90"
890FUNCTION timedelta_new(year, month, day, hour, minute, sec, msec, &
891 isodate, simpledate, oraclesimdate)
RESULT (this)
892INTEGER,
INTENT(IN),
OPTIONAL :: year
893INTEGER,
INTENT(IN),
OPTIONAL :: month
894INTEGER,
INTENT(IN),
OPTIONAL :: day
895INTEGER,
INTENT(IN),
OPTIONAL :: hour
896INTEGER,
INTENT(IN),
OPTIONAL :: minute
897INTEGER,
INTENT(IN),
OPTIONAL :: sec
898INTEGER,
INTENT(IN),
OPTIONAL :: msec
899CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: isodate
900CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: simpledate
901CHARACTER(len=12),
INTENT(IN),
OPTIONAL :: oraclesimdate
905CALL timedelta_init(this, year, month, day, hour, minute, sec, msec, &
906 isodate, simpledate, oraclesimdate)
908END FUNCTION timedelta_new
915SUBROUTINE timedelta_init(this, year, month, day, hour, minute, sec, msec, &
916 isodate, simpledate, oraclesimdate)
918INTEGER,
INTENT(IN),
OPTIONAL :: year
919INTEGER,
INTENT(IN),
OPTIONAL :: month
920INTEGER,
INTENT(IN),
OPTIONAL :: day
921INTEGER,
INTENT(IN),
OPTIONAL :: hour
922INTEGER,
INTENT(IN),
OPTIONAL :: minute
923INTEGER,
INTENT(IN),
OPTIONAL :: sec
924INTEGER,
INTENT(IN),
OPTIONAL :: msec
925CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: isodate
926CHARACTER(len=*),
INTENT(IN),
OPTIONAL :: simpledate
927CHARACTER(len=12),
INTENT(IN),
OPTIONAL :: oraclesimdate
929INTEGER :: n, l, lyear, lmonth, d, h, m, s, ms
930CHARACTER(len=23) :: datebuf
934IF (
PRESENT(isodate))
THEN
935 datebuf(1:23) =
'0000000000 00:00:00.000'
936 l = len_trim(isodate)
938 n =
index(trim(isodate),
' ')
940 IF (n > 11 .OR. n < l - 12)
GOTO 200
941 datebuf(12-n:12-n+l-1) = isodate(:l)
943 datebuf(1:l) = isodate(1:l)
948 READ(datebuf,
'(I4,I2,I4,1X,I2,1X,I2,1X,I2,1X,I3)', err=200) lyear, lmonth, d, &
950 this%month = lmonth + 12*lyear
951 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
952 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
953 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
958 CALL l4f_log(l4f_error,
'isodate '//trim(isodate)//
' not valid')
961ELSE IF (
PRESENT(simpledate))
THEN
962 datebuf(1:17) =
'00000000000000000'
963 datebuf(1:min(len(simpledate),17)) = simpledate(1:min(len(simpledate),17))
964 READ(datebuf,
'(I8.8,3I2.2,I3.3)', err=220) d, h, m, s, ms
965 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
966 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll) + &
967 1000_int_ll*int(s, kind=int_ll) + int(ms, kind=int_ll)
971 CALL l4f_log(l4f_error,
'simpledate '//trim(simpledate)//
' not valid')
975ELSE IF (
PRESENT(oraclesimdate))
THEN
976 CALL l4f_log(l4f_warn,
'in timedelta_init, parametro oraclesimdate '// &
977 'obsoleto, usare piuttosto simpledate')
978 READ(oraclesimdate,
'(I8,2I2)')d, h, m
979 this%iminuti = 86400000_int_ll*int(d, kind=int_ll) + &
980 3600000_int_ll*int(h, kind=int_ll) + 60000_int_ll*int(m, kind=int_ll)
982ELSE IF (.not.
present(year) .and. .not.
present(month) .and. .not.
present(day)&
983 .and. .not.
present(hour) .and. .not.
present(minute) .and. .not.
present(sec)&
984 .and. .not.
present(msec) .and. .not.
present(isodate) &
985 .and. .not.
present(simpledate) .and. .not.
present(oraclesimdate))
THEN
991 IF (
PRESENT(year))
THEN
993 this%month = this%month + year*12
999 IF (
PRESENT(month))
THEN
1001 this%month = this%month + month
1007 IF (
PRESENT(day))
THEN
1009 this%iminuti = this%iminuti + 86400000_int_ll*int(day, kind=int_ll)
1015 IF (
PRESENT(hour))
THEN
1017 this%iminuti = this%iminuti + 3600000_int_ll*int(hour, kind=int_ll)
1023 IF (
PRESENT(minute))
THEN
1024 if (
c_e(minute))
then
1025 this%iminuti = this%iminuti + 60000_int_ll*int(minute, kind=int_ll)
1031 IF (
PRESENT(sec))
THEN
1033 this%iminuti = this%iminuti + 1000_int_ll*int(sec, kind=int_ll)
1039 IF (
PRESENT(msec))
THEN
1041 this%iminuti = this%iminuti + msec
1052END SUBROUTINE timedelta_init
1055SUBROUTINE timedelta_delete(this)
1061END SUBROUTINE timedelta_delete
1068PURE SUBROUTINE timedelta_getval(this, year, month, amonth, &
1069 day, hour, minute, sec, msec, &
1070 ahour, aminute, asec, amsec, isodate, simpledate, oraclesimdate)
1072INTEGER,
INTENT(OUT),
OPTIONAL :: year
1073INTEGER,
INTENT(OUT),
OPTIONAL :: month
1074INTEGER,
INTENT(OUT),
OPTIONAL :: amonth
1075INTEGER,
INTENT(OUT),
OPTIONAL :: day
1076INTEGER,
INTENT(OUT),
OPTIONAL :: hour
1077INTEGER,
INTENT(OUT),
OPTIONAL :: minute
1078INTEGER,
INTENT(OUT),
OPTIONAL :: sec
1079INTEGER,
INTENT(OUT),
OPTIONAL :: msec
1080INTEGER,
INTENT(OUT),
OPTIONAL :: ahour
1081INTEGER,
INTENT(OUT),
OPTIONAL :: aminute
1082INTEGER,
INTENT(OUT),
OPTIONAL :: asec
1083INTEGER(kind=int_ll),
INTENT(OUT),
OPTIONAL :: amsec
1084CHARACTER(len=*),
INTENT(OUT),
OPTIONAL :: isodate
1085CHARACTER(len=*),
INTENT(OUT),
OPTIONAL :: simpledate
1086CHARACTER(len=12),
INTENT(OUT),
OPTIONAL :: oraclesimdate
1088CHARACTER(len=23) :: datebuf
1090IF (
PRESENT(amsec))
THEN
1091 amsec = this%iminuti
1093IF (
PRESENT(asec))
THEN
1094 asec = int(this%iminuti/1000_int_ll)
1096IF (
PRESENT(aminute))
THEN
1097 aminute = int(this%iminuti/60000_int_ll)
1099IF (
PRESENT(ahour))
THEN
1100 ahour = int(this%iminuti/3600000_int_ll)
1102IF (
PRESENT(msec))
THEN
1103 msec = int(
mod(this%iminuti, 1000_int_ll))
1105IF (
PRESENT(sec))
THEN
1106 sec = int(
mod(this%iminuti/1000_int_ll, 60_int_ll))
1108IF (
PRESENT(minute))
THEN
1109 minute = int(
mod(this%iminuti/60000_int_ll, 60_int_ll))
1111IF (
PRESENT(hour))
THEN
1112 hour = int(
mod(this%iminuti/3600000_int_ll, 24_int_ll))
1114IF (
PRESENT(day))
THEN
1115 day = int(this%iminuti/86400000_int_ll)
1117IF (
PRESENT(amonth))
THEN
1120IF (
PRESENT(month))
THEN
1121 month =
mod(this%month-1,12)+1
1123IF (
PRESENT(year))
THEN
1124 year = this%month/12
1126IF (
PRESENT(isodate))
THEN
1127 WRITE(datebuf(1:23),
'(I10.10,1X,I2.2,A1,I2.2,A1,I2.2,A1,I3.3)') &
1128 this%iminuti/86400000_int_ll,
mod(this%iminuti/3600000_int_ll, 24_int_ll),
':', &
1129 mod(this%iminuti/60000_int_ll, 60_int_ll),
':',
mod(this%iminuti/1000_int_ll, 60_int_ll), &
1130 '.',
mod(this%iminuti, 1000_int_ll)
1131 isodate = datebuf(1:min(len(isodate),23))
1134IF (
PRESENT(simpledate))
THEN
1135 WRITE(datebuf(1:17),
'(I8.8,3I2.2,I3.3)') &
1136 this%iminuti/86400000_int_ll,
mod(this%iminuti/3600000_int_ll, 24_int_ll), &
1137 mod(this%iminuti/60000_int_ll, 60_int_ll),
mod(this%iminuti/1000_int_ll, 60_int_ll), &
1138 mod(this%iminuti, 1000_int_ll)
1139 simpledate = datebuf(1:min(len(simpledate),17))
1141IF (
PRESENT(oraclesimdate))
THEN
1144 WRITE(oraclesimdate,
'(I8.8,2I2.2)') this%iminuti/86400000_int_ll, &
1145 mod(this%iminuti/3600000_int_ll, 24_int_ll),
mod(this%iminuti/60000_int_ll, 60_int_ll)
1148END SUBROUTINE timedelta_getval
1153elemental FUNCTION timedelta_to_char(this)
RESULT(char)
1156CHARACTER(len=23) :: char
1158CALL getval(this, isodate=char)
1160END FUNCTION timedelta_to_char
1163FUNCTION trim_timedelta_to_char(in)
RESULT(char)
1166CHARACTER(len=len_trim(timedelta_to_char(in))) :: char
1168char=timedelta_to_char(in)
1170END FUNCTION trim_timedelta_to_char
1174elemental FUNCTION timedelta_getamsec(this)
1176INTEGER(kind=int_ll) :: timedelta_getamsec
1178timedelta_getamsec = this%iminuti
1180END FUNCTION timedelta_getamsec
1188FUNCTION timedelta_depop(this)
1194IF (this%month == 0)
THEN
1195 timedelta_depop = this
1197 tmpdt = datetime_new(1970, 1, 1)
1198 timedelta_depop = (tmpdt + this) - tmpdt
1201END FUNCTION timedelta_depop
1204elemental FUNCTION timedelta_eq(this, that)
RESULT(res)
1208res = (this%iminuti == that%iminuti .AND. this%month == that%month)
1210END FUNCTION timedelta_eq
1213ELEMENTAL FUNCTION timedelta_ne(this, that)
RESULT(res)
1217res = .NOT.(this == that)
1219END FUNCTION timedelta_ne
1222ELEMENTAL FUNCTION timedelta_gt(this, that)
RESULT(res)
1226res = this%iminuti > that%iminuti
1228END FUNCTION timedelta_gt
1231ELEMENTAL FUNCTION timedelta_lt(this, that)
RESULT(res)
1235res = this%iminuti < that%iminuti
1237END FUNCTION timedelta_lt
1240ELEMENTAL FUNCTION timedelta_ge(this, that)
RESULT(res)
1244IF (this == that)
THEN
1246ELSE IF (this > that)
THEN
1252END FUNCTION timedelta_ge
1255elemental FUNCTION timedelta_le(this, that)
RESULT(res)
1259IF (this == that)
THEN
1261ELSE IF (this < that)
THEN
1267END FUNCTION timedelta_le
1270ELEMENTAL FUNCTION timedelta_add(this, that)
RESULT(res)
1274res%iminuti = this%iminuti + that%iminuti
1275res%month = this%month + that%month
1277END FUNCTION timedelta_add
1280ELEMENTAL FUNCTION timedelta_sub(this, that)
RESULT(res)
1284res%iminuti = this%iminuti - that%iminuti
1285res%month = this%month - that%month
1287END FUNCTION timedelta_sub
1290ELEMENTAL FUNCTION timedelta_mult(this, n)
RESULT(res)
1292INTEGER,
INTENT(IN) :: n
1295res%iminuti = this%iminuti*n
1296res%month = this%month*n
1298END FUNCTION timedelta_mult
1301ELEMENTAL FUNCTION timedelta_tlum(n, this)
RESULT(res)
1302INTEGER,
INTENT(IN) :: n
1306res%iminuti = this%iminuti*n
1307res%month = this%month*n
1309END FUNCTION timedelta_tlum
1312ELEMENTAL FUNCTION timedelta_divint(this, n)
RESULT(res)
1314INTEGER,
INTENT(IN) :: n
1317res%iminuti = this%iminuti/n
1318res%month = this%month/n
1320END FUNCTION timedelta_divint
1323ELEMENTAL FUNCTION timedelta_divtd(this, that)
RESULT(res)
1327res = int(this%iminuti/that%iminuti)
1329END FUNCTION timedelta_divtd
1332elemental FUNCTION timedelta_mod(this, that)
RESULT(res)
1336res%iminuti =
mod(this%iminuti, that%iminuti)
1339END FUNCTION timedelta_mod
1342ELEMENTAL FUNCTION datetime_timedelta_mod(this, that)
RESULT(res)
1347IF (that%iminuti == 0)
THEN
1350 res%iminuti =
mod(this%iminuti, that%iminuti)
1354END FUNCTION datetime_timedelta_mod
1357ELEMENTAL FUNCTION timedelta_abs(this)
RESULT(res)
1361res%iminuti =
abs(this%iminuti)
1362res%month =
abs(this%month)
1364END FUNCTION timedelta_abs
1371SUBROUTINE timedelta_read_unit(this, unit)
1373INTEGER,
INTENT(in) :: unit
1375CALL timedelta_vect_read_unit((/this/), unit)
1377END SUBROUTINE timedelta_read_unit
1384SUBROUTINE timedelta_vect_read_unit(this, unit)
1386INTEGER,
INTENT(in) :: unit
1388CHARACTER(len=40) :: form
1389CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
1392ALLOCATE(dateiso(
SIZE(this)))
1393INQUIRE(unit, form=form)
1394IF (form ==
'FORMATTED')
THEN
1395 READ(unit,
'(3(A23,1X))')dateiso
1399DO i = 1,
SIZE(dateiso)
1400 CALL init(this(i), isodate=dateiso(i))
1404END SUBROUTINE timedelta_vect_read_unit
1411SUBROUTINE timedelta_write_unit(this, unit)
1413INTEGER,
INTENT(in) :: unit
1415CALL timedelta_vect_write_unit((/this/), unit)
1417END SUBROUTINE timedelta_write_unit
1424SUBROUTINE timedelta_vect_write_unit(this, unit)
1426INTEGER,
INTENT(in) :: unit
1428CHARACTER(len=40) :: form
1429CHARACTER(len=23),
ALLOCATABLE :: dateiso(:)
1432ALLOCATE(dateiso(
SIZE(this)))
1433DO i = 1,
SIZE(dateiso)
1434 CALL getval(this(i), isodate=dateiso(i))
1436INQUIRE(unit, form=form)
1437IF (form ==
'FORMATTED')
THEN
1438 WRITE(unit,
'(3(A23,1X))')dateiso
1444END SUBROUTINE timedelta_vect_write_unit
1447ELEMENTAL FUNCTION c_e_timedelta(this)
result (res)
1451res = .not. this == timedelta_miss
1453end FUNCTION c_e_timedelta
1456elemental SUBROUTINE jeladata5(iday,imonth,iyear,ihour,imin,iminuti)
1473INTEGER,
intent(in) :: iday, imonth, iyear, ihour, imin
1474INTEGER,
intent(out) :: iminuti
1476iminuti = ndays(iday,imonth,iyear)*1440+(ihour*60)+imin
1478END SUBROUTINE jeladata5
1481elemental SUBROUTINE jeladata5_1(iday,imonth,iyear,ihour,imin,imsec,imillisec)
1482INTEGER,
intent(in) :: iday, imonth, iyear, ihour, imin, imsec
1483INTEGER(KIND=int_ll),
intent(out) :: imillisec
1485imillisec = int(ndays(iday,imonth,iyear)*1440+(ihour*60)+imin, kind=int_ll)*60000 &
1488END SUBROUTINE jeladata5_1
1492elemental SUBROUTINE jeladata6(iday, imonth, iyear, ihour, imin, iminuti)
1511INTEGER,
intent(in) :: iminuti
1512INTEGER,
intent(out) :: iday, imonth, iyear, ihour, imin
1516imin =
mod(iminuti,60)
1517ihour =
mod(iminuti,1440)/60
1518igiorno = iminuti/1440
1519IF (
mod(iminuti,1440) < 0) igiorno = igiorno-1
1520CALL ndyin(igiorno,iday,imonth,iyear)
1522END SUBROUTINE jeladata6
1525elemental SUBROUTINE jeladata6_1(iday, imonth, iyear, ihour, imin, imsec, imillisec)
1526INTEGER(KIND=int_ll),
INTENT(IN) :: imillisec
1527INTEGER,
INTENT(OUT) :: iday, imonth, iyear, ihour, imin, imsec
1531imsec = int(
mod(imillisec, 60000_int_ll))
1534imin = int(
mod(imillisec, 3600000_int_ll)/60000_int_ll)
1535ihour = int(
mod(imillisec, 86400000_int_ll)/3600000_int_ll)
1536igiorno = int(imillisec/86400000_int_ll)
1538CALL ndyin(igiorno,iday,imonth,iyear)
1540END SUBROUTINE jeladata6_1
1543elemental SUBROUTINE ndyin(ndays,igg,imm,iaa)
1552INTEGER,
intent(in) :: ndays
1553INTEGER,
intent(out) :: igg, imm, iaa
1559lndays = lndays - n*d400
1561n = min(lndays/d100, 3)
1562lndays = lndays - n*d100
1565lndays = lndays - n*d4
1567n = min(lndays/d1, 3)
1568lndays = lndays - n*d1
1572 IF (lndays < ianno(imm+1,n))
EXIT
1574igg = lndays+1-ianno(imm,n)
1579integer elemental FUNCTION ndays(igg,imm,iaa)
1596INTEGER,
intent(in) :: igg, imm, iaa
1598INTEGER :: lmonth, lyear
1601lmonth = modulo(imm-1, 12) + 1
1602lyear = iaa + (imm - lmonth)/12
1603ndays = igg+ianno(lmonth, bisextilis(lyear))
1604ndays = ndays-1 + 365*(lyear-year0) + (lyear-year0)/4 - (lyear-year0)/100 + &
1610elemental FUNCTION bisextilis(annum)
1611INTEGER,
INTENT(in) :: annum
1612INTEGER :: bisextilis
1614IF (
mod(annum,4) == 0 .AND. (
mod(annum,400) == 0 .EQV.
mod(annum,100) == 0))
THEN
1619END FUNCTION bisextilis
1622ELEMENTAL FUNCTION cyclicdatetime_eq(this, that)
RESULT(res)
1627if (this%minute /= that%minute) res=.false.
1628if (this%hour /= that%hour) res=.false.
1629if (this%day /= that%day) res=.false.
1630if (this%month /= that%month) res=.false.
1631if (this%tendaysp /= that%tendaysp) res=.false.
1633END FUNCTION cyclicdatetime_eq
1636ELEMENTAL FUNCTION cyclicdatetime_datetime_eq(this, that)
RESULT(res)
1641integer :: minute,hour,day,month
1643call getval(that,minute=minute,hour=hour,day=day,month=month)
1646if (
c_e(this%minute) .and. this%minute /= minute) res=.false.
1647if (
c_e(this%hour) .and. this%hour /= hour) res=.false.
1648if (
c_e(this%day) .and. this%day /= day) res=.false.
1649if (
c_e(this%month) .and. this%month /= month) res=.false.
1650if (
c_e(this%tendaysp))
then
1651 if ( this%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
1654END FUNCTION cyclicdatetime_datetime_eq
1657ELEMENTAL FUNCTION datetime_cyclicdatetime_eq(this, that)
RESULT(res)
1662integer :: minute,hour,day,month
1664call getval(this,minute=minute,hour=hour,day=day,month=month)
1667if (
c_e(that%minute) .and. that%minute /= minute) res=.false.
1668if (
c_e(that%hour) .and. that%hour /= hour) res=.false.
1669if (
c_e(that%day) .and. that%day /= day) res=.false.
1670if (
c_e(that%month) .and. that%month /= month) res=.false.
1672if (
c_e(that%tendaysp))
then
1673 if ( that%tendaysp /= min(((day-1)/10) +1,3)) res=.false.
1677END FUNCTION datetime_cyclicdatetime_eq
1679ELEMENTAL FUNCTION c_e_cyclicdatetime(this)
result (res)
1683res = .not. this == cyclicdatetime_miss
1685end FUNCTION c_e_cyclicdatetime
1690FUNCTION cyclicdatetime_new(tendaysp, month, day, hour, minute, chardate)
RESULT(this)
1691INTEGER,
INTENT(IN),
OPTIONAL :: tendaysp
1692INTEGER,
INTENT(IN),
OPTIONAL :: month
1693INTEGER,
INTENT(IN),
OPTIONAL :: day
1694INTEGER,
INTENT(IN),
OPTIONAL :: hour
1695INTEGER,
INTENT(IN),
OPTIONAL :: minute
1696CHARACTER(len=9),
INTENT(IN),
OPTIONAL :: chardate
1698integer :: ltendaysp,lmonth,lday,lhour,lminute,ios
1703if (
present(chardate))
then
1711 if (
c_e(chardate))
then
1713 read(chardate(1:1),
'(i1)',iostat=ios)ltendaysp
1715 if (ios /= 0)ltendaysp=imiss
1717 read(chardate(2:3),
'(i2)',iostat=ios)lmonth
1719 if (ios /= 0)lmonth=imiss
1721 read(chardate(4:5),
'(i2)',iostat=ios)lday
1723 if (ios /= 0)lday=imiss
1725 read(chardate(6:7),
'(i2)',iostat=ios)lhour
1727 if (ios /= 0)lhour=imiss
1729 read(chardate(8:9),
'(i2)',iostat=ios)lminute
1731 if (ios /= 0)lminute=imiss
1734 this%tendaysp=ltendaysp
1740 this%tendaysp=optio_l(tendaysp)
1741 this%month=optio_l(month)
1742 this%day=optio_l(day)
1743 this%hour=optio_l(hour)
1744 this%minute=optio_l(minute)
1747END FUNCTION cyclicdatetime_new
1751elemental FUNCTION cyclicdatetime_to_char(this)
RESULT(char)
1754CHARACTER(len=80) :: char
1759END FUNCTION cyclicdatetime_to_char
1774FUNCTION cyclicdatetime_to_conventional(this)
RESULT(dtc)
1779integer :: year,month,day,hour
1784if ( .not.
c_e(this))
then
1785 dtc=datetime_new(year=1007, month=1, day=1, hour=1, minute=1)
1790if (
c_e(this%minute))
return
1792if (
c_e(this%day) .and.
c_e(this%month) .and.
c_e(this%tendaysp))
return
1794if (
c_e(this%day) .and.
c_e(this%month))
then
1795 dtc=datetime_new(year=1001, month=this%month, day=this%day, hour=1, minute=1)
1796else if (
c_e(this%tendaysp) .and.
c_e(this%month))
then
1797 day=(this%tendaysp-1)*10+1
1798 dtc=datetime_new(year=1003, month=this%month, day=day, hour=1, minute=1)
1799else if (
c_e(this%month))
then
1800 dtc=datetime_new(year=1005, month=this%month, day=1, hour=1, minute=1)
1801else if (
c_e(this%day))
then
1806if (
c_e(this%hour))
then
1807 call getval(dtc,year=year,month=month,day=day,hour=hour)
1808 dtc=datetime_new(year=year+1,month=month,day=day,hour=this%hour,minute=1)
1812END FUNCTION cyclicdatetime_to_conventional
1816FUNCTION trim_cyclicdatetime_to_char(in)
RESULT(char)
1819CHARACTER(len=len_trim(cyclicdatetime_to_char(in))) :: char
1821char=cyclicdatetime_to_char(in)
1823END FUNCTION trim_cyclicdatetime_to_char
1827SUBROUTINE display_cyclicdatetime(this)
1830print*,
"CYCLICDATETIME: ",
to_char(this)
1832end subroutine display_cyclicdatetime
1835#include "array_utilities_inc.F90"