From f61f51919700f9dc20b7cfd2b327b8ee104ae66c Mon Sep 17 00:00:00 2001
From: Luis Kornblueh <luis.kornblueh@mpimet.mpg.de>
Date: Tue, 25 Oct 2022 10:38:06 +0200
Subject: [PATCH] Added some Julian day functions
---
src/libmtime.f90 | 25 ++++++++++++++++++++++---
src/mtime_c_bindings.f90 | 7 +++++++
2 files changed, 29 insertions(+), 3 deletions(-)
diff --git a/src/libmtime.f90 b/src/libmtime.f90
index 9ff15db9..687a617e 100644
--- a/src/libmtime.f90
+++ b/src/libmtime.f90
@@ -116,7 +116,12 @@ MODULE mtime_juliandelta
PUBLIC :: juliandelta
PUBLIC :: newJulianDelta
PUBLIC :: deallocateJulianDelta
+ public :: operator (+)
!
+ interface operator (+)
+ module procedure addjuliandeltatojulianday
+ module procedure addjuliandaytojuliandelta
+ end interface operator (+)
CONTAINS
@@ -141,10 +146,24 @@ CONTAINS
CALL my_deallocatejuliandelta(c_loc(my_juliandelta))
my_juliandelta => NULL()
END SUBROUTINE deallocateJuliandelta
-
+ !
+ function addJulianDeltaToJulianDay(op1, op2) result(ret) !OK-TESTED.
+ type(julianday), target :: ret
+ type(julianday), target, intent(in) :: op1
+ type(juliandelta), target, intent(in) :: op2
+ type(c_ptr) :: dummy_ptr
+ dummy_ptr = my_addjuliandeltatojulianday(c_loc(op1), c_loc(op2), c_loc(ret))
+ end function addJulianDeltaToJulianDay
+ !
+ function addjulianDayToJulianDelta(op2, op1) result(ret) !OK-TESTED.
+ type(julianday), target :: ret
+ type(julianday), target, intent(in) :: op1
+ type(juliandelta), target, intent(in) :: op2
+ type(c_ptr) :: dummy_ptr
+ dummy_ptr = my_addjuliandeltatojulianday(c_loc(op1), c_loc(op2), c_loc(ret))
+ end function addjulianDayToJulianDelta
+ !
END MODULE mtime_juliandelta
-
-
!>
!! @brief Julian Day Calendar and some operations supported on julian dates.
!!
diff --git a/src/mtime_c_bindings.f90 b/src/mtime_c_bindings.f90
index 6190b987..76f3fa38 100644
--- a/src/mtime_c_bindings.f90
+++ b/src/mtime_c_bindings.f90
@@ -128,6 +128,13 @@ module mtime_c_bindings
import :: c_ptr
type(c_ptr), value :: jd
end subroutine my_deallocatejuliandelta
+ !
+ function my_addjuliandeltatojulianday(my_julianday, my_juliandelta, ret_julianday) result(julianday_ptr) &
+ & bind(c, name='addJulianDelta')
+ import :: c_ptr
+ type(c_ptr) :: julianday_ptr
+ type(c_ptr), value :: my_julianday, my_juliandelta, ret_julianday
+ end function my_addjuliandeltatojulianday
end interface
interface
--
GitLab