-
Notifications
You must be signed in to change notification settings - Fork 3
/
fms_diag_send_data.F90
224 lines (199 loc) · 13 KB
/
fms_diag_send_data.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
module fms_diag_send_data_mod
use fms_diag_averaging_mod, only: get_average, alloc_subarray
use fms_diag_write_data_mod, only: write_static
use fms_diag_data_mod, only: diag_null, diag_error, fatal, note, warning
use fms_diag_object_mod
!> \descrption The user API for diag_manager is send_data. Users pass their variable object to
!! this routine, and magic happens.
!! - Check if the diagnostic object is allocated/registered. If it isn't return.
!! - On the first call, the diag object is converted to the correct type to allow for bufferring.
!! - If the input data are static, they are written to the file(s) they are supposed to go to. Subsequent
!! send data calls will be ignored (a quick return).
!! - The optional arguments are all handled and checked.
!! - Data is buffered in the diag object. This object is carried by the model component sending the data.
!! - Averaging routines are called to preform the correct calculations if there is averaging.
!! - Data is written to the appropriate file at the appropriate time. The averaged data is not buffered.
!! - If no more averaging needs to be done on a given set of data, then the data buffer is deallocated.
!! (example: a veriable is written out on a monthly basis, and the model has reached the end of the month)
interface send_data
module procedure fms_send_datascalar
module procedure fms_send_data1d
module procedure fms_send_data2d
module procedure fms_send_data3d
module procedure fms_send_data4d
module procedure fms_send_data5d
end interface send_data
type send_data_opts
integer, allocatable :: is
integer, allocatable :: js
integer, allocatable :: ks
integer, allocatable :: ie
integer, allocatable :: je
integer, allocatable :: ke
logical, allocatable :: mask
real, allocatable :: rmask
real, allocatable :: weight
end type send_data_opts
contains
!> \descrption scalar wrapper for fms_send_data
subroutine fms_send_datascalar(diagobj, var)
class (fms_diag_object),target, intent(inout), allocatable :: diagobj !< The diag variable object
class(*) , intent(in) , target :: var !< The variable
class(*) , pointer :: vptr => NULL() !< A pointer to the data
!> If the diagnostic object is not allocated, then return withut doing anything
if (.not.allocated( diagobj )) return
end subroutine fms_send_datascalar
subroutine fms_send_data1d(diagobj, var)
class (fms_diag_object),target, intent(inout), allocatable :: diagobj !< The diag variable object
class(*), dimension(:) , intent(in) , target :: var !< The variable
class(*), dimension(:) , pointer :: vptr => NULL() !< A pointer to the data
!> If the diagnostic object is not allocated, then return
if (.not.allocated( diagobj )) return
!> If this is the first call in, set the type to be fms_diag_object_1d
call switch_to_right_type(diagobj, null_1d, var(lbound(var,1)))
end subroutine fms_send_data1d
!> \descrption 4D wrapper for fms_send_data
subroutine fms_send_data4d(diagobj, var, time, is_in, js_in, ks_in, mask, &
rmask, ie_in, je_in, ke_in, weight, err_msg)
class (fms_diag_object),target, intent(inout), allocatable :: diagobj !< The diag variable object
class(*), dimension(:,:,:,:) , intent(in) , target :: var !< The variable
class(*), dimension(:,:,:,:) , pointer :: vptr => NULL() !< A pointer to the data
integer, optional , intent(in) :: time !< A time place holder
integer, optional , intent(in) :: is_in !< Start of the first dimension
integer, optional , intent(in) :: js_in !< Start of the second dimension
integer, optional , intent(in) :: ks_in !< Start of the third dimension
integer, optional , intent(in) :: ie_in !< End of the first dimension
integer, optional , intent(in) :: je_in !< End of the second dimension
integer, optional , intent(in) :: ke_in !< End of the third dimension
logical, optional , intent(in) :: mask !< A lask for point to ignore
real , optional , intent(in) :: rmask !< I DONT KNOW
real , optional , intent(in) :: weight !< Something for averaging?
CHARACTER(len=*) , INTENT(out), OPTIONAL :: err_msg
! local vars
class (fms_diag_object) , pointer :: dptr => NULL()
!> If the diagnostic object is not allocated, then return
if (.not.allocated( diagobj )) return
!> If this is the first call in, set the type to be fms_diag_object_4d
call switch_to_right_type(diagobj, null_4d, &
var(lbound(var,1),lbound(var,2),lbound(var,3),lbound(var,4)) )
end subroutine fms_send_data4d
!> \descrption 5D wrapper for fms_send_data
subroutine fms_send_data5d(diagobj, var, time, is_in, js_in, ks_in, mask, &
rmask, ie_in, je_in, ke_in, weight, err_msg)
class (fms_diag_object),target, intent(inout), allocatable :: diagobj !< The diag variable object
class(*), dimension(:,:,:,:,:) , intent(in) , target :: var !< The variable
class(*), dimension(:,:,:,:,:) , pointer :: vptr => NULL() !< A pointer to the data
integer, optional , intent(in) :: time !< A time place holder
integer, optional , intent(in) :: is_in !< Start of the first dimension
integer, optional , intent(in) :: js_in !< Start of the second dimension
integer, optional , intent(in) :: ks_in !< Start of the third dimension
integer, optional , intent(in) :: ie_in !< End of the first dimension
integer, optional , intent(in) :: je_in !< End of the second dimension
integer, optional , intent(in) :: ke_in !< End of the third dimension
logical, optional , intent(in) :: mask !< A lask for point to ignore
real , optional , intent(in) :: rmask !< I DONT KNOW
real , optional , intent(in) :: weight !< Something for averaging?
CHARACTER(len=*) , INTENT(out), OPTIONAL :: err_msg
! local vars
class (fms_diag_object) , pointer :: dptr => NULL()
!> If the diagnostic object is not allocated, then return
if (.not.allocated( diagobj )) return
!> If this is the first call in, set the type to be fms_diag_object_5d
call switch_to_right_type(diagobj, null_5d, &
var(lbound(var,1),lbound(var,2),lbound(var,3),lbound(var,4),lbound(var,5)) )
end subroutine fms_send_data5d
!> \descrption 2D wrapper for fms_send_data
subroutine fms_send_data2d (diagobj, var, time, is_in, js_in, ks_in, mask, &
rmask, ie_in, je_in, ke_in, weight, err_msg)
class (fms_diag_object),target, intent(inout), allocatable :: diagobj !< The diag variable object
class(*), dimension(:,:) , intent(in) , target :: var !< The variable
class(*), dimension(:,:) , pointer :: vptr => NULL() !< A pointer to the data
integer, optional , intent(in) :: time !< A time place holder
integer, optional , intent(in) :: is_in !< Start of the first dimension
integer, optional , intent(in) :: js_in !< Start of the second dimension
integer, optional , intent(in) :: ks_in !< Start of the third dimension
integer, optional , intent(in) :: ie_in !< End of the first dimension
integer, optional , intent(in) :: je_in !< End of the second dimension
integer, optional , intent(in) :: ke_in !< End of the third dimension
logical, optional , intent(in) :: mask !< A lask for point to ignore
real , optional , intent(in) :: rmask !< I DONT KNOW
real , optional , intent(in) :: weight !< Something for averaging?
CHARACTER(len=*) , INTENT(out), OPTIONAL :: err_msg
! local vars
class (fms_diag_object) , pointer :: dptr => NULL()
!> If this is the first call in, set the type to be fms_diag_object_2d
call switch_to_right_type(diagobj, null_2d, var(lbound(var,1),lbound(var,2)) )
end subroutine fms_send_data2d
!> \descrption 3D wrapper for fms_send_data
subroutine fms_send_data3d (diagobj, var, varname, time, is_in, js_in, ks_in, mask, &
rmask, ie_in, je_in, ke_in, weight, err_msg)
class (fms_diag_object),target, intent(inout), allocatable :: diagobj !< The diag variable object
!! TODO: real vs char(*)
!!class(*), dimension(:,:,:) , intent(in) , target :: var !< The variable
real(kind=8), dimension(:,:,:) , intent(in) , target :: var !< The variable
class(*), dimension(:,:,:) , pointer :: vptr => NULL() !< A pointer to the data
character(len=*), intent(in) :: varname !!TODO: Is this neccesary
integer, optional , intent(in) :: time !< A time place holder
integer, optional , intent(in) :: is_in !< Start of the first dimension
integer, optional , intent(in) :: js_in !< Start of the second dimension
integer, optional , intent(in) :: ks_in !< Start of the third dimension
integer, optional , intent(in) :: ie_in !< End of the first dimension
integer, optional , intent(in) :: je_in !< End of the second dimension
integer, optional , intent(in) :: ke_in !< End of the third dimension
logical, optional , intent(in) :: mask !< A lask for point to ignore
real , optional , intent(in) :: rmask !< I DONT KNOW
real , optional , intent(in) :: weight !< Something for averaging?
CHARACTER(len=*) , INTENT(out), OPTIONAL :: err_msg
! local vars
class (fms_diag_object) , pointer :: dptr => NULL()
!
!> If the diagnostic object is not allocated, then return
if (.not. allocated( diagobj )) then
call diag_error("fms_send_data3d", "The diag object " // diagobj%get_varname() // &
" is not allocated", WARNING)
endif
return
!> If this is the first call in, set the type to be fms_diag_object_3d
!> first check if already of type 3d
call switch_to_right_type(diagobj, null_3d, var(lbound(var,1),lbound(var,2),lbound(var,3)) )
!> If the diagnostic object is not registered, then return.
if(.not. diagobj%is_registeredB()) return
!> Write the object if its static
!> TODO: Only if its not yet writtennetcd
if ( .not. diagobj%is_static() ) then
call write_static(diagobj, var, varname, time, is_in, js_in, ks_in, mask, &
rmask, ie_in, je_in, ke_in, weight, err_msg)
!else write dynamic
endif
end subroutine fms_send_data3d
!> \Description This routine is used to switch the diag object to the correct type based on the dimensions
!! of the input data. It then determines the type of the data, and stores that within the object. Only
!! one datum needs to be send in to determine the data type, so this routine is shared by all of the
!! send_data calls.
!! This only needs to be done one time.
subroutine switch_to_right_type(diagobj, null_obj,var)
class (fms_diag_object),target, intent(inout), allocatable :: diagobj !< The diag variable object
class (fms_diag_object),intent(in) :: null_obj !< The null object that matches the diagnostic
class (*) ,intent (in) :: var
class (fms_diag_object), allocatable :: dcopy
class (fms_diag_object), pointer :: dptr => NULL()
dptr => diagobj
select type (dptr)
type is (fms_diag_object)
!> Switch the diagobj to the correct type
dcopy = null_obj !< Copy null into the temp object to set the type
call dptr%copy(dcopy) !> Copy the values of the object into the tFmsNetcdfFile_temp dcopy
deallocate(diagobj) !> Deallocate the object
diagobj = null_obj !> Copy the null into the variable object to set the type
call dcopy%copy(diagobj) !> Copy the original values in
!> Determne the type of var
call diagobj%set_type(var)
end select
if (allocated(dcopy)) deallocate(dcopy)
if (associated(dptr)) nullify(dptr) !> Dont leak memory
end subroutine switch_to_right_type
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine fms_send_data
end subroutine fms_send_data
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end module fms_diag_send_data_mod