YetAnotherCoupler 3.1.1
Loading...
Searching...
No Matches
yac_finterface.F90
Go to the documentation of this file.
1! Copyright (c) 2024 The YAC Authors
2!
3! SPDX-License-Identifier: BSD-3-Clause
4
6
8
9 contains
10
11#define YAC_FASSERT(exp, msg) IF (.NOT. exp) call yac_abort_message(msg, __FILE__, __LINE__)
12
16 function yac_internal_cptr2char( cptr ) result (string)
17
18 use, intrinsic :: iso_c_binding, only: c_ptr, c_char, &
19 c_f_pointer,c_size_t
20
21 implicit none
22
23 TYPE(c_ptr), intent(in) :: cptr
24 CHARACTER(len=:), allocatable :: string
25 CHARACTER(kind=c_char), dimension(:), pointer :: chars
26 INTEGER(kind=c_size_t) :: i, strlen
27
28 interface
29 function strlen_c(str_ptr) bind ( C, name = "strlen" ) result(len)
30 use, intrinsic :: iso_c_binding
31 type(c_ptr), value :: str_ptr
32 integer(kind=c_size_t) :: len
33 end function strlen_c
34 end interface
35
36 strlen = strlen_c(cptr)
37 CALL c_f_pointer(cptr, chars, [ strlen ])
38 ALLOCATE(character(len=strlen) :: string)
39 DO i=1,strlen
40 string(i:i) = chars(i)
41 END DO
42 end function yac_internal_cptr2char
43
46 subroutine yac_check_strlength ( in_string )
47
49
50 implicit none
51
52 character (len=*), intent (in) :: in_string
53
54 yac_fassert(len_trim(in_string) < yac_max_charlen, "ERROR(yac_check_strlength): string " // trim(in_string) // "exceeds length of YAC_MAX_CHARLEN")
55
56 end subroutine yac_check_strlength
57
58end module mo_yac_iso_c_helpers
59
61
62 public :: send_field_to_dble, &
69
70contains
71
72 subroutine send_field_to_dble(field_id, &
73 nbr_hor_points, &
74 nbr_pointsets, &
75 collection_size, &
76 send_field, &
77 send_field_dble, &
78 send_frac_mask, &
79 send_frac_mask_dble)
80
82 use iso_c_binding, only: c_ptr, c_f_pointer, c_int, c_associated
83
84 implicit none
85
86 interface
87
88 function yac_get_field_put_mask_c2f_c ( field_id ) &
89 bind( c, name='yac_get_field_put_mask_c2f' )
90
91 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
92
93 integer ( kind=c_int ), value :: field_id
94 type(c_ptr) :: yac_get_field_put_mask_c2f_c
95
96 end function yac_get_field_put_mask_c2f_c
97
98 end interface
99
100 integer, intent (in) :: field_id
101 integer, intent (in) :: nbr_hor_points
102 integer, intent (in) :: nbr_pointsets
103 integer, intent (in) :: collection_size
104 real, intent (in) :: send_field(nbr_hor_points, &
105 nbr_pointsets, &
106 collection_size)
107 double precision, intent (out) :: send_field_dble(nbr_hor_points, &
108 nbr_pointsets, &
109 collection_size)
110 real, optional, intent (in) :: send_frac_mask(nbr_hor_points, &
111 nbr_pointsets, &
112 collection_size)
113 double precision, optional, intent (out) :: send_frac_mask_dble(nbr_hor_points, &
114 nbr_pointsets, &
115 collection_size)
116
117 integer :: i, j, k
118 type(c_ptr) :: put_mask_
119 type(c_ptr), pointer :: put_mask(:)
120 integer(kind=c_int), pointer :: pointset_put_mask(:)
121
123
124 put_mask_ = yac_get_field_put_mask_c2f_c(field_id)
125 if (c_associated(put_mask_)) then
126 call c_f_pointer(put_mask_, put_mask, shape=[nbr_pointsets])
127 do i = 1, collection_size
128 do j = 1, nbr_pointsets
129 call c_f_pointer( &
130 put_mask(j), pointset_put_mask, shape=[nbr_hor_points])
131 do k = 1, nbr_hor_points
132 if (pointset_put_mask(k) /= 0) then
133 send_field_dble(k, j, i) = dble(send_field(k, j, i))
134 else
135 send_field_dble(k, j, i) = 0d0
136 end if
137 end do
138 end do
139 end do
140 if (present(send_frac_mask)) then
141 do i = 1, collection_size
142 do j = 1, nbr_pointsets
143 call c_f_pointer( &
144 put_mask(j), pointset_put_mask, shape=[nbr_hor_points])
145 do k = 1, nbr_hor_points
146 if (pointset_put_mask(k) /= 0) then
147 send_frac_mask_dble(k, j, i) = dble(send_frac_mask(k, j, i))
148 else
149 send_frac_mask_dble(k, j, i) = 0d0
150 end if
151 end do
152 end do
153 end do
154 end if
155 else
156 send_field_dble = dble(send_field)
157 if (present(send_frac_mask)) then
158 send_frac_mask_dble = dble(send_frac_mask)
159 end if
160 end if
161 else
162 send_field_dble = 0d0
163 if (present(send_frac_mask)) then
164 send_frac_mask_dble = 0d0
165 end if
166 end if
167 end subroutine send_field_to_dble
168
169 subroutine send_field_to_dble_single(field_id, &
170 nbr_hor_points, &
171 collection_size, &
172 send_field, &
173 send_field_dble, &
174 send_frac_mask, &
175 send_frac_mask_dble)
176
178 use iso_c_binding, only: c_ptr, c_f_pointer, c_int, c_associated
179
180 implicit none
181
182 interface
183
184 function yac_get_field_put_mask_c2f_c ( field_id ) &
185 bind( c, name='yac_get_field_put_mask_c2f' )
186
187 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
188
189 integer ( kind=c_int ), value :: field_id
190 type(c_ptr) :: yac_get_field_put_mask_c2f_c
191
192 end function yac_get_field_put_mask_c2f_c
193
194 end interface
195
196 integer, intent (in) :: field_id
197 integer, intent (in) :: nbr_hor_points
198 integer, intent (in) :: collection_size
199 real, intent (in) :: send_field(nbr_hor_points, &
200 collection_size)
201 double precision, intent (out) :: send_field_dble(nbr_hor_points, &
202 collection_size)
203 real, optional, intent (in) :: send_frac_mask(nbr_hor_points, &
204 collection_size)
205 double precision, optional, intent (out) :: send_frac_mask_dble(nbr_hor_points, &
206 collection_size)
207
208 integer :: i, j
209 type(c_ptr) :: put_mask_
210 type(c_ptr), pointer :: put_mask(:)
211 integer(kind=c_int), pointer :: pointset_put_mask(:)
212
214
215 put_mask_ = yac_get_field_put_mask_c2f_c(field_id)
216 if (c_associated(put_mask_)) then
217 call c_f_pointer(put_mask_, put_mask, shape=[1])
218 do i = 1, collection_size
219 call c_f_pointer( &
220 put_mask(1), pointset_put_mask, shape=[nbr_hor_points])
221 do j = 1, nbr_hor_points
222 if (pointset_put_mask(j) /= 0) then
223 send_field_dble(j, i) = dble(send_field(j, i))
224 else
225 send_field_dble(j, i) = 0d0
226 end if
227 end do
228 end do
229 if (present(send_frac_mask)) then
230 do i = 1, collection_size
231 call c_f_pointer( &
232 put_mask(1), pointset_put_mask, shape=[nbr_hor_points])
233 do j = 1, nbr_hor_points
234 if (pointset_put_mask(j) /= 0) then
235 send_frac_mask_dble(j, i) = dble(send_frac_mask(j, i))
236 else
237 send_frac_mask_dble(j, i) = 0d0
238 end if
239 end do
240 end do
241 end if
242 else
243 send_field_dble = dble(send_field)
244 if (present(send_frac_mask)) then
245 send_frac_mask_dble = dble(send_frac_mask)
246 end if
247 end if
248 else
249 send_field_dble = 0d0
250 if (present(send_frac_mask)) then
251 send_frac_mask_dble = 0d0
252 end if
253 end if
254 end subroutine send_field_to_dble_single
255
256 subroutine send_field_to_dble_ptr(field_id, &
257 nbr_pointsets, &
258 collection_size, &
259 send_field, &
260 send_field_dble, &
261 send_frac_mask, &
262 send_frac_mask_dble)
263
265 use iso_c_binding, only: c_ptr, c_f_pointer, c_int, c_associated
266
267 implicit none
268
269 interface
270
271 function yac_get_field_put_mask_c2f_c ( field_id ) &
272 bind( c, name='yac_get_field_put_mask_c2f' )
273
274 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
275
276 integer ( kind=c_int ), value :: field_id
277 type(c_ptr) :: yac_get_field_put_mask_c2f_c
278
279 end function yac_get_field_put_mask_c2f_c
280
281 end interface
282
283 integer, intent (in) :: field_id
284 integer, intent (in) :: nbr_pointsets
285 integer, intent (in) :: collection_size
286 type(yac_real_ptr), intent (in) :: send_field(nbr_pointsets, &
287 collection_size)
288 type(yac_dble_ptr), intent (out) :: send_field_dble(nbr_pointsets, &
289 collection_size)
290 type(yac_real_ptr), optional, intent (in) :: send_frac_mask(nbr_pointsets, &
291 collection_size)
292 type(yac_dble_ptr), optional, intent (out) :: send_frac_mask_dble(nbr_pointsets, &
293 collection_size)
294
295 integer :: i, j, k, nbr_hor_points
296 type(c_ptr) :: put_mask_
297 type(c_ptr), pointer :: put_mask(:)
298 integer(kind=c_int), pointer :: pointset_put_mask(:)
299
301
302 put_mask_ = yac_get_field_put_mask_c2f_c(field_id)
303 if (c_associated(put_mask_)) then
304 call c_f_pointer(put_mask_, put_mask, shape=[nbr_pointsets])
305 do i = 1, collection_size
306 do j = 1, nbr_pointsets
307 nbr_hor_points = size(send_field(j,i)%p)
308 allocate(send_field_dble(j,i)%p(nbr_hor_points))
309 call c_f_pointer( &
310 put_mask(j), pointset_put_mask, shape=[nbr_hor_points])
311 do k = 1, nbr_hor_points
312 if (pointset_put_mask(k) /= 0) then
313 send_field_dble(j, i)%p(k) = dble(send_field(j, i)%p(k))
314 else
315 send_field_dble(j, i)%p(k) = 0d0
316 end if
317 end do
318 end do
319 end do
320 if (present(send_frac_mask)) then
321 do i = 1, collection_size
322 do j = 1, nbr_pointsets
323 nbr_hor_points = size(send_frac_mask(j,i)%p)
324 allocate(send_frac_mask_dble(j,i)%p(nbr_hor_points))
325 call c_f_pointer( &
326 put_mask(j), pointset_put_mask, shape=[nbr_hor_points])
327 do k = 1, nbr_hor_points
328 if (pointset_put_mask(k) /= 0) then
329 send_frac_mask_dble(j, i)%p(k) = dble(send_frac_mask(j, i)%p(k))
330 else
331 send_frac_mask_dble(j, i)%p(k) = 0d0
332 end if
333 end do
334 end do
335 end do
336 end if
337 else
338 do i = 1, collection_size
339 do j = 1, nbr_pointsets
340 nbr_hor_points = size(send_field(j,i)%p)
341 allocate(send_field_dble(j,i)%p(nbr_hor_points))
342 send_field_dble(j,i)%p = dble(send_field(j,i)%p)
343 end do
344 end do
345 if (present(send_frac_mask)) then
346 do i = 1, collection_size
347 do j = 1, nbr_pointsets
348 nbr_hor_points = size(send_frac_mask(j,i)%p)
349 allocate(send_frac_mask_dble(j,i)%p(nbr_hor_points))
350 send_frac_mask_dble(j,i)%p = dble(send_frac_mask(j,i)%p)
351 end do
352 end do
353 end if
354 end if
355 else
356 do i = 1, collection_size
357 do j = 1, nbr_pointsets
358 nbr_hor_points = size(send_field(j,i)%p)
359 allocate(send_field_dble(j,i)%p(nbr_hor_points))
360 send_field_dble(j,i)%p = 0d0
361 end do
362 end do
363 if (present(send_frac_mask)) then
364 do i = 1, collection_size
365 do j = 1, nbr_pointsets
366 nbr_hor_points = size(send_frac_mask(j,i)%p)
367 allocate(send_frac_mask_dble(j,i)%p(nbr_hor_points))
368 send_frac_mask_dble(j,i)%p = 0d0
369 end do
370 end do
371 end if
372 end if
373 end subroutine send_field_to_dble_ptr
374
375 ! -----------------------------------------------------------------------
376
377 subroutine recv_field_to_dble(field_id, &
378 nbr_hor_points, &
379 collection_size, &
380 recv_field, &
381 recv_field_dble)
382
384 use iso_c_binding, only: c_ptr, c_f_pointer, c_int, c_associated
385
386 implicit none
387
388 interface
389
390 function yac_get_field_get_mask_c2f_c ( field_id ) &
391 bind( c, name='yac_get_field_get_mask_c2f' )
392
393 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
394
395 integer ( kind=c_int ), value :: field_id
396 type(c_ptr) :: yac_get_field_get_mask_c2f_c
397
398 end function yac_get_field_get_mask_c2f_c
399
400 end interface
401
402 integer, intent (in) :: field_id
403 integer, intent (in) :: nbr_hor_points
404 integer, intent (in) :: collection_size
405 real, intent (in) :: recv_field(nbr_hor_points, &
406 collection_size)
407 double precision, intent (out) :: recv_field_dble(nbr_hor_points, &
408 collection_size)
409
410 integer :: i, j
411 type(c_ptr) :: get_mask_
412 integer(kind=c_int), pointer :: get_mask(:)
413
415
416 get_mask_ = yac_get_field_get_mask_c2f_c(field_id)
417 if (c_associated(get_mask_)) then
418 call c_f_pointer(get_mask_, get_mask, shape=[nbr_hor_points])
419 do i = 1, collection_size
420 do j = 1, nbr_hor_points
421 if (get_mask(j) /= 0) then
422 recv_field_dble(j, i) = dble(recv_field(j, i))
423 else
424 recv_field_dble(j, i) = 0d0
425 end if
426 end do
427 end do
428 else
429 recv_field_dble = dble(recv_field)
430 end if
431 else
432 recv_field_dble = 0d0
433 end if
434 end subroutine recv_field_to_dble
435
436 subroutine recv_field_to_dble_ptr(field_id, &
437 collection_size, &
438 recv_field, &
439 recv_field_dble)
440
442 use iso_c_binding, only: c_ptr, c_f_pointer, c_int, c_associated
443
444 implicit none
445
446 interface
447
448 function yac_get_field_get_mask_c2f_c ( field_id ) &
449 bind( c, name='yac_get_field_get_mask_c2f' )
450
451 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
452
453 integer ( kind=c_int ), value :: field_id
454 type(c_ptr) :: yac_get_field_get_mask_c2f_c
455
456 end function yac_get_field_get_mask_c2f_c
457
458 end interface
459
460 integer, intent (in) :: field_id
461 integer, intent (in) :: collection_size
462 type(yac_real_ptr), intent (in) :: recv_field(collection_size)
463 type(yac_dble_ptr), intent (out) :: recv_field_dble(collection_size)
464
465 integer :: i, j, nbr_hor_points
466 type(c_ptr) :: get_mask_
467 integer(kind=c_int), pointer :: get_mask(:)
468
470
471 get_mask_ = yac_get_field_get_mask_c2f_c(field_id)
472 if (c_associated(get_mask_) .and. (collection_size > 0)) then
473 nbr_hor_points = size(recv_field(1)%p)
474 call c_f_pointer(get_mask_, get_mask, shape=[nbr_hor_points])
475 do i = 1, collection_size
476 nbr_hor_points = size(recv_field(i)%p)
477 allocate(recv_field_dble(i)%p(nbr_hor_points))
478 do j = 1, nbr_hor_points
479 if (get_mask(j) /= 0) then
480 recv_field_dble(i)%p(j) = dble(recv_field(i)%p(j))
481 else
482 recv_field_dble(i)%p(j) = 0d0
483 end if
484 end do
485 end do
486 else
487 do i = 1, collection_size
488 nbr_hor_points = size(recv_field(i)%p)
489 allocate(recv_field_dble(i)%p(nbr_hor_points))
490 recv_field_dble(i)%p = dble(recv_field(i)%p)
491 end do
492 end if
493 else
494 do i = 1, collection_size
495 nbr_hor_points = size(recv_field(i)%p)
496 allocate(recv_field_dble(i)%p(nbr_hor_points))
497 recv_field_dble(i)%p = 0d0
498 end do
499 end if
500 end subroutine recv_field_to_dble_ptr
501
502 ! -----------------------------------------------------------------------
503
504 subroutine recv_field_from_dble(field_id, &
505 nbr_hor_points, &
506 collection_size, &
507 recv_field_dble, &
508 recv_field)
509
511 use iso_c_binding, only: c_ptr, c_f_pointer, c_int, c_associated
512
513 implicit none
514
515 interface
516
517 function yac_get_field_get_mask_c2f_c ( field_id ) &
518 bind( c, name='yac_get_field_get_mask_c2f' )
519
520 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
521
522 integer ( kind=c_int ), value :: field_id
523 type(c_ptr) :: yac_get_field_get_mask_c2f_c
524
525 end function yac_get_field_get_mask_c2f_c
526
527 end interface
528
529 integer, intent (in) :: field_id
530 integer, intent (in) :: nbr_hor_points
531 integer, intent (in) :: collection_size
532 double precision, intent (in) :: recv_field_dble(nbr_hor_points, &
533 collection_size)
534 real, intent (inout) :: recv_field(nbr_hor_points, &
535 collection_size)
536
537 integer :: i, j
538 type(c_ptr) :: get_mask_
539 integer(kind=c_int), pointer :: get_mask(:)
540
542
543 get_mask_ = yac_get_field_get_mask_c2f_c(field_id)
544 if (c_associated(get_mask_)) then
545 call c_f_pointer(get_mask_, get_mask, shape=[nbr_hor_points])
546 do i = 1, collection_size
547 do j = 1, nbr_hor_points
548 if (get_mask(j) /= 0) then
549 recv_field(j, i) = real(recv_field_dble(j, i))
550 end if
551 end do
552 end do
553 else
554 recv_field = real(recv_field_dble)
555 end if
556 end if
557 end subroutine recv_field_from_dble
558
559 subroutine recv_field_from_dble_ptr(field_id, &
560 collection_size, &
561 recv_field_dble, &
562 recv_field)
563
565 use iso_c_binding, only: c_ptr, c_f_pointer, c_int, c_associated
566
567 implicit none
568
569 interface
570
571 function yac_get_field_get_mask_c2f_c ( field_id ) &
572 bind( c, name='yac_get_field_get_mask_c2f' )
573
574 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
575
576 integer ( kind=c_int ), value :: field_id
577 type(c_ptr) :: yac_get_field_get_mask_c2f_c
578
579 end function yac_get_field_get_mask_c2f_c
580
581 end interface
582
583 integer, intent (in) :: field_id
584 integer, intent (in) :: collection_size
585 type(yac_dble_ptr), intent (inout) :: recv_field_dble(collection_size)
586 type(yac_real_ptr), intent (inout) :: recv_field(collection_size)
587
588 integer :: i, j, nbr_hor_points
589 type(c_ptr) :: get_mask_
590 integer(kind=c_int), pointer :: get_mask(:)
591
593
594 get_mask_ = yac_get_field_get_mask_c2f_c(field_id)
595 if (c_associated(get_mask_) .and. (collection_size > 0)) then
596 nbr_hor_points = size(recv_field(1)%p)
597 call c_f_pointer(get_mask_, get_mask, shape=[nbr_hor_points])
598 do i = 1, collection_size
599 nbr_hor_points = size(recv_field(i)%p)
600 do j = 1, nbr_hor_points
601 if (get_mask(j) /= 0) then
602 recv_field(i)%p(j) = real(recv_field_dble(i)%p(j))
603 end if
604 end do
605 deallocate(recv_field_dble(i)%p)
606 end do
607 else
608 do i = 1, collection_size
609 recv_field(i)%p = real(recv_field_dble(i)%p)
610 deallocate(recv_field_dble(i)%p)
611 end do
612 end if
613 end if
614 end subroutine recv_field_from_dble_ptr
615
617
618! -------------------------- init -------------------------------------
619
620subroutine yac_fmpi_handshake ( comm, group_names, group_comms )
621 use, intrinsic :: iso_c_binding, only : c_ptr, c_null_char, c_loc
623
624 implicit none
625
626 interface
627 subroutine yac_cmpi_handshake_c (comm, n, group_names, group_comms) &
628 bind( c, name='yac_cmpi_handshake_f2c')
629 use, intrinsic :: iso_c_binding, only : c_ptr, c_int
631 integer (kind = YAC_MPI_FINT_KIND ), intent(in), value :: comm
632 integer(c_int), intent(in), value :: n
633 type (c_ptr) , intent(in) :: group_names(n)
634 integer (kind = YAC_MPI_FINT_KIND ), intent(out) :: group_comms(n)
635 end subroutine yac_cmpi_handshake_c
636 end interface
637
638 integer, intent(in) :: comm
639 character(len=YAC_MAX_CHARLEN), intent(in) :: group_names(:)
640 integer, intent(out) :: group_comms(SIZE(group_names))
641
642 CHARACTER (kind=c_char, len=YAC_MAX_CHARLEN+1), TARGET :: &
643 group_names_cpy(SIZE(group_names))
644 type( c_ptr ) :: group_name_ptr(SIZE(group_names))
645 integer :: i
646 DO i=1,SIZE(group_names)
647 group_names_cpy(i) = trim(group_names(i)) // c_null_char
648 group_name_ptr(i) = c_loc(group_names_cpy(i))
649 END DO
650
651 call yac_cmpi_handshake_c( &
652 comm, SIZE(group_names), group_name_ptr, group_comms)
653
654end subroutine yac_fmpi_handshake
655
657
660
661 implicit none
662
663 interface
664
665 function yac_cyaml_get_emitter_flag_default () &
666 bind( c, name='yac_cyaml_get_emitter_flag_default_c2f' )
667
668 use, intrinsic :: iso_c_binding, only : c_int
669
670 integer ( kind=c_int) :: yac_cyaml_get_emitter_flag_default
671
672 end function yac_cyaml_get_emitter_flag_default
673
674 function yac_cyaml_get_emitter_flag_json () &
675 bind( c, name='yac_cyaml_get_emitter_flag_json_c2f' )
676
677 use, intrinsic :: iso_c_binding, only : c_int
678
679 integer ( kind=c_int) :: yac_cyaml_get_emitter_flag_json
680
681 end function yac_cyaml_get_emitter_flag_json
682
683 end interface
684
685 yac_yaml_emitter_default_f = yac_cyaml_get_emitter_flag_default()
686 yac_yaml_emitter_json_f = yac_cyaml_get_emitter_flag_json()
687
688end subroutine
689
690subroutine yac_finit_comm ( comm )
691
692 use, intrinsic :: iso_c_binding, only : c_null_char
694
695 implicit none
696
697 interface
698
699 subroutine yac_cinit_comm_c ( comm ) &
700 bind( c, name='yac_cinit_comm_f2c' )
701
702 use, intrinsic :: iso_c_binding, only : c_char
704
705 integer ( kind=YAC_MPI_FINT_KIND ), value :: comm
706
707 end subroutine yac_cinit_comm_c
708
709 subroutine yac_finit_emitter_flags()
710 end subroutine yac_finit_emitter_flags
711
712 end interface
713
714 integer, intent(in) :: comm
715
717 call yac_cinit_comm_c ( comm )
718
719end subroutine yac_finit_comm
720
721subroutine yac_finit_comm_instance( comm, yac_instance_id)
722
723 use, intrinsic :: iso_c_binding, only : c_null_char
725
726 implicit none
727
728 interface
729
730 subroutine yac_cinit_comm_instance_c ( comm, yac_instance_id) &
731 bind( c, name='yac_cinit_comm_instance_f2c' )
732
733 use, intrinsic :: iso_c_binding, only : c_char, c_int
735
736 integer ( kind=YAC_MPI_FINT_KIND ), value :: comm
737 integer (kind=c_int) :: yac_instance_id
738
739 end subroutine yac_cinit_comm_instance_c
740
741 subroutine yac_finit_emitter_flags()
742 end subroutine yac_finit_emitter_flags
743
744 end interface
745
746 integer, intent(in) :: comm
747 integer, intent(out) :: yac_instance_id
748
750 call yac_cinit_comm_instance_c ( comm, yac_instance_id )
751
752end subroutine yac_finit_comm_instance
753
754subroutine yac_finit ( )
755
756 use, intrinsic :: iso_c_binding, only : c_null_char
757 use mo_yac_finterface, dummy => yac_finit
758
759 implicit none
760
761 interface
762
763 subroutine yac_cinit_c ( ) &
764 bind( c, name='yac_cinit' )
765
766 use, intrinsic :: iso_c_binding, only : c_char
767
768 end subroutine yac_cinit_c
769
770 subroutine yac_finit_emitter_flags()
771 end subroutine yac_finit_emitter_flags
772
773 end interface
774
776 call yac_cinit_c ( )
777
778end subroutine yac_finit
779
780subroutine yac_finit_instance ( yac_instance_id )
781
782 use, intrinsic :: iso_c_binding, only : c_null_char
784
785 implicit none
786
787 interface
788
789 subroutine yac_cinit_instance_c ( yac_instance_id ) &
790 bind( c, name='yac_cinit_instance' )
791
792 use, intrinsic :: iso_c_binding, only : c_char, c_int
793
794 integer (kind=c_int) :: yac_instance_id
795
796 end subroutine yac_cinit_instance_c
797
798 subroutine yac_finit_emitter_flags()
799 end subroutine yac_finit_emitter_flags
800
801 end interface
802
803 integer, intent(out) :: yac_instance_id
804
806 call yac_cinit_instance_c ( yac_instance_id )
807
808end subroutine yac_finit_instance
809
810subroutine yac_finit_comm_dummy ( world_comm )
811
813
814 implicit none
815
816 interface
817
818 subroutine yac_cinit_comm_dummy_c ( world_comm ) &
819 bind( c, name='yac_cinit_comm_dummy_f2c' )
820
822
823 integer ( kind=YAC_MPI_FINT_KIND ), value :: world_comm
824
825 end subroutine yac_cinit_comm_dummy_c
826
827 subroutine yac_finit_emitter_flags()
828 end subroutine yac_finit_emitter_flags
829
830 end interface
831
832 integer, intent(in) :: world_comm
833
835 call yac_cinit_comm_dummy_c ( world_comm )
836
837end subroutine yac_finit_comm_dummy
838
839subroutine yac_finit_dummy ( )
840
842
843 implicit none
844
845 interface
846
847 subroutine yac_cinit_dummy_c ( ) &
848 bind( c, name='yac_cinit_dummy' )
849
850 end subroutine yac_cinit_dummy_c
851
852 subroutine yac_finit_emitter_flags()
853 end subroutine yac_finit_emitter_flags
854
855 end interface
856
858 call yac_cinit_dummy_c ( )
859
860end subroutine yac_finit_dummy
861
862
863! -------------------------- reading config file ---------------------------
864
865subroutine yac_fread_config_yaml (yaml_filename)
867 use, intrinsic :: iso_c_binding, only : c_null_char
869
870 implicit none
871
872 interface
873 subroutine yac_cread_config_yaml_c(yaml_filename) &
874 bind( c, name='yac_cread_config_yaml' )
875 use, intrinsic :: iso_c_binding, only : c_char
876 character (kind=c_char), dimension(*) :: yaml_filename
877 end subroutine yac_cread_config_yaml_c
878 end interface
879
880 character(len=*), intent(in) :: yaml_filename
881
882 call yac_cread_config_yaml_c(trim(yaml_filename) // c_null_char)
883
884end subroutine yac_fread_config_yaml
885
886subroutine yac_fread_config_yaml_instance(yac_instance_id, yaml_filename)
888 use, intrinsic :: iso_c_binding, only : c_null_char
890
891 implicit none
892
893 interface
894 subroutine yac_cread_config_yaml_instance_c( &
895 yac_instance_id, yaml_filename) &
896 bind( c, name='yac_cread_config_yaml_instance' )
897 use, intrinsic :: iso_c_binding, only : c_char, c_int
898 integer (kind=c_int), value :: yac_instance_id
899 character (kind=c_char), dimension(*) :: yaml_filename
900 end subroutine yac_cread_config_yaml_instance_c
901 end interface
902
903 integer, intent(in) :: yac_instance_id
904 character(len=*), intent(in) :: yaml_filename
905
906 call yac_cread_config_yaml_instance_c(yac_instance_id, &
907 & trim(yaml_filename) // c_null_char)
908
910
911subroutine yac_fread_config_json (json_filename)
913 use, intrinsic :: iso_c_binding, only : c_null_char
915
916 implicit none
917
918 interface
919 subroutine yac_cread_config_json_c(json_filename) &
920 bind( c, name='yac_cread_config_json' )
921 use, intrinsic :: iso_c_binding, only : c_char
922 character (kind=c_char), dimension(*) :: json_filename
923 end subroutine yac_cread_config_json_c
924 end interface
925
926 character(len=*), intent(in) :: json_filename
927
928 call yac_cread_config_json_c(trim(json_filename) // c_null_char)
929
930end subroutine yac_fread_config_json
931
932subroutine yac_fread_config_json_instance(yac_instance_id, json_filename)
934 use, intrinsic :: iso_c_binding, only : c_null_char
936
937 implicit none
938
939 interface
940 subroutine yac_cread_config_json_instance_c( &
941 yac_instance_id, json_filename) &
942 bind( c, name='yac_cread_config_json_instance' )
943 use, intrinsic :: iso_c_binding, only : c_char, c_int
944 integer (kind=c_int), value :: yac_instance_id
945 character (kind=c_char), dimension(*) :: json_filename
946 end subroutine yac_cread_config_json_instance_c
947 end interface
948
949 integer, intent(in) :: yac_instance_id
950 character(len=*), intent(in) :: json_filename
951
952 call yac_cread_config_json_instance_c(yac_instance_id, &
953 & trim(json_filename) // c_null_char)
954
956
957! -------------------------- cleanup -----------------------------------
958
959subroutine yac_fcleanup ( )
960
961 use mo_yac_finterface, dummy => yac_fcleanup
962
963 implicit none
964
965 interface
966
967 subroutine yac_ccleanup_c () bind ( c, name='yac_ccleanup' )
968 end subroutine yac_ccleanup_c
969
970 end interface
971
972 call yac_ccleanup_c ( )
973
974end subroutine yac_fcleanup
975
976subroutine yac_fcleanup_instance ( yac_instance_id )
977
979
980 implicit none
981
982 interface
983
984 subroutine yac_ccleanup_instance_c ( yac_instance_id ) &
985 bind( c, name='yac_ccleanup_instance' )
986
987 use, intrinsic :: iso_c_binding, only : c_int
988
989 integer (kind=c_int), value :: yac_instance_id
990
991 end subroutine yac_ccleanup_instance_c
992
993 end interface
994
995 integer, intent(in) :: yac_instance_id
996
997 call yac_ccleanup_instance_c ( yac_instance_id )
998
999end subroutine yac_fcleanup_instance
1000
1001! -------------------------- final -------------------------------------
1002
1003subroutine yac_ffinalize ( )
1004
1005 use mo_yac_finterface, dummy => yac_ffinalize
1006
1007 implicit none
1008
1009 interface
1010 subroutine yac_cfinalize_c () bind ( c, name='yac_cfinalize' )
1011 end subroutine yac_cfinalize_c
1012 end interface
1013
1014 call yac_cfinalize_c ( )
1015
1016end subroutine yac_ffinalize
1017
1018subroutine yac_ffinalize_instance ( yac_instance_id )
1019
1021
1022 implicit none
1023
1024 interface
1025 subroutine yac_cfinalize_instance_c ( yac_instance_id ) &
1026 bind( c, name='yac_cfinalize_instance' )
1027
1028 use, intrinsic :: iso_c_binding, only : c_int
1029
1030 integer (kind=c_int), value :: yac_instance_id
1031
1032 end subroutine yac_cfinalize_instance_c
1033 end interface
1034
1035 integer, intent(in) :: yac_instance_id
1036
1037 call yac_cfinalize_instance_c ( yac_instance_id )
1038
1039end subroutine yac_ffinalize_instance
1040
1041! -------------------------- version ----------------------------------
1042
1043function yac_fget_version () result (version_string)
1044
1045 use, intrinsic :: iso_c_binding, only : c_ptr
1048
1049 implicit none
1050
1051 interface
1052 function yac_cget_version_c () bind ( c, name='yac_cget_version' )
1053
1054 use, intrinsic :: iso_c_binding, only : c_ptr
1055 type(c_ptr) :: yac_cget_version_c
1056
1057 end function yac_cget_version_c
1058 end interface
1059
1060 type (c_ptr) :: c_string_ptr
1061 character (len=:), ALLOCATABLE :: version_string
1062
1063 c_string_ptr = yac_cget_version_c()
1064 version_string = yac_internal_cptr2char(c_string_ptr)
1065
1066end function yac_fget_version
1067
1068! -------------------------- dates ------------------------------------
1069
1070subroutine yac_fdef_datetime ( start_datetime, end_datetime )
1071
1072 use, intrinsic :: iso_c_binding, only : c_null_char
1075
1076 implicit none
1077
1078 interface
1079
1080 subroutine yac_cdef_datetime_c ( start_datetime, end_datetime ) &
1081 & bind( c, name='yac_cdef_datetime' )
1082
1083 use, intrinsic :: iso_c_binding, only : c_char
1084
1085 character ( kind=c_char), dimension(*) :: start_datetime
1086 character ( kind=c_char), dimension(*) :: end_datetime
1087
1088 end subroutine yac_cdef_datetime_c
1089
1090 end interface
1091
1092 character(len=*), intent(in), optional :: start_datetime
1093 character(len=*), intent(in), optional :: end_datetime
1094
1095 integer :: index
1096
1097 index = 0
1098
1099
1100 if (present(start_datetime)) then
1101 call yac_check_strlength ( start_datetime )
1102 index = index + 1
1103 end if
1104
1105 if (present(end_datetime)) then
1106 call yac_check_strlength ( end_datetime )
1107 index = index + 2
1108 end if
1109
1110 select case ( index )
1111
1112 case ( 3 )
1113 call yac_cdef_datetime_c ( trim(start_datetime) // c_null_char, &
1114 trim(end_datetime) // c_null_char )
1115 case ( 2 )
1116 call yac_cdef_datetime_c ( c_null_char, &
1117 trim(end_datetime) // c_null_char )
1118 case ( 1 )
1119 call yac_cdef_datetime_c ( trim(start_datetime) // c_null_char, &
1120 c_null_char )
1121 end select
1122
1123end subroutine yac_fdef_datetime
1124
1126 yac_instance_id, start_datetime, end_datetime )
1127
1128 use, intrinsic :: iso_c_binding, only : c_null_char
1131
1132 implicit none
1133
1134 interface
1135
1136 subroutine yac_cdef_datetime_instance_c ( yac_instance_id, &
1137 start_datetime, &
1138 end_datetime ) &
1139 bind( c, name='yac_cdef_datetime_instance' )
1140
1141 use, intrinsic :: iso_c_binding, only : c_char, c_int
1142
1143 integer (kind=c_int), value :: yac_instance_id
1144 character ( kind=c_char), dimension(*) :: start_datetime
1145 character ( kind=c_char), dimension(*) :: end_datetime
1146
1147 end subroutine yac_cdef_datetime_instance_c
1148
1149 end interface
1150
1151 integer, intent(in) :: yac_instance_id
1152 character(len=*), intent(in), optional :: start_datetime
1153 character(len=*), intent(in), optional :: end_datetime
1154
1155 integer :: index
1156
1157 index = 0
1158
1159
1160 if (present(start_datetime)) then
1161 call yac_check_strlength ( start_datetime )
1162 index = index + 1
1163 end if
1164
1165 if (present(end_datetime)) then
1166 call yac_check_strlength ( end_datetime )
1167 index = index + 2
1168 end if
1169
1170 select case ( index )
1171
1172 case ( 3 )
1173 call yac_cdef_datetime_instance_c ( yac_instance_id, &
1174 trim(start_datetime) // c_null_char, &
1175 trim(end_datetime) // c_null_char )
1176 case ( 2 )
1177 call yac_cdef_datetime_instance_c ( yac_instance_id, &
1178 c_null_char, &
1179 trim(end_datetime) // c_null_char )
1180 case ( 1 )
1181 call yac_cdef_datetime_instance_c ( yac_instance_id, &
1182 trim(start_datetime) // c_null_char, &
1183 c_null_char )
1184 end select
1185
1186end subroutine yac_fdef_datetime_instance
1187
1188subroutine yac_fdef_calendar ( calendar )
1189
1191
1192 implicit none
1193
1194 interface
1195
1196 subroutine yac_cdef_calendar_c ( calendar ) &
1197 bind( c, name='yac_cdef_calendar' )
1198 use, intrinsic :: iso_c_binding, only : c_int
1199
1200 integer ( kind=c_int ), value :: calendar
1201
1202 end subroutine yac_cdef_calendar_c
1203
1204 end interface
1205
1206 integer, intent(in) :: calendar
1207
1208 call yac_cdef_calendar_c ( calendar )
1209
1210end subroutine yac_fdef_calendar
1211
1212! ------------------------ predef_comp ------------------------------------
1213
1214SUBROUTINE yac_fpredef_comp ( comp_name, comp_id )
1215
1216 use, intrinsic :: iso_c_binding, only : c_null_char
1219
1220 implicit none
1221
1222 INTERFACE
1223
1224 SUBROUTINE yac_cpredef_comp_c ( comp_name, comp_id ) &
1225 bind( c, name='yac_cpredef_comp' )
1226
1227 use, intrinsic :: iso_c_binding, only : c_int, c_char
1228
1229 character ( kind=c_char), dimension(*) :: comp_name
1230 integer ( kind=c_int ) :: comp_id
1231
1232 END SUBROUTINE yac_cpredef_comp_c
1233
1234 END INTERFACE
1235
1236 character(len=*), intent(in) :: comp_name
1237 integer, intent(out) :: comp_id
1238
1239 call yac_check_strlength ( comp_name )
1240
1241 call yac_cpredef_comp_c ( trim(comp_name) // c_null_char, comp_id )
1242
1243END SUBROUTINE yac_fpredef_comp
1244
1245SUBROUTINE yac_fpredef_comp_instance ( yac_instance_id, comp_name, comp_id )
1246
1247 use, intrinsic :: iso_c_binding, only : c_null_char
1250
1251 implicit none
1252
1253 INTERFACE
1254
1255 SUBROUTINE yac_cpredef_comp_instance_c ( yac_instance_id, &
1256 comp_name, &
1257 comp_id ) &
1258 bind( c, name='yac_cdef_comp_instance' )
1259
1260 use, intrinsic :: iso_c_binding, only : c_int, c_char
1261
1262 integer (kind=c_int), value :: yac_instance_id
1263 character ( kind=c_char), dimension(*) :: comp_name
1264 integer ( kind=c_int ) :: comp_id
1265
1266 END SUBROUTINE yac_cpredef_comp_instance_c
1267
1268 END INTERFACE
1269
1270 integer, intent(in) :: yac_instance_id
1271 character(len=*), intent(in) :: comp_name
1272 integer, intent(out) :: comp_id
1273
1274 call yac_check_strlength ( comp_name )
1275
1276 call yac_cpredef_comp_instance_c( yac_instance_id, &
1277 trim(comp_name) // c_null_char, &
1278 comp_id )
1279
1280END SUBROUTINE yac_fpredef_comp_instance
1281
1282! ------------------------ def_comp ------------------------------------
1283
1284subroutine yac_fdef_comp ( comp_name, comp_id )
1285
1286 use, intrinsic :: iso_c_binding, only : c_null_char
1287 use mo_yac_finterface, dummy => yac_fdef_comp
1289
1290 implicit none
1291
1292 interface
1293
1294 subroutine yac_cdef_comp_c ( comp_name, comp_id ) &
1295 bind( c, name='yac_cdef_comp' )
1296
1297 use, intrinsic :: iso_c_binding, only : c_int, c_char
1298
1299 character ( kind=c_char), dimension(*) :: comp_name
1300 integer ( kind=c_int ) :: comp_id
1301
1302 end subroutine yac_cdef_comp_c
1303
1304 end interface
1305
1306 character(len=*), intent(in) :: comp_name
1307 integer, intent(out) :: comp_id
1308
1309 call yac_check_strlength ( comp_name )
1310
1311 call yac_cdef_comp_c ( trim(comp_name) // c_null_char, comp_id )
1312
1313end subroutine yac_fdef_comp
1314
1315subroutine yac_fdef_comp_instance ( yac_instance_id, comp_name, comp_id )
1316
1317 use, intrinsic :: iso_c_binding, only : c_null_char
1320
1321 implicit none
1322
1323 interface
1324
1325 subroutine yac_cdef_comp_instance_c ( yac_instance_id, &
1326 comp_name, &
1327 comp_id ) &
1328 bind( c, name='yac_cdef_comp_instance' )
1329
1330 use, intrinsic :: iso_c_binding, only : c_int, c_char
1331
1332 integer (kind=c_int), value :: yac_instance_id
1333 character ( kind=c_char), dimension(*) :: comp_name
1334 integer ( kind=c_int ) :: comp_id
1335
1336 end subroutine yac_cdef_comp_instance_c
1337
1338 end interface
1339
1340 integer, intent(in) :: yac_instance_id
1341 character(len=*), intent(in) :: comp_name
1342 integer, intent(out) :: comp_id
1343
1344 call yac_check_strlength ( comp_name )
1345
1346 call yac_cdef_comp_instance_c( yac_instance_id, &
1347 trim(comp_name) // c_null_char, &
1348 comp_id )
1349
1350end subroutine yac_fdef_comp_instance
1351
1352! ------------------------ def_comps ------------------------------------
1353
1354subroutine yac_fdef_comps ( comp_names, num_comps, comp_ids )
1355
1356 use, intrinsic :: iso_c_binding, only : c_null_char, c_ptr, c_loc, c_char
1357 use mo_yac_finterface, dummy => yac_fdef_comps
1359
1360 implicit none
1361
1362 interface
1363
1364 subroutine yac_cdef_comps_c ( comp_names, num_comps, comp_ids ) &
1365 bind( c, name='yac_cdef_comps' )
1366
1367 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
1368
1369 type ( c_ptr ) :: comp_names(*)
1370 integer ( kind=c_int ), value :: num_comps
1371 integer ( kind=c_int ) :: comp_ids(*)
1372
1373 end subroutine yac_cdef_comps_c
1374
1375 end interface
1376
1377 integer, intent(in) :: num_comps
1378 character(kind=c_char, len=*), intent(in) :: &
1379 comp_names(num_comps)
1380 integer, intent(out) :: comp_ids(num_comps)
1381
1382 integer :: i, j
1383 character(kind=c_char), target :: comp_names_cpy(YAC_MAX_CHARLEN+1, num_comps)
1384 type(c_ptr) :: comp_name_ptrs(num_comps)
1385
1386 comp_names_cpy = c_null_char
1387
1388 do i = 1, num_comps
1389 call yac_check_strlength(comp_names(i))
1390 do j = 1, len_trim(comp_names(i))
1391 comp_names_cpy(j,i) = comp_names(i)(j:j)
1392 end do
1393 comp_name_ptrs(i) = c_loc(comp_names_cpy(1,i))
1394 end do
1395
1396 call yac_cdef_comps_c ( comp_name_ptrs, num_comps, comp_ids )
1397
1398end subroutine yac_fdef_comps
1399
1400subroutine yac_fdef_comps_instance ( yac_instance_id, &
1401 comp_names, &
1402 num_comps, &
1403 comp_ids )
1404
1405 use, intrinsic :: iso_c_binding, only : c_null_char, c_ptr, c_loc, c_char
1408
1409 implicit none
1410
1411 interface
1412
1413 subroutine yac_cdef_comps_instance_c ( yac_instance_id, &
1414 comp_names, &
1415 num_comps, &
1416 comp_ids ) &
1417 bind( c, name='yac_cdef_comps_instance' )
1418
1419 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
1420
1421 integer (kind=c_int), value :: yac_instance_id
1422 type ( c_ptr ) :: comp_names(*)
1423 integer ( kind=c_int ), value :: num_comps
1424 integer ( kind=c_int ) :: comp_ids(*)
1425
1426 end subroutine yac_cdef_comps_instance_c
1427
1428 end interface
1429
1430 integer, intent(in) :: yac_instance_id
1431 integer, intent(in) :: num_comps
1432 character(kind=c_char, len=*), intent(in) :: &
1433 comp_names(num_comps)
1434 integer, intent(out) :: comp_ids(num_comps)
1435
1436 integer :: i, j
1437 character(kind=c_char), target :: comp_names_cpy(YAC_MAX_CHARLEN+1, num_comps)
1438 type(c_ptr) :: comp_name_ptrs(num_comps)
1439
1440 comp_names_cpy = c_null_char
1441
1442 do i = 1, num_comps
1443 call yac_check_strlength(comp_names(i))
1444 do j = 1, len_trim(comp_names(i))
1445 comp_names_cpy(j,i) = comp_names(i)(j:j)
1446 end do
1447 comp_name_ptrs(i) = c_loc(comp_names_cpy(1,i))
1448 end do
1449
1450 call yac_cdef_comps_instance_c ( yac_instance_id, &
1451 comp_name_ptrs, &
1452 num_comps, &
1453 comp_ids )
1454
1455end subroutine yac_fdef_comps_instance
1456
1457
1458! ------------------------- def_points ----------------------------------
1459
1460subroutine yac_fdef_points_reg2d_real ( grid_id, &
1461 nbr_points, &
1462 location, &
1463 x_points_real, &
1464 y_points_real, &
1465 point_id )
1466
1468
1469 implicit none
1470
1471 integer, intent(in) :: grid_id
1472 integer, intent(in) :: nbr_points(2)
1473 integer, intent(in) :: location
1474 real, intent(in) :: x_points_real(nbr_points(1))
1475 real, intent(in) :: y_points_real(nbr_points(2))
1476 integer, intent(out) :: point_id
1477
1478 double precision :: x_points(nbr_points(1))
1479 double precision :: y_points(nbr_points(2))
1480
1481 x_points(:) = dble(x_points_real(:))
1482 y_points(:) = dble(y_points_real(:))
1483
1484 call yac_fdef_points_reg2d_dble ( grid_id, &
1485 nbr_points, &
1486 location, &
1487 x_points, &
1488 y_points, &
1489 point_id )
1490
1491end subroutine yac_fdef_points_reg2d_real
1492
1493subroutine yac_fdef_points_reg2d_dble ( grid_id, &
1494 nbr_points, &
1495 location, &
1496 x_points, &
1497 y_points, &
1498 point_id )
1499
1501
1502 implicit none
1503
1504 interface
1505
1506 subroutine yac_cdef_points_reg2d_c ( grid_id, &
1507 nbr_points, &
1508 location, &
1509 x_points, &
1510 y_points, &
1511 point_id ) &
1512 & bind( c, name='yac_cdef_points_reg2d' )
1513
1514 use, intrinsic :: iso_c_binding, only : c_int, c_double
1515
1516 integer ( kind=c_int ), value :: grid_id
1517 integer ( kind=c_int ) :: nbr_points(2)
1518 integer ( kind=c_int ), value :: location
1519
1520 real ( kind=c_double ) :: x_points(nbr_points(1))
1521 real ( kind=c_double ) :: y_points(nbr_points(2))
1522
1523 integer ( kind=c_int ) :: point_id
1524
1525 end subroutine yac_cdef_points_reg2d_c
1526
1527 end interface
1528
1529 integer, intent(in) :: grid_id
1530 integer, intent(in) :: nbr_points(2)
1531 integer, intent(in) :: location
1532
1533 double precision, intent(in) :: x_points(nbr_points(1))
1534 double precision, intent(in) :: y_points(nbr_points(2))
1535
1536 integer, intent(out) :: point_id
1537
1538 call yac_cdef_points_reg2d_c ( grid_id, &
1539 nbr_points, &
1540 location, &
1541 x_points, &
1542 y_points, &
1543 point_id )
1544
1545end subroutine yac_fdef_points_reg2d_dble
1546
1547subroutine yac_fdef_points_curve2d_real ( grid_id, &
1548 nbr_points, &
1549 location, &
1550 x_points_real, &
1551 y_points_real, &
1552 point_id )
1553
1555
1556 implicit none
1557
1558 integer, intent(in) :: grid_id
1559 integer, intent(in) :: nbr_points(2)
1560 integer, intent(in) :: location
1561 real, intent(in) :: &
1562 x_points_real(nbr_points(1),nbr_points(2))
1563 real, intent(in) :: &
1564 y_points_real(nbr_points(1),nbr_points(2))
1565 integer, intent(out) :: point_id
1566
1567 double precision :: x_points(nbr_points(1),nbr_points(2))
1568 double precision :: y_points(nbr_points(1),nbr_points(2))
1569
1570 x_points(:,:) = dble(x_points_real(:,:))
1571 y_points(:,:) = dble(y_points_real(:,:))
1572
1573 call yac_fdef_points_curve2d_dble ( grid_id, &
1574 nbr_points, &
1575 location, &
1576 x_points, &
1577 y_points, &
1578 point_id )
1579
1580end subroutine yac_fdef_points_curve2d_real
1581
1582subroutine yac_fdef_points_curve2d_dble ( grid_id, &
1583 nbr_points, &
1584 location, &
1585 x_points, &
1586 y_points, &
1587 point_id )
1588
1590
1591 implicit none
1592
1593 interface
1594
1595 subroutine yac_cdef_points_curve2d_c ( grid_id, &
1596 nbr_points, &
1597 location, &
1598 x_points, &
1599 y_points, &
1600 point_id ) &
1601 bind( c, name='yac_cdef_points_curve2d' )
1602
1603 use, intrinsic :: iso_c_binding, only : c_int, c_double
1604
1605 integer ( kind=c_int ), value :: grid_id
1606 integer ( kind=c_int ) :: nbr_points(2)
1607 integer ( kind=c_int ), value :: location
1608
1609 real ( kind=c_double ) :: x_points(nbr_points(1),nbr_points(2))
1610 real ( kind=c_double ) :: y_points(nbr_points(1),nbr_points(2))
1611
1612 integer ( kind=c_int ) :: point_id
1613
1614 end subroutine yac_cdef_points_curve2d_c
1615
1616 end interface
1617
1618 integer, intent(in) :: grid_id
1619 integer, intent(in) :: nbr_points(2)
1620 integer, intent(in) :: location
1621
1622 double precision, intent(in) :: &
1623 x_points(nbr_points(1),nbr_points(2))
1624 double precision, intent(in) :: &
1625 y_points(nbr_points(1),nbr_points(2))
1626
1627 integer, intent(out) :: point_id
1628
1629 call yac_cdef_points_curve2d_c ( grid_id, &
1630 nbr_points, &
1631 location, &
1632 x_points, &
1633 y_points, &
1634 point_id )
1635
1636end subroutine yac_fdef_points_curve2d_dble
1637
1638subroutine yac_fdef_points_unstruct_real ( grid_id, &
1639 nbr_points, &
1640 location, &
1641 x_points_real, &
1642 y_points_real, &
1643 point_id )
1644
1646
1647 implicit none
1648
1649 integer, intent(in) :: grid_id
1650 integer, intent(in) :: nbr_points
1651 integer, intent(in) :: location
1652
1653 real, intent(in) :: x_points_real(nbr_points)
1654 real, intent(in) :: y_points_real(nbr_points)
1655
1656 integer, intent(out) :: point_id
1657
1658 double precision :: x_points(nbr_points)
1659 double precision :: y_points(nbr_points)
1660
1661 x_points(:) = dble(x_points_real(:))
1662 y_points(:) = dble(y_points_real(:))
1663
1664 call yac_fdef_points_unstruct_dble ( grid_id, &
1665 nbr_points, &
1666 location, &
1667 x_points, &
1668 y_points, &
1669 point_id )
1670
1671end subroutine yac_fdef_points_unstruct_real
1672
1673subroutine yac_fdef_points_unstruct_dble ( grid_id, &
1674 nbr_points, &
1675 location, &
1676 x_points, &
1677 y_points, &
1678 point_id )
1679
1681
1682 implicit none
1683
1684 interface
1685
1686 subroutine yac_cdef_points_unstruct_c ( grid_id, &
1687 nbr_points, &
1688 location, &
1689 x_points, &
1690 y_points, &
1691 point_id ) &
1692 bind( c, name='yac_cdef_points_unstruct' )
1693
1694 use, intrinsic :: iso_c_binding, only : c_int, c_double
1695
1696 integer (kind=c_int), value :: grid_id
1697 integer (kind=c_int), value :: nbr_points
1698 integer (kind=c_int), value :: location
1699
1700 real (kind=c_double) :: x_points(nbr_points)
1701 real (kind=c_double) :: y_points(nbr_points)
1702
1703 integer (kind=c_int) :: point_id
1704
1705 end subroutine yac_cdef_points_unstruct_c
1706
1707 end interface
1708
1709 integer, intent(in) :: grid_id
1710 integer, intent(in) :: nbr_points
1711 integer, intent(in) :: location
1712
1713 double precision, intent(in) :: x_points(nbr_points)
1714 double precision, intent(in) :: y_points(nbr_points)
1715
1716 integer, intent(out) :: point_id
1717
1718 call yac_cdef_points_unstruct_c ( grid_id, &
1719 nbr_points, &
1720 location, &
1721 x_points, &
1722 y_points, &
1723 point_id )
1724
1725end subroutine yac_fdef_points_unstruct_dble
1726
1727! ------------------------- def_grid -------------------------------
1728
1748subroutine yac_fdef_grid_nonuniform_real ( grid_name, &
1749 nbr_vertices, &
1750 nbr_cells, &
1751 nbr_connections, &
1752 nbr_vertices_per_cell, &
1753 x_vertices_real, &
1754 y_vertices_real, &
1755 cell_to_vertex_in, &
1756 grid_id, &
1757 use_ll_edges)
1758
1760
1761 implicit none
1762
1763 character(len=*), intent(in) :: grid_name
1764 integer, intent(in) :: nbr_vertices
1765 integer, intent(in) :: nbr_cells
1766 integer, intent(in) :: nbr_connections
1767 integer, intent(in) :: nbr_vertices_per_cell(nbr_cells)
1768
1769 real, intent(in) :: x_vertices_real(nbr_vertices)
1770 real, intent(in) :: y_vertices_real(nbr_vertices)
1771
1772 integer, intent(in) :: cell_to_vertex_in(nbr_connections)
1773
1774 integer, intent(out) :: grid_id
1775
1776 logical, optional, intent(in) :: use_ll_edges
1777
1778 double precision :: x_vertices(nbr_vertices)
1779 double precision :: y_vertices(nbr_vertices)
1780
1781 x_vertices(:) = dble(x_vertices_real(:))
1782 y_vertices(:) = dble(y_vertices_real(:))
1783
1784 call yac_fdef_grid_nonuniform_dble ( grid_name, &
1785 nbr_vertices, &
1786 nbr_cells, &
1787 nbr_connections, &
1788 nbr_vertices_per_cell, &
1789 x_vertices, &
1790 y_vertices, &
1791 cell_to_vertex_in, &
1792 grid_id, &
1793 use_ll_edges )
1794
1795end subroutine yac_fdef_grid_nonuniform_real
1796
1816subroutine yac_fdef_grid_nonuniform_dble ( grid_name, &
1817 nbr_vertices, &
1818 nbr_cells, &
1819 nbr_connections, &
1820 nbr_vertices_per_cell, &
1821 x_vertices, &
1822 y_vertices, &
1823 cell_to_vertex_in, &
1824 grid_id, &
1825 use_ll_edges )
1826
1827 use, intrinsic :: iso_c_binding, only : c_null_char
1829
1830 implicit none
1831
1832 interface
1833
1834 subroutine yac_cdef_grid_unstruct_c ( grid_name, &
1835 nbr_vertices, &
1836 nbr_cells, &
1837 nbr_vertices_per_cell, &
1838 x_vertices, &
1839 y_vertices, &
1840 cell_to_vertex, &
1841 grid_id ) &
1842 bind( c, name='yac_cdef_grid_unstruct' )
1843
1844 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_double
1845
1846 character ( kind=c_char ), dimension(*) :: grid_name
1847 integer ( kind=c_int ), value :: nbr_vertices
1848 integer ( kind=c_int ), value :: nbr_cells
1849 integer ( kind=c_int ) :: nbr_vertices_per_cell(nbr_cells)
1850 real ( kind=c_double ) :: x_vertices(nbr_vertices)
1851 real ( kind=c_double ) :: y_vertices(nbr_vertices)
1852 integer ( kind=c_int ) :: cell_to_vertex(nbr_cells,nbr_vertices)
1853 integer ( kind=c_int ) :: grid_id
1854
1855 end subroutine yac_cdef_grid_unstruct_c
1856
1857 subroutine yac_cdef_grid_unstruct_ll_c ( grid_name, &
1858 nbr_vertices, &
1859 nbr_cells, &
1860 nbr_vertices_per_cell, &
1861 x_vertices, &
1862 y_vertices, &
1863 cell_to_vertex, &
1864 grid_id ) &
1865 bind( c, name='yac_cdef_grid_unstruct_ll' )
1866
1867 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_double
1868
1869 character ( kind=c_char ), dimension(*) :: grid_name
1870 integer ( kind=c_int ), value :: nbr_vertices
1871 integer ( kind=c_int ), value :: nbr_cells
1872 integer ( kind=c_int ) :: nbr_vertices_per_cell(nbr_cells)
1873 real ( kind=c_double ) :: x_vertices(nbr_vertices)
1874 real ( kind=c_double ) :: y_vertices(nbr_vertices)
1875 integer ( kind=c_int ) :: cell_to_vertex(nbr_cells,nbr_vertices)
1876 integer ( kind=c_int ) :: grid_id
1877
1878 end subroutine yac_cdef_grid_unstruct_ll_c
1879
1880 end interface
1881
1882 character(len=*), intent(in) :: grid_name
1883 integer, intent(in) :: nbr_vertices
1884 integer, intent(in) :: nbr_cells
1885 integer, intent(in) :: nbr_connections
1886 integer, intent(in) :: nbr_vertices_per_cell(nbr_cells)
1887
1888 double precision, intent(in) :: x_vertices(nbr_vertices)
1889 double precision, intent(in) :: y_vertices(nbr_vertices)
1890
1891 integer, intent(in) :: cell_to_vertex_in(nbr_connections)
1892
1893 integer, intent(out) :: grid_id
1894
1895 logical, optional, intent(in) :: use_ll_edges
1896
1897
1898 integer :: cell_to_vertex(nbr_connections)
1899
1900 logical :: use_ll_edges_
1901
1902 yac_fassert(all(cell_to_vertex_in > 0), "ERROR(yac_fdef_grid_nonuniform_dble): all entries of cell_to_vertex have to be > 0")
1903
1904 yac_fassert(all(cell_to_vertex_in <= nbr_vertices), "ERROR(yac_fdef_grid_nonuniform_dble): all entries of cell_to_vertex have to be <= nbr_vertices")
1905
1906 cell_to_vertex(:) = cell_to_vertex_in(:) - 1
1907
1908 if (present(use_ll_edges)) then
1909 use_ll_edges_ = use_ll_edges
1910 else
1911 use_ll_edges_ = .false.
1912 end if
1913
1914 if (use_ll_edges_) then
1915 call yac_cdef_grid_unstruct_ll_c ( trim(grid_name) // c_null_char, &
1916 nbr_vertices, &
1917 nbr_cells, &
1918 nbr_vertices_per_cell, &
1919 x_vertices, &
1920 y_vertices, &
1921 cell_to_vertex, &
1922 grid_id )
1923 else
1924 call yac_cdef_grid_unstruct_c ( trim(grid_name) // c_null_char, &
1925 nbr_vertices, &
1926 nbr_cells, &
1927 nbr_vertices_per_cell, &
1928 x_vertices, &
1929 y_vertices, &
1930 cell_to_vertex, &
1931 grid_id )
1932 end if
1933
1934end subroutine yac_fdef_grid_nonuniform_dble
1935
1954subroutine yac_fdef_grid_unstruct_real ( grid_name, &
1955 nbr_vertices, &
1956 nbr_cells, &
1957 nbr_vertices_per_cell_in, &
1958 x_vertices_real, &
1959 y_vertices_real, &
1960 cell_to_vertex_in, &
1961 grid_id, &
1962 use_ll_edges )
1963
1965
1966 implicit none
1967
1968 character(len=*), intent(in) :: grid_name
1969 integer, intent(in) :: nbr_vertices
1970 integer, intent(in) :: nbr_cells
1971 integer, intent(in) :: nbr_vertices_per_cell_in
1972
1973 real, intent(in) :: x_vertices_real(nbr_vertices)
1974 real, intent(in) :: y_vertices_real(nbr_vertices)
1975
1976 integer, intent(in) :: cell_to_vertex_in(nbr_vertices_per_cell_in,nbr_cells)
1977
1978 integer, intent(out) :: grid_id
1979
1980 logical, optional, intent(in) :: use_ll_edges
1981
1982 double precision :: x_vertices(nbr_vertices)
1983 double precision :: y_vertices(nbr_vertices)
1984
1985 x_vertices(:) = dble(x_vertices_real(:))
1986 y_vertices(:) = dble(y_vertices_real(:))
1987
1988 call yac_fdef_grid_unstruct_dble ( grid_name, &
1989 nbr_vertices, &
1990 nbr_cells, &
1991 nbr_vertices_per_cell_in, &
1992 x_vertices, &
1993 y_vertices, &
1994 cell_to_vertex_in, &
1995 grid_id, &
1996 use_ll_edges )
1997
1998end subroutine yac_fdef_grid_unstruct_real
1999
2018subroutine yac_fdef_grid_unstruct_dble ( grid_name, &
2019 nbr_vertices, &
2020 nbr_cells, &
2021 nbr_vertices_per_cell_in, &
2022 x_vertices, &
2023 y_vertices, &
2024 cell_to_vertex_in, &
2025 grid_id, &
2026 use_ll_edges )
2027
2028 use, intrinsic :: iso_c_binding, only : c_null_char
2030
2031 implicit none
2032
2033 interface
2034
2035 subroutine yac_cdef_grid_unstruct_c ( grid_name, &
2036 nbr_vertices, &
2037 nbr_cells, &
2038 nbr_vertices_per_cell, &
2039 x_vertices, &
2040 y_vertices, &
2041 cell_to_vertex, &
2042 grid_id ) &
2043 bind( c, name='yac_cdef_grid_unstruct' )
2044
2045 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_double
2046
2047 character ( kind=c_char ), dimension(*) :: grid_name
2048 integer ( kind=c_int ), value :: nbr_vertices
2049 integer ( kind=c_int ), value :: nbr_cells
2050 integer ( kind=c_int ) :: nbr_vertices_per_cell(nbr_cells)
2051 real ( kind=c_double ) :: x_vertices(nbr_vertices)
2052 real ( kind=c_double ) :: y_vertices(nbr_vertices)
2053 integer ( kind=c_int ) :: cell_to_vertex(nbr_cells,nbr_vertices)
2054 integer ( kind=c_int ) :: grid_id
2055
2056 end subroutine yac_cdef_grid_unstruct_c
2057
2058 subroutine yac_cdef_grid_unstruct_ll_c ( grid_name, &
2059 nbr_vertices, &
2060 nbr_cells, &
2061 nbr_vertices_per_cell, &
2062 x_vertices, &
2063 y_vertices, &
2064 cell_to_vertex, &
2065 grid_id ) &
2066 bind( c, name='yac_cdef_grid_unstruct_ll' )
2067
2068 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_double
2069
2070 character ( kind=c_char ), dimension(*) :: grid_name
2071 integer ( kind=c_int ), value :: nbr_vertices
2072 integer ( kind=c_int ), value :: nbr_cells
2073 integer ( kind=c_int ) :: nbr_vertices_per_cell(nbr_cells)
2074 real ( kind=c_double ) :: x_vertices(nbr_vertices)
2075 real ( kind=c_double ) :: y_vertices(nbr_vertices)
2076 integer ( kind=c_int ) :: cell_to_vertex(nbr_cells,nbr_vertices)
2077 integer ( kind=c_int ) :: grid_id
2078
2079 end subroutine yac_cdef_grid_unstruct_ll_c
2080
2081 end interface
2082
2083 character(len=*), intent(in) :: grid_name
2084 integer, intent(in) :: nbr_vertices
2085 integer, intent(in) :: nbr_cells
2086 integer, intent(in) :: nbr_vertices_per_cell_in
2087
2088 double precision, intent(in) :: x_vertices(nbr_vertices)
2089 double precision, intent(in) :: y_vertices(nbr_vertices)
2090
2091 integer, intent(in) :: cell_to_vertex_in( &
2092 nbr_vertices_per_cell_in, &
2093 nbr_cells)
2094
2095 integer, intent(out) :: grid_id
2096
2097 logical, optional, intent(in) :: use_ll_edges
2098
2099 integer :: nbr_vertices_per_cell(nbr_cells)
2100 integer :: cell_to_vertex(nbr_vertices_per_cell_in,nbr_cells)
2101 logical :: use_ll_edges_
2102
2103 nbr_vertices_per_cell(:) = nbr_vertices_per_cell_in
2104
2105 yac_fassert(all(cell_to_vertex_in > 0), "ERROR(yac_fdef_grid_unstruct_dble): all entries of cell_to_vertex have to be > 0")
2106
2107 yac_fassert(all(cell_to_vertex_in <= nbr_vertices), "ERROR(yac_fdef_grid_unstruct_dble): all entries of cell_to_vertex have to be <= nbr_vertices")
2108
2109 cell_to_vertex(:,:) = cell_to_vertex_in(:,:) - 1
2110
2111 if (present(use_ll_edges)) then
2112 use_ll_edges_ = use_ll_edges
2113 else
2114 use_ll_edges_ = .false.
2115 end if
2116
2117 if (use_ll_edges_) then
2118 call yac_cdef_grid_unstruct_ll_c ( trim(grid_name) // c_null_char, &
2119 nbr_vertices, &
2120 nbr_cells, &
2121 nbr_vertices_per_cell, &
2122 x_vertices, &
2123 y_vertices, &
2124 cell_to_vertex, &
2125 grid_id )
2126 else
2127 call yac_cdef_grid_unstruct_c ( trim(grid_name) // c_null_char, &
2128 nbr_vertices, &
2129 nbr_cells, &
2130 nbr_vertices_per_cell, &
2131 x_vertices, &
2132 y_vertices, &
2133 cell_to_vertex, &
2134 grid_id )
2135 end if
2136
2137end subroutine yac_fdef_grid_unstruct_dble
2138
2146subroutine yac_fdef_grid_curve2d_real ( grid_name, &
2147 nbr_vertices, &
2148 cyclic, &
2149 x_vertices_real, &
2150 y_vertices_real, &
2151 grid_id )
2152
2154
2155 implicit none
2156
2157 character(len=*), intent(in) :: grid_name
2158 integer, intent(in) :: nbr_vertices(2)
2159 integer, intent(in) :: cyclic(2)
2160 real, intent(in) :: &
2161 x_vertices_real(nbr_vertices(1),nbr_vertices(2))
2162 real, intent(in) :: &
2163 y_vertices_real(nbr_vertices(1),nbr_vertices(2))
2164 integer, intent(out) :: grid_id
2165
2166 double precision :: x_vertices(nbr_vertices(1),nbr_vertices(2))
2167 double precision :: y_vertices(nbr_vertices(1),nbr_vertices(2))
2168
2169 x_vertices(:,:) = dble(x_vertices_real(:,:))
2170 y_vertices(:,:) = dble(y_vertices_real(:,:))
2171
2172 call yac_fdef_grid_curve2d_dble ( grid_name, &
2173 nbr_vertices, &
2174 cyclic, &
2175 x_vertices, &
2176 y_vertices, &
2177 grid_id )
2178
2179end subroutine yac_fdef_grid_curve2d_real
2180
2188subroutine yac_fdef_grid_curve2d_dble ( grid_name, &
2189 nbr_vertices, &
2190 cyclic, &
2191 x_vertices, &
2192 y_vertices, &
2193 grid_id )
2194
2195 use, intrinsic :: iso_c_binding, only : c_null_char
2197
2198 implicit none
2199
2200 interface
2201
2202 subroutine yac_cdef_grid_curve2d_c ( grid_name, &
2203 nbr_vertices, &
2204 cyclic, &
2205 x_vertices, &
2206 y_vertices, &
2207 grid_id ) &
2208 bind( c, name='yac_cdef_grid_curve2d' )
2209
2210 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_double
2211
2212 character ( kind=c_char ), dimension(*) :: grid_name
2213 integer ( kind=c_int ) :: nbr_vertices(2)
2214 integer ( kind=c_int ) :: cyclic(2)
2215 real ( kind=c_double ) :: x_vertices(nbr_vertices(1),nbr_vertices(2))
2216 real ( kind=c_double ) :: y_vertices(nbr_vertices(1),nbr_vertices(2))
2217 integer ( kind=c_int ) :: grid_id
2218
2219 end subroutine yac_cdef_grid_curve2d_c
2220
2221 end interface
2222
2223 character(len=*), intent(in) :: grid_name
2224 integer, intent(in) :: nbr_vertices(2)
2225 integer, intent(in) :: cyclic(2)
2226 double precision, intent(in) :: &
2227 x_vertices(nbr_vertices(1),nbr_vertices(2))
2228 double precision, intent(in) :: &
2229 y_vertices(nbr_vertices(1),nbr_vertices(2))
2230 integer, intent(out) :: grid_id
2231
2232 call yac_cdef_grid_curve2d_c ( trim(grid_name) // c_null_char, &
2233 nbr_vertices, &
2234 cyclic, &
2235 x_vertices, &
2236 y_vertices, &
2237 grid_id )
2238
2239end subroutine yac_fdef_grid_curve2d_dble
2240
2248subroutine yac_fdef_grid_reg2d_real ( grid_name, &
2249 nbr_vertices, &
2250 cyclic, &
2251 x_vertices_real, &
2252 y_vertices_real, &
2253 grid_id )
2254
2256
2257 implicit none
2258
2259 character(len=*), intent(in) :: grid_name
2260 integer, intent(in) :: nbr_vertices(2)
2261 integer, intent(in) :: cyclic(2)
2262 real, intent(in) :: x_vertices_real(nbr_vertices(1))
2263 real, intent(in) :: y_vertices_real(nbr_vertices(2))
2264 integer, intent(out) :: grid_id
2265
2266 double precision :: x_vertices(nbr_vertices(1))
2267 double precision :: y_vertices(nbr_vertices(2))
2268
2269 x_vertices(:) = dble(x_vertices_real(:))
2270 y_vertices(:) = dble(y_vertices_real(:))
2271
2272 call yac_fdef_grid_reg2d_dble ( grid_name, &
2273 nbr_vertices, &
2274 cyclic, &
2275 x_vertices, &
2276 y_vertices, &
2277 grid_id )
2278
2279end subroutine yac_fdef_grid_reg2d_real
2280
2288subroutine yac_fdef_grid_reg2d_dble ( grid_name, &
2289 nbr_vertices, &
2290 cyclic, &
2291 x_vertices, &
2292 y_vertices, &
2293 grid_id )
2294
2295 use, intrinsic :: iso_c_binding, only : c_null_char
2297
2298 implicit none
2299
2300 interface
2301
2302 subroutine yac_cdef_grid_reg2d_c ( grid_name, &
2303 nbr_vertices, &
2304 cyclic, &
2305 x_vertices, &
2306 y_vertices, &
2307 grid_id ) &
2308 bind( c, name='yac_cdef_grid_reg2d' )
2309
2310 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_double
2311
2312 character ( kind=c_char ), dimension(*) :: grid_name
2313 integer ( kind=c_int ) :: nbr_vertices(2)
2314 integer ( kind=c_int ) :: cyclic(2)
2315 real ( kind=c_double ) :: x_vertices(nbr_vertices(1))
2316 real ( kind=c_double ) :: y_vertices(nbr_vertices(2))
2317 integer ( kind=c_int ) :: grid_id
2318
2319 end subroutine yac_cdef_grid_reg2d_c
2320
2321 end interface
2322
2323 character(len=*), intent(in) :: grid_name
2324 integer, intent(in) :: nbr_vertices(2)
2325 integer, intent(in) :: cyclic(2)
2326 double precision, intent(in) :: x_vertices(nbr_vertices(1))
2327 double precision, intent(in) :: y_vertices(nbr_vertices(2))
2328 integer, intent(out) :: grid_id
2329
2330 call yac_cdef_grid_reg2d_c ( trim(grid_name) // c_null_char, &
2331 nbr_vertices, &
2332 cyclic, &
2333 x_vertices, &
2334 y_vertices, &
2335 grid_id )
2336
2337end subroutine yac_fdef_grid_reg2d_dble
2338
2339! ------------------------- set global_index ------------------------------
2340
2341subroutine yac_fset_global_index ( global_index, &
2342 location, &
2343 grid_id )
2344
2346
2347 implicit none
2348
2349 interface
2350
2351 subroutine yac_cset_global_index_c ( global_index, &
2352 location, &
2353 grid_id ) &
2354 bind( c, name='yac_cset_global_index' )
2355
2356 use, intrinsic :: iso_c_binding, only : c_int
2357
2358 integer ( kind=c_int ) :: global_index(*)
2359 integer ( kind=c_int ), value :: location
2360 integer ( kind=c_int ), value :: grid_id
2361
2362 end subroutine yac_cset_global_index_c
2363
2364 end interface
2365
2366 integer, intent(in) :: global_index(*)
2367 integer, intent(in) :: location
2368 integer, intent(in) :: grid_id
2369
2370 call yac_cset_global_index_c ( global_index, &
2371 location, &
2372 grid_id )
2373
2374end subroutine yac_fset_global_index
2375
2376! ------------------------- set core_mask ------------------------------
2377
2378subroutine yac_fset_core_lmask ( is_core, &
2379 location, &
2380 grid_id )
2381
2383 use, intrinsic :: iso_c_binding, only : c_size_t
2384
2385 implicit none
2386
2387 logical, intent(in) :: is_core(*)
2390 integer, intent(in) :: location
2391 integer, intent(in) :: grid_id
2392
2393 integer (kind=c_size_t) :: i, count
2394 integer, allocatable :: int_is_core(:)
2395
2396 interface
2397
2398 function yac_get_grid_size_c ( location, &
2399 grid_id ) &
2400 result( grid_size ) &
2401 bind( c, name='yac_get_grid_size' )
2402
2403 use, intrinsic :: iso_c_binding, only : c_int, c_size_t
2404
2405 integer ( kind=c_int ), value :: location
2406 integer ( kind=c_int ), value :: grid_id
2407 integer ( kind=c_size_t) :: grid_size
2408
2409 end function yac_get_grid_size_c
2410
2411 end interface
2412
2413 count = yac_get_grid_size_c(location, grid_id)
2414 allocate(int_is_core(count))
2415
2416 do i = 1, count
2417 if ( is_core(i) ) then
2418 int_is_core(i) = 1
2419 else
2420 int_is_core(i) = 0
2421 endif
2422 enddo
2423
2424 call yac_fset_core_imask ( int_is_core, &
2425 location, &
2426 grid_id )
2427
2428end subroutine yac_fset_core_lmask
2429
2430subroutine yac_fset_core_imask ( is_core, &
2431 location, &
2432 grid_id )
2433
2435
2436 implicit none
2437
2438 interface
2439
2440 subroutine yac_cset_core_mask_c ( mask, &
2441 location, &
2442 grid_id ) &
2443 bind( c, name='yac_cset_core_mask' )
2444
2445 use, intrinsic :: iso_c_binding, only : c_int
2446
2447 integer ( kind=c_int ) :: mask(*)
2448 integer ( kind=c_int ), value :: location
2449 integer ( kind=c_int ), value :: grid_id
2450
2451 end subroutine yac_cset_core_mask_c
2452
2453 end interface
2454
2455
2456 integer, intent(in) :: is_core(*)
2459 integer, intent(in) :: location
2460 integer, intent(in) :: grid_id
2461
2462 call yac_cset_core_mask_c ( is_core, &
2463 location, &
2464 grid_id )
2465
2466end subroutine yac_fset_core_imask
2467
2468! ------------------------- set_mask ------------------------------
2469
2470subroutine yac_fset_lmask ( is_valid, &
2471 points_id )
2472
2473 use mo_yac_finterface, dummy => yac_fset_lmask
2474 use, intrinsic :: iso_c_binding, only : c_size_t
2475
2476 implicit none
2477
2478 logical, intent(in) :: is_valid(*)
2481 integer, intent(in) :: points_id
2482
2483 integer ( kind=c_size_t) :: i, count
2484 integer, allocatable :: int_is_valid(:)
2485
2486 interface
2487
2488 function yac_get_points_size_c ( points_id ) &
2489 result( points_size ) &
2490 bind( c, name='yac_get_points_size' )
2491
2492 use, intrinsic :: iso_c_binding, only : c_int, c_size_t
2493
2494 integer ( kind=c_int ), value :: points_id
2495 integer ( kind=c_size_t) :: points_size
2496
2497 end function yac_get_points_size_c
2498
2499 end interface
2500
2501 count = yac_get_points_size_c(points_id)
2502 allocate(int_is_valid(count))
2503
2504 do i = 1, count
2505 int_is_valid(i) = merge(1,0,is_valid(i))
2506 enddo
2507
2508 call yac_fset_imask ( int_is_valid, points_id )
2509
2510end subroutine yac_fset_lmask
2511
2512subroutine yac_fset_imask ( is_valid, &
2513 points_id )
2514
2515 use mo_yac_finterface, dummy => yac_fset_imask
2516
2517 implicit none
2518
2519 interface
2520
2521 subroutine yac_cset_mask_c ( is_valid, &
2522 points_id ) &
2523 bind( c, name='yac_cset_mask' )
2524
2525 use, intrinsic :: iso_c_binding, only : c_int
2526
2527 integer ( kind=c_int ) :: is_valid(*)
2528 integer ( kind=c_int ), value :: points_id
2529
2530 end subroutine yac_cset_mask_c
2531
2532 end interface
2533
2534 integer, intent(in) :: is_valid(*)
2537 integer, intent(in) :: points_id
2538
2539 call yac_cset_mask_c ( is_valid, points_id )
2540
2541end subroutine yac_fset_imask
2542
2543! ------------------------- def_mask ------------------------------
2544
2545subroutine yac_fdef_lmask ( grid_id, &
2546 nbr_points, &
2547 location, &
2548 is_valid, &
2549 mask_id )
2550
2551 use mo_yac_finterface, dummy => yac_fdef_lmask
2552
2553 implicit none
2554
2555 integer, intent(in) :: grid_id
2556 integer, intent(in) :: nbr_points
2557 integer, intent(in) :: location
2558 logical, intent(in) :: is_valid(*)
2561 integer, intent(out) :: mask_id
2562
2563 integer :: i
2564 integer, allocatable :: int_is_valid(:)
2565
2566 allocate(int_is_valid(nbr_points))
2567
2568 do i = 1, nbr_points
2569 int_is_valid(i) = merge(1,0,is_valid(i))
2570 enddo
2571
2572 call yac_fdef_imask ( grid_id, &
2573 nbr_points, &
2574 location, &
2575 int_is_valid, &
2576 mask_id )
2577
2578end subroutine yac_fdef_lmask
2579
2580subroutine yac_fdef_imask ( grid_id, &
2581 nbr_points, &
2582 location, &
2583 is_valid, &
2584 mask_id )
2585
2586 use mo_yac_finterface, dummy => yac_fdef_imask
2587
2588 implicit none
2589
2590 interface
2591
2592 subroutine yac_cdef_mask_c ( grid_id, &
2593 nbr_points, &
2594 location, &
2595 is_valid, &
2596 mask_id ) &
2597 bind( c, name='yac_cdef_mask' )
2598
2599 use, intrinsic :: iso_c_binding, only : c_int
2600
2601 integer ( kind=c_int ), value :: grid_id
2602 integer ( kind=c_int ), value :: nbr_points
2603 integer ( kind=c_int ), value :: location
2604 integer ( kind=c_int ) :: is_valid(*)
2605 integer ( kind=c_int ) :: mask_id
2606
2607 end subroutine yac_cdef_mask_c
2608
2609 end interface
2610
2611 integer, intent(in) :: grid_id
2612 integer, intent(in) :: nbr_points
2613 integer, intent(in) :: location
2614 integer, intent(in) :: is_valid(*)
2617 integer, intent(out) :: mask_id
2618
2619 call yac_cdef_mask_c ( grid_id, &
2620 nbr_points, &
2621 location, &
2622 is_valid, &
2623 mask_id )
2624
2625end subroutine yac_fdef_imask
2626
2627! ------------------------- def_mask_named ------------------------
2628
2629subroutine yac_fdef_lmask_named ( grid_id, &
2630 nbr_points, &
2631 location, &
2632 is_valid, &
2633 name, &
2634 mask_id )
2635
2637
2638 implicit none
2639
2640 integer, intent(in) :: grid_id
2641 integer, intent(in) :: nbr_points
2642 integer, intent(in) :: location
2643 logical, intent(in) :: is_valid(*)
2646 character(len=*), intent(in) :: name
2647 integer, intent(out) :: mask_id
2648
2649 integer :: i
2650 integer, allocatable :: int_is_valid(:)
2651
2652 allocate(int_is_valid(nbr_points))
2653
2654 do i = 1, nbr_points
2655 int_is_valid(i) = merge(1,0,is_valid(i))
2656 enddo
2657
2658 call yac_fdef_imask_named ( grid_id, &
2659 nbr_points, &
2660 location, &
2661 int_is_valid, &
2662 name, &
2663 mask_id )
2664
2665end subroutine yac_fdef_lmask_named
2666
2667subroutine yac_fdef_imask_named ( grid_id, &
2668 nbr_points, &
2669 location, &
2670 is_valid, &
2671 name, &
2672 mask_id )
2673
2674 use, intrinsic :: iso_c_binding, only : c_null_char
2677
2678 implicit none
2679
2680 interface
2681
2682 subroutine yac_cdef_mask_named_c ( grid_id, &
2683 nbr_points, &
2684 location, &
2685 is_valid, &
2686 name, &
2687 mask_id ) &
2688 bind( c, name='yac_cdef_mask_named' )
2689
2690 use, intrinsic :: iso_c_binding, only : c_int, c_char
2691
2692 integer ( kind=c_int ), value :: grid_id
2693 integer ( kind=c_int ), value :: nbr_points
2694 integer ( kind=c_int ), value :: location
2695 integer ( kind=c_int ) :: is_valid(*)
2696 character ( kind=c_char ), dimension(*) :: name
2697 integer ( kind=c_int ) :: mask_id
2698
2699 end subroutine yac_cdef_mask_named_c
2700
2701 end interface
2702
2703 integer, intent(in) :: grid_id
2704 integer, intent(in) :: nbr_points
2705 integer, intent(in) :: location
2706 integer, intent(in) :: is_valid(*)
2709 character(len=*), intent(in) :: name
2710 integer, intent(out) :: mask_id
2711
2712 call yac_check_strlength ( name )
2713
2714 call yac_cdef_mask_named_c ( grid_id, &
2715 nbr_points, &
2716 location, &
2717 is_valid, &
2718 trim(name) // c_null_char, &
2719 mask_id )
2720
2721end subroutine yac_fdef_imask_named
2722
2723! ----------------------------- def_field -------------------------------
2724
2725subroutine yac_fdef_field ( field_name, &
2726 component_id, &
2727 point_ids, &
2728 num_pointsets, &
2729 collection_size, &
2730 timestep, &
2731 time_unit, &
2732 field_id )
2733
2734 use, intrinsic :: iso_c_binding, only : c_null_char
2735 use mo_yac_finterface, dummy => yac_fdef_field
2737
2738 implicit none
2739
2740 interface
2741
2742 subroutine yac_cdef_field_c ( field_name, &
2743 component_id, &
2744 point_ids, &
2745 num_pointsets, &
2746 collection_size, &
2747 timestep, &
2748 time_unit, &
2749 field_id ) &
2750 bind( c, name='yac_cdef_field' )
2751
2752 use, intrinsic :: iso_c_binding, only : c_int, c_char
2753
2754 character ( kind=c_char ), dimension(*) :: field_name
2755 integer ( kind=c_int ), value :: component_id
2756 integer ( kind=c_int ) :: point_ids(*)
2757 integer ( kind=c_int ), value :: num_pointsets
2758 integer ( kind=c_int ), value :: collection_size
2759 character ( kind=c_char ), dimension(*) :: timestep
2760 integer ( kind=c_int ), value :: time_unit
2761 integer ( kind=c_int ) :: field_id
2762
2763 end subroutine yac_cdef_field_c
2764
2765 end interface
2766
2767 !
2768 ! Definition of coupling fields
2769 !
2770 character(len=*), intent (in) :: field_name
2771 integer, intent (in) :: component_id
2772 integer, intent (in) :: point_ids(*)
2773 integer, intent (in) :: num_pointsets
2774 integer, intent (in) :: collection_size
2775 character(len=*), intent (in) :: timestep
2776 integer, intent (in) :: time_unit
2777 integer, intent (out) :: field_id
2778
2779 call yac_check_strlength ( field_name )
2780 call yac_check_strlength ( timestep )
2781
2782
2783 call yac_cdef_field_c ( trim(field_name) // c_null_char, &
2784 component_id, &
2785 point_ids, &
2786 num_pointsets, &
2787 collection_size, &
2788 trim(timestep) // c_null_char, &
2789 time_unit, &
2790 field_id )
2791
2792end subroutine yac_fdef_field
2793
2794! ----------------------------- def_field_mask---------------------------
2795
2796subroutine yac_fdef_field_mask ( field_name, &
2797 component_id, &
2798 point_ids, &
2799 mask_ids, &
2800 num_pointsets, &
2801 collection_size, &
2802 timestep, &
2803 time_unit, &
2804 field_id )
2805
2806 use, intrinsic :: iso_c_binding, only : c_null_char
2809
2810 implicit none
2811
2812 interface
2813
2814 subroutine yac_cdef_field_mask_c ( field_name, &
2815 component_id, &
2816 point_ids, &
2817 mask_ids, &
2818 num_pointsets, &
2819 collection_size, &
2820 timestep, &
2821 time_unit, &
2822 field_id ) &
2823 bind( c, name='yac_cdef_field_mask' )
2824
2825 use, intrinsic :: iso_c_binding, only : c_int, c_char
2826
2827 character ( kind=c_char ), dimension(*) :: field_name
2828 integer ( kind=c_int ), value :: component_id
2829 integer ( kind=c_int ) :: point_ids(*)
2830 integer ( kind=c_int ) :: mask_ids(*)
2831 integer ( kind=c_int ), value :: num_pointsets
2832 integer ( kind=c_int ), value :: collection_size
2833 character ( kind=c_char ), dimension(*) :: timestep
2834 integer ( kind=c_int ), value :: time_unit
2835 integer ( kind=c_int ) :: field_id
2836
2837 end subroutine yac_cdef_field_mask_c
2838
2839 end interface
2840
2841
2842 !
2843 ! Definition of coupling fields
2844 !
2845 character(len=*), intent (in) :: field_name
2846 integer, intent (in) :: component_id
2847 integer, intent (in) :: point_ids(*)
2848 integer, intent (in) :: mask_ids(*)
2849 integer, intent (in) :: num_pointsets
2850 integer, intent (in) :: collection_size
2851 character(len=*), intent (in) :: timestep
2852 integer, intent (in) :: time_unit
2853 integer, intent (out) :: field_id
2854
2855 call yac_check_strlength ( field_name )
2856 call yac_check_strlength ( timestep )
2857
2858 call yac_cdef_field_mask_c ( trim(field_name) // c_null_char, &
2859 component_id, &
2860 point_ids, &
2861 mask_ids, &
2862 num_pointsets, &
2863 collection_size, &
2864 trim(timestep) // c_null_char, &
2865 time_unit, &
2866 field_id )
2867
2868end subroutine yac_fdef_field_mask
2869
2870! -----------------------------------------------------------------------
2871
2872subroutine yac_fcheck_field_dimensions( field_id, &
2873 collection_size, &
2874 num_interp_fields, &
2875 interp_field_sizes )
2876
2878 use, intrinsic :: iso_c_binding, only : c_int
2879
2880 implicit none
2881
2882 interface
2883
2884 subroutine yac_ccheck_field_dimensions_c ( field_id, &
2885 collection_size, &
2886 num_interp_fields, &
2887 interp_field_sizes ) &
2888 bind( c, name='yac_ccheck_field_dimensions' )
2889
2890 use, intrinsic :: iso_c_binding, only : c_int
2891
2892 integer ( kind=c_int ), value :: field_id
2893 integer ( kind=c_int ), value :: collection_size
2894 integer ( kind=c_int ), value :: num_interp_fields
2895 integer ( kind=c_int ), dimension(*) :: interp_field_sizes
2896
2897 end subroutine yac_ccheck_field_dimensions_c
2898
2899 end interface
2900
2901 integer, intent (in) :: field_id
2902 integer, intent (in) :: collection_size
2903 integer, intent (in) :: num_interp_fields
2905 integer, intent (in) :: interp_field_sizes(num_interp_fields)
2907
2908 call yac_ccheck_field_dimensions_c(field_id, &
2909 collection_size, &
2910 num_interp_fields, &
2911 interp_field_sizes)
2912
2913end subroutine yac_fcheck_field_dimensions
2914
2915! ---------------------------------- put --------------------------------
2924subroutine yac_fput_real ( field_id, &
2925 nbr_hor_points, &
2926 nbr_pointsets, &
2927 collection_size, &
2928 send_field, &
2929 info, &
2930 ierror )
2931
2932 use mo_yac_finterface, dummy => yac_fput_real
2934
2935 implicit none
2936
2937 integer, intent (in) :: field_id
2938 integer, intent (in) :: nbr_hor_points
2939 integer, intent (in) :: nbr_pointsets
2940 integer, intent (in) :: collection_size
2941 real, intent (in) :: send_field(nbr_hor_points, &
2942 nbr_pointsets, &
2943 collection_size)
2944 integer, intent (out) :: info
2945 integer, intent (out) :: ierror
2946
2947 double precision :: send_field_dble(nbr_hor_points, &
2948 nbr_pointsets, &
2949 collection_size)
2950 integer :: i
2951
2953 field_id, collection_size, nbr_pointsets, &
2954 (/(nbr_hor_points,i=1,nbr_pointsets)/) )
2955
2956 call send_field_to_dble(field_id, &
2957 nbr_hor_points, &
2958 nbr_pointsets, &
2959 collection_size, &
2960 send_field, &
2961 send_field_dble)
2962
2963 call yac_fput_dble ( field_id, &
2964 nbr_hor_points, &
2965 nbr_pointsets, &
2966 collection_size, &
2967 send_field_dble, &
2968 info, &
2969 ierror )
2970
2971end subroutine yac_fput_real
2972
2982subroutine yac_fput_frac_real ( field_id, &
2983 nbr_hor_points, &
2984 nbr_pointsets, &
2985 collection_size, &
2986 send_field, &
2987 send_frac_mask, &
2988 info, &
2989 ierror )
2990
2993
2994 implicit none
2995
2996 integer, intent (in) :: field_id
2997 integer, intent (in) :: nbr_hor_points
2998 integer, intent (in) :: nbr_pointsets
2999 integer, intent (in) :: collection_size
3000 real, intent (in) :: send_field(nbr_hor_points, &
3001 nbr_pointsets, &
3002 collection_size)
3003 real, intent (in) :: send_frac_mask(nbr_hor_points, &
3004 nbr_pointsets, &
3005 collection_size)
3006 integer, intent (out) :: info
3007 integer, intent (out) :: ierror
3008
3009 double precision :: send_field_dble(nbr_hor_points, &
3010 nbr_pointsets, &
3011 collection_size)
3012 double precision :: send_frac_mask_dble(nbr_hor_points, &
3013 nbr_pointsets, &
3014 collection_size)
3015 integer :: i
3016
3018 field_id, collection_size, nbr_pointsets, &
3019 (/(nbr_hor_points,i=1,nbr_pointsets)/) )
3020
3021 call send_field_to_dble(field_id, &
3022 nbr_hor_points, &
3023 nbr_pointsets, &
3024 collection_size, &
3025 send_field, &
3026 send_field_dble, &
3027 send_frac_mask, &
3028 send_frac_mask_dble)
3029
3030 call yac_fput_frac_dble ( field_id, &
3031 nbr_hor_points, &
3032 nbr_pointsets, &
3033 collection_size, &
3034 send_field_dble, &
3035 send_frac_mask_dble, &
3036 info, &
3037 ierror )
3038
3039end subroutine yac_fput_frac_real
3040
3048subroutine yac_fput_real_ptr ( field_id, &
3049 nbr_pointsets, &
3050 collection_size, &
3051 send_field, &
3052 info, &
3053 ierror )
3054
3057
3058 implicit none
3059
3060 integer, intent (in) :: field_id
3061 integer, intent (in) :: nbr_pointsets
3062 integer, intent (in) :: collection_size
3063 type(yac_real_ptr), intent (in) :: send_field(nbr_pointsets, &
3064 collection_size)
3065 integer, intent (out) :: info
3066 integer, intent (out) :: ierror
3067
3068 integer :: i, j
3069 type(yac_dble_ptr) :: send_field_dble(nbr_pointsets, &
3070 collection_size)
3071
3073 field_id, collection_size, nbr_pointsets, &
3074 (/(SIZE(send_field(i, 1)%p),i=1,nbr_pointsets)/) )
3075
3076 call send_field_to_dble_ptr(field_id, &
3077 nbr_pointsets, &
3078 collection_size, &
3079 send_field, &
3080 send_field_dble)
3081
3082 call yac_fput_dble_ptr ( field_id, &
3083 nbr_pointsets, &
3084 collection_size, &
3085 send_field_dble, &
3086 info, &
3087 ierror )
3088
3089 do i = 1, collection_size
3090 do j = 1, nbr_pointsets
3091 deallocate(send_field_dble(j, i)%p)
3092 end do
3093 end do
3094
3095end subroutine yac_fput_real_ptr
3096
3105subroutine yac_fput_frac_real_ptr ( field_id, &
3106 nbr_pointsets, &
3107 collection_size, &
3108 send_field, &
3109 send_frac_mask, &
3110 info, &
3111 ierror )
3112
3115
3116 implicit none
3117
3118 integer, intent (in) :: field_id
3119 integer, intent (in) :: nbr_pointsets
3120 integer, intent (in) :: collection_size
3121 type(yac_real_ptr), intent (in) :: send_field(nbr_pointsets, &
3122 collection_size)
3123 type(yac_real_ptr), intent (in) :: send_frac_mask(nbr_pointsets, &
3124 collection_size)
3125 integer, intent (out) :: info
3126 integer, intent (out) :: ierror
3127
3128 integer :: i, j
3129 type(yac_dble_ptr) :: send_field_dble(nbr_pointsets, &
3130 collection_size)
3131 type(yac_dble_ptr) :: send_frac_mask_dble(nbr_pointsets, &
3132 collection_size)
3133
3135 field_id, collection_size, nbr_pointsets, &
3136 (/(SIZE(send_field(i, 1)%p),i=1,nbr_pointsets)/) )
3137
3138 call send_field_to_dble_ptr(field_id, &
3139 nbr_pointsets, &
3140 collection_size, &
3141 send_field, &
3142 send_field_dble, &
3143 send_frac_mask, &
3144 send_frac_mask_dble)
3145
3146 call yac_fput_frac_dble_ptr ( field_id, &
3147 nbr_pointsets, &
3148 collection_size, &
3149 send_field_dble, &
3150 send_frac_mask_dble, &
3151 info, &
3152 ierror )
3153
3154 do i = 1, collection_size
3155 do j = 1, nbr_pointsets
3156 deallocate(send_field_dble(j, i)%p)
3157 deallocate(send_frac_mask_dble(j, i)%p)
3158 end do
3159 end do
3160
3161end subroutine yac_fput_frac_real_ptr
3162
3170subroutine yac_fput_single_pointset_real ( field_id, &
3171 nbr_hor_points, &
3172 collection_size, &
3173 send_field, &
3174 info, &
3175 ierror )
3176
3179
3180 implicit none
3181
3182 integer, intent (in) :: field_id
3183 integer, intent (in) :: nbr_hor_points
3184 integer, intent (in) :: collection_size
3185 real, intent (in) :: send_field(nbr_hor_points, &
3186 collection_size)
3187 integer, intent (out) :: info
3188 integer, intent (out) :: ierror
3189
3190 double precision :: send_field_dble(nbr_hor_points, &
3191 collection_size)
3192
3194 field_id, collection_size, 1, (/nbr_hor_points/) )
3195
3196 call send_field_to_dble_single(field_id, &
3197 nbr_hor_points, &
3198 collection_size, &
3199 send_field, &
3200 send_field_dble)
3201
3202 call yac_fput_single_pointset_dble ( field_id, &
3203 nbr_hor_points, &
3204 collection_size, &
3205 send_field_dble, &
3206 info, &
3207 ierror )
3208
3209end subroutine yac_fput_single_pointset_real
3210
3220 nbr_hor_points, &
3221 collection_size, &
3222 send_field, &
3223 send_frac_mask, &
3224 info, &
3225 ierror )
3226
3229
3230 implicit none
3231
3232 integer, intent (in) :: field_id
3233 integer, intent (in) :: nbr_hor_points
3234 integer, intent (in) :: collection_size
3235 real, intent (in) :: send_field(nbr_hor_points, &
3236 collection_size)
3237 real, intent (in) :: send_frac_mask(nbr_hor_points, &
3238 collection_size)
3239 integer, intent (out) :: info
3240 integer, intent (out) :: ierror
3241
3242 double precision :: send_field_dble(nbr_hor_points, &
3243 collection_size)
3244 double precision :: send_frac_mask_dble(nbr_hor_points, &
3245 collection_size)
3247 field_id, collection_size, 1, (/nbr_hor_points/) )
3248
3249 call send_field_to_dble_single(field_id, &
3250 nbr_hor_points, &
3251 collection_size, &
3252 send_field, &
3253 send_field_dble, &
3254 send_frac_mask, &
3255 send_frac_mask_dble)
3256
3257 call yac_fput_frac_single_pointset_dble ( field_id, &
3258 nbr_hor_points, &
3259 collection_size, &
3260 send_field_dble, &
3261 send_frac_mask_dble, &
3262 info, &
3263 ierror )
3264
3266
3275subroutine yac_fput_dble ( field_id, &
3276 nbr_hor_points, &
3277 nbr_pointsets, &
3278 collection_size, &
3279 send_field, &
3280 info, &
3281 ierror )
3282
3283 use mo_yac_finterface, dummy => yac_fput_dble
3284
3285 implicit none
3286
3287 interface
3288
3289 subroutine yac_cput__c ( field_id, &
3290 collection_size, &
3291 send_field, &
3292 info, &
3293 ierror ) bind ( c, name='yac_cput_' )
3294
3295 use, intrinsic :: iso_c_binding, only : c_int, c_double
3296
3297 integer ( kind=c_int ), value :: field_id
3298 integer ( kind=c_int ), value :: collection_size
3299 real ( kind=c_double ) :: send_field(*)
3300 integer ( kind=c_int ) :: info
3301 integer ( kind=c_int ) :: ierror
3302
3303 end subroutine yac_cput__c
3304
3305 end interface
3306
3307 integer, intent (in) :: field_id
3308 integer, intent (in) :: nbr_hor_points
3309 integer, intent (in) :: nbr_pointsets
3310 integer, intent (in) :: collection_size
3311 double precision, intent (in) :: send_field(nbr_hor_points, &
3312 nbr_pointsets, &
3313 collection_size)
3314 integer, intent (out) :: info
3315 integer, intent (out) :: ierror
3316
3317 integer :: i
3318
3320 field_id, collection_size, nbr_pointsets, &
3321 (/(nbr_hor_points,i=1,nbr_pointsets)/) )
3322
3323 call yac_cput__c ( field_id, &
3324 collection_size, &
3325 send_field, &
3326 info, &
3327 ierror )
3328
3329end subroutine yac_fput_dble
3330
3340subroutine yac_fput_frac_dble ( field_id, &
3341 nbr_hor_points, &
3342 nbr_pointsets, &
3343 collection_size, &
3344 send_field, &
3345 send_frac_mask, &
3346 info, &
3347 ierror )
3348
3350
3351 implicit none
3352
3353 interface
3354
3355 subroutine yac_cput_frac__c ( field_id, &
3356 collection_size, &
3357 send_field, &
3358 send_frac_mask, &
3359 info, &
3360 ierror ) &
3361 bind( c, name='yac_cput_frac_' )
3362
3363 use, intrinsic :: iso_c_binding, only : c_int, c_double
3364
3365 integer ( kind=c_int ), value :: field_id
3366 integer ( kind=c_int ), value :: collection_size
3367 real ( kind=c_double ) :: send_field(*)
3368 real ( kind=c_double ) :: send_frac_mask(*)
3369 integer ( kind=c_int ) :: info
3370 integer ( kind=c_int ) :: ierror
3371
3372 end subroutine yac_cput_frac__c
3373
3374 end interface
3375
3376 integer, intent (in) :: field_id
3377 integer, intent (in) :: nbr_hor_points
3378 integer, intent (in) :: nbr_pointsets
3379 integer, intent (in) :: collection_size
3380 double precision, intent (in) :: send_field(nbr_hor_points, &
3381 nbr_pointsets, &
3382 collection_size)
3383 double precision, intent (in) :: send_frac_mask(nbr_hor_points, &
3384 nbr_pointsets, &
3385 collection_size)
3386 integer, intent (out) :: info
3387 integer, intent (out) :: ierror
3388
3389 integer :: i
3390
3392 field_id, collection_size, nbr_pointsets, &
3393 (/(nbr_hor_points,i=1,nbr_pointsets)/) )
3394
3395 call yac_cput_frac__c ( field_id, &
3396 collection_size, &
3397 send_field, &
3398 send_frac_mask, &
3399 info, &
3400 ierror )
3401
3402end subroutine yac_fput_frac_dble
3403
3411subroutine yac_fput_dble_ptr ( field_id, &
3412 nbr_pointsets, &
3413 collection_size, &
3414 send_field, &
3415 info, &
3416 ierror )
3417
3419 use iso_c_binding, only: c_ptr, c_loc
3420
3421 implicit none
3422
3423 interface
3424
3425 subroutine yac_cput_ptr__c ( field_id, &
3426 collection_size, &
3427 send_field, &
3428 info, &
3429 ierror ) &
3430 bind( c, name='yac_cput_ptr_' )
3431
3432 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
3433
3434 integer ( kind=c_int ), value :: field_id
3435 integer ( kind=c_int ), value :: collection_size
3436 type(c_ptr) :: send_field(*)
3437 integer ( kind=c_int ) :: info
3438 integer ( kind=c_int ) :: ierror
3439
3440 end subroutine yac_cput_ptr__c
3441
3442 end interface
3443
3444 integer, intent (in) :: field_id
3445 integer, intent (in) :: nbr_pointsets
3446 integer, intent (in) :: collection_size
3447 type(yac_dble_ptr), intent (in) :: send_field(nbr_pointsets, collection_size)
3448 integer, intent (out) :: info
3449 integer, intent (out) :: ierror
3450
3451 integer :: i, j
3452 type(c_ptr) :: send_field_(nbr_pointsets, collection_size)
3453
3455 field_id, collection_size, nbr_pointsets, &
3456 (/(SIZE(send_field(i, 1)%p),i=1,nbr_pointsets)/) )
3457
3458 do i = 1, collection_size
3459 do j = 1, nbr_pointsets
3460 yac_fassert(is_contiguous(send_field(j, i)%p), "ERROR(yac_fput_dble_ptr): send_field is not contiguous")
3461 send_field_(j, i) = c_loc(send_field(j, i)%p(1))
3462 end do
3463 end do
3464
3465 call yac_cput_ptr__c ( field_id, &
3466 collection_size, &
3467 send_field_, &
3468 info, &
3469 ierror )
3470
3471end subroutine yac_fput_dble_ptr
3472
3481subroutine yac_fput_frac_dble_ptr ( field_id, &
3482 nbr_pointsets, &
3483 collection_size, &
3484 send_field, &
3485 send_frac_mask, &
3486 info, &
3487 ierror )
3488
3490 use iso_c_binding, only: c_ptr, c_loc
3491
3492 implicit none
3493
3494 interface
3495
3496 subroutine yac_cput_frac_ptr__c ( field_id, &
3497 collection_size, &
3498 send_field, &
3499 send_frac_mask, &
3500 info, &
3501 ierror ) &
3502 bind( c, name='yac_cput_frac_ptr_' )
3503
3504 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
3505
3506 integer ( kind=c_int ), value :: field_id
3507 integer ( kind=c_int ), value :: collection_size
3508 type(c_ptr) :: send_field(*)
3509 type(c_ptr) :: send_frac_mask(*)
3510 integer ( kind=c_int ) :: info
3511 integer ( kind=c_int ) :: ierror
3512
3513 end subroutine yac_cput_frac_ptr__c
3514
3515 end interface
3516
3517 integer, intent (in) :: field_id
3518 integer, intent (in) :: nbr_pointsets
3519 integer, intent (in) :: collection_size
3520 type(yac_dble_ptr), intent (in) :: send_field(nbr_pointsets, collection_size)
3521 type(yac_dble_ptr), intent (in) :: send_frac_mask(nbr_pointsets, collection_size)
3522 integer, intent (out) :: info
3523 integer, intent (out) :: ierror
3524
3525 integer :: i, j
3526 type(c_ptr) :: send_field_(nbr_pointsets, collection_size)
3527 type(c_ptr) :: send_frac_mask_(nbr_pointsets, collection_size)
3528
3530 field_id, collection_size, nbr_pointsets, &
3531 (/(SIZE(send_field(i, 1)%p),i=1,nbr_pointsets)/) )
3532
3533 do i = 1, collection_size
3534 do j = 1, nbr_pointsets
3535 yac_fassert(is_contiguous(send_field(j, i)%p), "ERROR(yac_fput_frac_dble_ptr): send_field is not contiguous")
3536 send_field_(j, i) = c_loc(send_field(j, i)%p(1))
3537 yac_fassert(is_contiguous(send_frac_mask(j, i)%p), "ERROR(yac_fput_frac_dble_ptr): send_frac_mask is not contiguous")
3538 send_frac_mask_(j, i) = c_loc(send_frac_mask(j, i)%p(1))
3539 end do
3540 end do
3541
3542 call yac_cput_frac_ptr__c ( field_id, &
3543 collection_size, &
3544 send_field_, &
3545 send_frac_mask_, &
3546 info, &
3547 ierror )
3548
3549end subroutine yac_fput_frac_dble_ptr
3550
3558subroutine yac_fput_single_pointset_dble ( field_id, &
3559 nbr_hor_points, &
3560 collection_size, &
3561 send_field, &
3562 info, &
3563 ierror )
3564
3566
3567 implicit none
3568
3569 interface
3570
3571 subroutine yac_cput__c ( field_id, &
3572 collection_size, &
3573 send_field, &
3574 info, &
3575 ierror ) bind ( c, name='yac_cput_' )
3576
3577 use, intrinsic :: iso_c_binding, only : c_int, c_double
3578
3579 integer ( kind=c_int ), value :: field_id
3580 integer ( kind=c_int ), value :: collection_size
3581 real ( kind=c_double ) :: send_field(*)
3582 integer ( kind=c_int ) :: info
3583 integer ( kind=c_int ) :: ierror
3584
3585 end subroutine yac_cput__c
3586
3587 end interface
3588
3589 integer, intent (in) :: field_id
3590 integer, intent (in) :: nbr_hor_points
3591 integer, intent (in) :: collection_size
3592 double precision, intent (in) :: send_field(nbr_hor_points, &
3593 collection_size)
3594 integer, intent (out) :: info
3595 integer, intent (out) :: ierror
3596
3598 field_id, collection_size, 1, (/nbr_hor_points/) )
3599
3600 call yac_cput__c ( field_id, &
3601 collection_size, &
3602 send_field, &
3603 info, &
3604 ierror )
3605
3606end subroutine yac_fput_single_pointset_dble
3607
3617 nbr_hor_points, &
3618 collection_size, &
3619 send_field, &
3620 send_frac_mask, &
3621 info, &
3622 ierror )
3623
3625
3626 implicit none
3627
3628 interface
3629
3630 subroutine yac_cput_frac__c ( field_id, &
3631 collection_size, &
3632 send_field, &
3633 send_frac_mask, &
3634 info, &
3635 ierror ) &
3636 bind( c, name='yac_cput_frac_' )
3637
3638 use, intrinsic :: iso_c_binding, only : c_int, c_double
3639
3640 integer ( kind=c_int ), value :: field_id
3641 integer ( kind=c_int ), value :: collection_size
3642 real ( kind=c_double ) :: send_field(*)
3643 real ( kind=c_double ) :: send_frac_mask(*)
3644 integer ( kind=c_int ) :: info
3645 integer ( kind=c_int ) :: ierror
3646
3647 end subroutine yac_cput_frac__c
3648
3649 end interface
3650
3651 integer, intent (in) :: field_id
3652 integer, intent (in) :: nbr_hor_points
3653 integer, intent (in) :: collection_size
3654 double precision, intent (in) :: send_field(nbr_hor_points, &
3655 collection_size)
3656 double precision, intent (in) :: send_frac_mask(nbr_hor_points, &
3657 collection_size)
3658 integer, intent (out) :: info
3659 integer, intent (out) :: ierror
3660
3662 field_id, collection_size, 1, (/nbr_hor_points/) )
3663
3664 call yac_cput_frac__c ( field_id, &
3665 collection_size, &
3666 send_field, &
3667 send_frac_mask, &
3668 info, &
3669 ierror )
3670
3672
3673! ---------------------------------- get -------------------------------
3674
3675subroutine yac_fget_real ( field_id, &
3676 nbr_hor_points, &
3677 collection_size, &
3678 recv_field, &
3679 info, &
3680 ierror )
3681
3682 use mo_yac_finterface, dummy => yac_fget_real
3684
3685 implicit none
3686
3687 integer, intent (in) :: field_id
3688 integer, intent (in) :: nbr_hor_points
3689 integer, intent (in) :: collection_size
3690 real, intent (inout) :: recv_field(nbr_hor_points, collection_size)
3691
3692 integer, intent (out) :: info
3693 integer, intent (out) :: ierror
3694
3695 double precision :: recv_field_dble(nbr_hor_points, collection_size)
3696
3698 field_id, collection_size, 1, (/nbr_hor_points/) )
3699
3700 call recv_field_to_dble(field_id, &
3701 nbr_hor_points, &
3702 collection_size, &
3703 recv_field, &
3704 recv_field_dble)
3705
3706 call yac_fget_dble ( field_id, &
3707 nbr_hor_points, &
3708 collection_size, &
3709 recv_field_dble, &
3710 info, &
3711 ierror )
3712
3713 call recv_field_from_dble(field_id, &
3714 nbr_hor_points, &
3715 collection_size, &
3716 recv_field_dble, &
3717 recv_field)
3718
3719end subroutine yac_fget_real
3720
3721subroutine yac_fget_real_ptr ( field_id, &
3722 collection_size, &
3723 recv_field, &
3724 info, &
3725 ierror )
3726
3729
3730 implicit none
3731
3732 integer, intent (in) :: field_id
3733 integer, intent (in) :: collection_size
3734 type(yac_real_ptr) :: recv_field(collection_size)
3735 integer, intent (out) :: info
3736 integer, intent (out) :: ierror
3737
3738 type(yac_dble_ptr) :: recv_field_dble(collection_size)
3739
3741 field_id, collection_size, 1, (/SIZE(recv_field(1)%p, 1)/) )
3742
3743 call recv_field_to_dble_ptr(field_id, &
3744 collection_size, &
3745 recv_field, &
3746 recv_field_dble)
3747
3748 call yac_fget_dble_ptr ( field_id, &
3749 collection_size, &
3750 recv_field_dble, &
3751 info, &
3752 ierror )
3753
3754 call recv_field_from_dble_ptr(field_id, &
3755 collection_size, &
3756 recv_field_dble, &
3757 recv_field)
3758
3759end subroutine yac_fget_real_ptr
3760
3761subroutine yac_fget_dble ( field_id, &
3762 nbr_hor_points, &
3763 collection_size, &
3764 recv_field, &
3765 info, &
3766 ierror )
3767
3768 use mo_yac_finterface, dummy => yac_fget_dble
3769
3770 implicit none
3771
3772 interface
3773
3774 subroutine yac_cget__c ( field_id, &
3775 collection_size, &
3776 recv_field, &
3777 info, &
3778 ierror ) bind ( c, name='yac_cget_' )
3779
3780 use, intrinsic :: iso_c_binding, only : c_int, c_double
3781
3782 integer ( kind=c_int ), value :: field_id
3783 integer ( kind=c_int ), value :: collection_size
3784 real ( kind=c_double ) :: recv_field(*)
3785 integer ( kind=c_int ) :: info
3786 integer ( kind=c_int ) :: ierror
3787
3788 end subroutine yac_cget__c
3789
3790 end interface
3791
3792 integer, intent (in) :: field_id
3793 integer, intent (in) :: nbr_hor_points
3794 integer, intent (in) :: collection_size
3795 double precision, intent (inout):: recv_field(nbr_hor_points, collection_size)
3796
3797 integer, intent (out) :: info
3798 integer, intent (out) :: ierror
3799
3801 field_id, collection_size, 1, (/nbr_hor_points/) )
3802
3803 call yac_cget__c ( field_id, &
3804 collection_size, &
3805 recv_field, &
3806 info, &
3807 ierror )
3808
3809end subroutine yac_fget_dble
3810
3811subroutine yac_fget_dble_ptr ( field_id, &
3812 collection_size, &
3813 recv_field, &
3814 info, &
3815 ierror )
3816
3818 use iso_c_binding, only: c_ptr, c_loc
3819
3820 implicit none
3821
3822 interface
3823
3824 subroutine yac_cget_c ( field_id, &
3825 collection_size, &
3826 recv_field, &
3827 info, &
3828 ierror ) bind ( c, name='yac_cget' )
3829
3830 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
3831
3832 integer ( kind=c_int ), value :: field_id
3833 integer ( kind=c_int ), value :: collection_size
3834 type(c_ptr) :: recv_field(*)
3835 integer ( kind=c_int ) :: info
3836 integer ( kind=c_int ) :: ierror
3837
3838 end subroutine yac_cget_c
3839
3840 end interface
3841
3842 integer, intent (in) :: field_id
3843 integer, intent (in) :: collection_size
3844 type(yac_dble_ptr) :: recv_field(collection_size)
3845 integer, intent (out) :: info
3846 integer, intent (out) :: ierror
3847
3848 integer :: i
3849 type(c_ptr) :: recv_field_(collection_size)
3850
3852 field_id, collection_size, 1, (/SIZE(recv_field(1)%p)/) )
3853
3854 do i = 1, collection_size
3855 recv_field_(i) = c_loc(recv_field(i)%p(1))
3856 yac_fassert(is_contiguous(recv_field(i)%p), "ERROR(yac_fget_dble_ptr): recv_field is not contiguous")
3857 end do
3858
3859 call yac_cget_c ( field_id, &
3860 collection_size, &
3861 recv_field_, &
3862 info, &
3863 ierror )
3864
3865end subroutine yac_fget_dble_ptr
3866
3867! ---------------------------------- get_async -------------------------------
3868
3869subroutine yac_fget_async_dble_ptr ( field_id, &
3870 collection_size, &
3871 recv_field, &
3872 info, &
3873 ierror )
3874
3876 use iso_c_binding, only: c_ptr, c_loc
3877
3878 implicit none
3879
3880 interface
3881
3882 subroutine yac_cget_async_c ( field_id, &
3883 collection_size, &
3884 recv_field, &
3885 info, &
3886 ierror ) bind ( c, name='yac_cget_async' )
3887
3888 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
3889
3890 integer ( kind=c_int ), value :: field_id
3891 integer ( kind=c_int ), value :: collection_size
3892 type(c_ptr) :: recv_field(*)
3893 integer ( kind=c_int ) :: info
3894 integer ( kind=c_int ) :: ierror
3895
3896 end subroutine yac_cget_async_c
3897
3898 end interface
3899
3900 integer, intent (in) :: field_id
3901 integer, intent (in) :: collection_size
3902 type(yac_dble_ptr) :: recv_field(collection_size)
3903 integer, intent (out) :: info
3904 integer, intent (out) :: ierror
3905
3906 integer :: i
3907 type(c_ptr) :: recv_field_(collection_size)
3908
3910 field_id, collection_size, 1, (/SIZE(recv_field(1)%p)/) )
3911
3912 do i = 1, collection_size
3913 recv_field_(i) = c_loc(recv_field(i)%p(1))
3914 yac_fassert(is_contiguous(recv_field(i)%p), "ERROR(yac_fget_async_dble_ptr): recv_field is not contiguous")
3915 end do
3916
3917 call yac_cget_async_c ( field_id, &
3918 collection_size, &
3919 recv_field_, &
3920 info, &
3921 ierror )
3922
3923end subroutine yac_fget_async_dble_ptr
3924
3925! ---------------------------------- exchange --------------------------------
3926
3927subroutine yac_fexchange_real ( send_field_id, &
3928 recv_field_id, &
3929 send_nbr_hor_points, &
3930 send_nbr_pointsets, &
3931 recv_nbr_hor_points, &
3932 collection_size, &
3933 send_field, &
3934 recv_field, &
3935 send_info, &
3936 recv_info, &
3937 ierror )
3938
3941
3942 implicit none
3943
3944 integer, intent (in) :: send_field_id
3945 integer, intent (in) :: recv_field_id
3946 integer, intent (in) :: send_nbr_hor_points
3947 integer, intent (in) :: send_nbr_pointsets
3948 integer, intent (in) :: recv_nbr_hor_points
3949 integer, intent (in) :: collection_size
3950 real, intent (in) :: send_field(send_nbr_hor_points, &
3951 send_nbr_pointsets, &
3952 collection_size)
3953
3954 real, intent (inout) :: recv_field(recv_nbr_hor_points, &
3955 collection_size)
3956
3957 integer, intent (out) :: send_info
3958 integer, intent (out) :: recv_info
3959 integer, intent (out) :: ierror
3960
3961 double precision :: send_buffer(send_nbr_hor_points, &
3962 send_nbr_pointsets, &
3963 collection_size)
3964 double precision :: recv_buffer(recv_nbr_hor_points, &
3965 collection_size)
3966
3967 integer :: i
3968
3970 send_field_id, collection_size, send_nbr_pointsets, &
3971 (/(send_nbr_hor_points,i=1,send_nbr_pointsets)/) )
3973 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
3974
3975 call send_field_to_dble(send_field_id, &
3976 send_nbr_hor_points, &
3977 send_nbr_pointsets, &
3978 collection_size, &
3979 send_field, &
3980 send_buffer)
3981 call recv_field_to_dble(recv_field_id, &
3982 recv_nbr_hor_points, &
3983 collection_size, &
3984 recv_field, &
3985 recv_buffer)
3986
3987 call yac_fexchange_dble ( send_field_id, &
3988 recv_field_id, &
3989 send_nbr_hor_points, &
3990 send_nbr_pointsets, &
3991 recv_nbr_hor_points, &
3992 collection_size, &
3993 send_buffer, &
3994 recv_buffer, &
3995 send_info, &
3996 recv_info, &
3997 ierror )
3998
3999 call recv_field_from_dble(recv_field_id, &
4000 recv_nbr_hor_points, &
4001 collection_size, &
4002 recv_buffer, &
4003 recv_field)
4004
4005end subroutine yac_fexchange_real
4006
4007subroutine yac_fexchange_frac_real ( send_field_id, &
4008 recv_field_id, &
4009 send_nbr_hor_points, &
4010 send_nbr_pointsets, &
4011 recv_nbr_hor_points, &
4012 collection_size, &
4013 send_field, &
4014 send_frac_mask, &
4015 recv_field, &
4016 send_info, &
4017 recv_info, &
4018 ierror )
4019
4022
4023 implicit none
4024
4025 integer, intent (in) :: send_field_id
4026 integer, intent (in) :: recv_field_id
4027 integer, intent (in) :: send_nbr_hor_points
4028 integer, intent (in) :: send_nbr_pointsets
4029 integer, intent (in) :: recv_nbr_hor_points
4030 integer, intent (in) :: collection_size
4031 real, intent (in) :: send_field(send_nbr_hor_points, &
4032 send_nbr_pointsets, &
4033 collection_size)
4034
4035 real, intent (in) :: send_frac_mask(send_nbr_hor_points, &
4036 send_nbr_pointsets, &
4037 collection_size)
4038
4039 real, intent (inout) :: recv_field(recv_nbr_hor_points, &
4040 collection_size)
4041
4042 integer, intent (out) :: send_info
4043 integer, intent (out) :: recv_info
4044 integer, intent (out) :: ierror
4045
4046 double precision :: send_buffer(send_nbr_hor_points, &
4047 send_nbr_pointsets, &
4048 collection_size)
4049 double precision :: send_frac_mask_buffer(send_nbr_hor_points, &
4050 send_nbr_pointsets, &
4051 collection_size)
4052 double precision :: recv_buffer(recv_nbr_hor_points, &
4053 collection_size)
4054
4055 integer :: i
4056
4058 send_field_id, collection_size, send_nbr_pointsets, &
4059 (/(send_nbr_hor_points,i=1,send_nbr_pointsets)/) )
4061 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
4062
4063 call send_field_to_dble(send_field_id, &
4064 send_nbr_hor_points, &
4065 send_nbr_pointsets, &
4066 collection_size, &
4067 send_field, &
4068 send_buffer, &
4069 send_frac_mask, &
4070 send_frac_mask_buffer)
4071 call recv_field_to_dble(recv_field_id, &
4072 recv_nbr_hor_points, &
4073 collection_size, &
4074 recv_field, &
4075 recv_buffer)
4076
4077 call yac_fexchange_frac_dble ( send_field_id, &
4078 recv_field_id, &
4079 send_nbr_hor_points, &
4080 send_nbr_pointsets, &
4081 recv_nbr_hor_points, &
4082 collection_size, &
4083 send_buffer, &
4084 send_frac_mask_buffer, &
4085 recv_buffer, &
4086 send_info, &
4087 recv_info, &
4088 ierror )
4089
4090 call recv_field_from_dble(recv_field_id, &
4091 recv_nbr_hor_points, &
4092 collection_size, &
4093 recv_buffer, &
4094 recv_field)
4095
4096end subroutine yac_fexchange_frac_real
4097
4098subroutine yac_fexchange_real_ptr ( send_field_id, &
4099 recv_field_id, &
4100 send_nbr_pointsets, &
4101 collection_size, &
4102 send_field, &
4103 recv_field, &
4104 send_info, &
4105 recv_info, &
4106 ierror )
4107
4110
4111 implicit none
4112
4113 integer, intent (in) :: send_field_id
4114 integer, intent (in) :: recv_field_id
4115 integer, intent (in) :: send_nbr_pointsets
4116 integer, intent (in) :: collection_size
4117 type(yac_real_ptr), intent (in) :: &
4118 send_field(send_nbr_pointsets, &
4119 collection_size)
4120
4121 type(yac_real_ptr) :: recv_field(collection_size)
4122
4123 integer, intent (out) :: send_info
4124 integer, intent (out) :: recv_info
4125 integer, intent (out) :: ierror
4126
4127 integer :: i, j
4128 type(yac_dble_ptr) :: send_field_dble(send_nbr_pointsets, collection_size)
4129 type(yac_dble_ptr) :: recv_field_dble(collection_size)
4130
4132 send_field_id, collection_size, send_nbr_pointsets, &
4133 (/(SIZE(send_field(i,1)%p),i=1,send_nbr_pointsets)/) )
4135 recv_field_id, collection_size, 1, (/SIZE(recv_field(1)%p)/) )
4136
4137 call send_field_to_dble_ptr(send_field_id, &
4138 send_nbr_pointsets, &
4139 collection_size, &
4140 send_field, &
4141 send_field_dble)
4142 call recv_field_to_dble_ptr(recv_field_id, &
4143 collection_size, &
4144 recv_field, &
4145 recv_field_dble)
4146
4147 call yac_fexchange_dble_ptr ( send_field_id, &
4148 recv_field_id, &
4149 send_nbr_pointsets, &
4150 collection_size, &
4151 send_field_dble, &
4152 recv_field_dble, &
4153 send_info, &
4154 recv_info, &
4155 ierror )
4156
4157 call recv_field_from_dble_ptr(recv_field_id, &
4158 collection_size, &
4159 recv_field_dble, &
4160 recv_field)
4161 do i = 1, collection_size
4162 do j = 1, send_nbr_pointsets
4163 deallocate(send_field_dble(j, i)%p)
4164 end do
4165 end do
4166
4167end subroutine yac_fexchange_real_ptr
4168
4169subroutine yac_fexchange_frac_real_ptr ( send_field_id, &
4170 recv_field_id, &
4171 send_nbr_pointsets, &
4172 collection_size, &
4173 send_field, &
4174 send_frac_mask, &
4175 recv_field, &
4176 send_info, &
4177 recv_info, &
4178 ierror )
4179
4182
4183 implicit none
4184
4185 integer, intent (in) :: send_field_id
4186 integer, intent (in) :: recv_field_id
4187 integer, intent (in) :: send_nbr_pointsets
4188 integer, intent (in) :: collection_size
4189 type(yac_real_ptr), intent (in) :: &
4190 send_field(send_nbr_pointsets, &
4191 collection_size)
4192
4193 type(yac_real_ptr), intent (in) :: &
4194 send_frac_mask(send_nbr_pointsets, &
4195 collection_size)
4196
4197 type(yac_real_ptr) :: recv_field(collection_size)
4198
4199 integer, intent (out) :: send_info
4200 integer, intent (out) :: recv_info
4201 integer, intent (out) :: ierror
4202
4203 integer :: i, j
4204 type(yac_dble_ptr) :: send_field_dble(send_nbr_pointsets, collection_size)
4205 type(yac_dble_ptr) :: send_frac_mask_dble(send_nbr_pointsets, collection_size)
4206 type(yac_dble_ptr) :: recv_field_dble(collection_size)
4207
4209 send_field_id, collection_size, send_nbr_pointsets, &
4210 (/(SIZE(send_field(i,1)%p),i=1,send_nbr_pointsets)/) )
4212 recv_field_id, collection_size, 1, (/SIZE(recv_field(1)%p)/) )
4213
4214 call send_field_to_dble_ptr(send_field_id, &
4215 send_nbr_pointsets, &
4216 collection_size, &
4217 send_field, &
4218 send_field_dble, &
4219 send_frac_mask, &
4220 send_frac_mask_dble)
4221 call recv_field_to_dble_ptr(recv_field_id, &
4222 collection_size, &
4223 recv_field, &
4224 recv_field_dble)
4225
4226 call yac_fexchange_frac_dble_ptr ( send_field_id, &
4227 recv_field_id, &
4228 send_nbr_pointsets, &
4229 collection_size, &
4230 send_field_dble, &
4231 send_frac_mask_dble, &
4232 recv_field_dble, &
4233 send_info, &
4234 recv_info, &
4235 ierror )
4236
4237 call recv_field_from_dble_ptr(recv_field_id, &
4238 collection_size, &
4239 recv_field_dble, &
4240 recv_field)
4241 do i = 1, collection_size
4242 do j = 1, send_nbr_pointsets
4243 deallocate(send_field_dble(j, i)%p)
4244 deallocate(send_frac_mask_dble(j, i)%p)
4245 end do
4246 end do
4247
4248end subroutine yac_fexchange_frac_real_ptr
4249
4250subroutine yac_fexchange_single_pointset_real ( send_field_id, &
4251 recv_field_id, &
4252 send_nbr_hor_points, &
4253 recv_nbr_hor_points, &
4254 collection_size, &
4255 send_field, &
4256 recv_field, &
4257 send_info, &
4258 recv_info, &
4259 ierror )
4260
4263
4264 implicit none
4265
4266 integer, intent (in) :: send_field_id
4267 integer, intent (in) :: recv_field_id
4268 integer, intent (in) :: send_nbr_hor_points
4269 integer, intent (in) :: recv_nbr_hor_points
4270 integer, intent (in) :: collection_size
4271 real, intent (in) :: send_field(send_nbr_hor_points, &
4272 collection_size)
4273
4274 real, intent (inout) :: recv_field(recv_nbr_hor_points, &
4275 collection_size)
4276
4277 integer, intent (out) :: send_info
4278 integer, intent (out) :: recv_info
4279 integer, intent (out) :: ierror
4280
4281 double precision :: send_buffer(send_nbr_hor_points, collection_size)
4282 double precision :: recv_buffer(recv_nbr_hor_points, collection_size)
4283
4285 send_field_id, collection_size, 1, (/send_nbr_hor_points/) )
4287 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
4288
4289 call send_field_to_dble_single(send_field_id, &
4290 send_nbr_hor_points, &
4291 collection_size, &
4292 send_field, &
4293 send_buffer)
4294
4295 call recv_field_to_dble(recv_field_id, &
4296 recv_nbr_hor_points, &
4297 collection_size, &
4298 recv_field, &
4299 recv_buffer)
4300
4301 call yac_fexchange_single_pointset_dble ( send_field_id, &
4302 recv_field_id, &
4303 send_nbr_hor_points, &
4304 recv_nbr_hor_points, &
4305 collection_size, &
4306 send_buffer, &
4307 recv_buffer, &
4308 send_info, &
4309 recv_info, &
4310 ierror )
4311
4312 call recv_field_from_dble(recv_field_id, &
4313 recv_nbr_hor_points, &
4314 collection_size, &
4315 recv_buffer, &
4316 recv_field)
4317
4319
4320subroutine yac_fexchange_frac_single_pointset_real ( send_field_id, &
4321 recv_field_id, &
4322 send_nbr_hor_points, &
4323 recv_nbr_hor_points, &
4324 collection_size, &
4325 send_field, &
4326 send_frac_mask, &
4327 recv_field, &
4328 send_info, &
4329 recv_info, &
4330 ierror )
4331
4334
4335 implicit none
4336
4337 integer, intent (in) :: send_field_id
4338 integer, intent (in) :: recv_field_id
4339 integer, intent (in) :: send_nbr_hor_points
4340 integer, intent (in) :: recv_nbr_hor_points
4341 integer, intent (in) :: collection_size
4342 real, intent (in) :: send_field(send_nbr_hor_points, &
4343 collection_size)
4344
4345 real, intent (in) :: send_frac_mask(send_nbr_hor_points, &
4346 collection_size)
4347
4348 real, intent (inout) :: recv_field(recv_nbr_hor_points, &
4349 collection_size)
4350
4351 integer, intent (out) :: send_info
4352 integer, intent (out) :: recv_info
4353 integer, intent (out) :: ierror
4354
4355 double precision :: send_buffer(send_nbr_hor_points, collection_size)
4356 double precision :: send_frac_mask_buffer(send_nbr_hor_points, collection_size)
4357 double precision :: recv_buffer(recv_nbr_hor_points, collection_size)
4358
4360 send_field_id, collection_size, 1, (/send_nbr_hor_points/) )
4362 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
4363
4364 call send_field_to_dble_single(send_field_id, &
4365 send_nbr_hor_points, &
4366 collection_size, &
4367 send_field, &
4368 send_buffer, &
4369 send_frac_mask, &
4370 send_frac_mask_buffer)
4371
4372 call recv_field_to_dble(recv_field_id, &
4373 recv_nbr_hor_points, &
4374 collection_size, &
4375 recv_field, &
4376 recv_buffer)
4377
4378 call yac_fexchange_frac_single_pointset_dble ( send_field_id, &
4379 recv_field_id, &
4380 send_nbr_hor_points, &
4381 recv_nbr_hor_points, &
4382 collection_size, &
4383 send_buffer, &
4384 send_frac_mask_buffer, &
4385 recv_buffer, &
4386 send_info, &
4387 recv_info, &
4388 ierror )
4389
4390 call recv_field_from_dble(recv_field_id, &
4391 recv_nbr_hor_points, &
4392 collection_size, &
4393 recv_buffer, &
4394 recv_field)
4395
4397
4410subroutine yac_fexchange_dble ( send_field_id, &
4411 recv_field_id, &
4412 send_nbr_hor_points, &
4413 send_nbr_pointsets, &
4414 recv_nbr_hor_points, &
4415 collection_size, &
4416 send_field, &
4417 recv_field, &
4418 send_info, &
4419 recv_info, &
4420 ierror )
4421
4423
4424 implicit none
4425
4426 interface
4427
4428 subroutine yac_cexchange__c ( send_field_id, &
4429 recv_field_id, &
4430 collection_size, &
4431 send_field, &
4432 recv_field, &
4433 send_info, &
4434 recv_info, &
4435 ierror ) &
4436 bind( c, name='yac_cexchange_' )
4437
4438 use, intrinsic :: iso_c_binding, only : c_int, c_double
4439
4440 integer ( kind=c_int ), value :: send_field_id
4441 integer ( kind=c_int ), value :: recv_field_id
4442 integer ( kind=c_int ), value :: collection_size
4443 real ( kind=c_double ) :: send_field(*)
4444 real ( kind=c_double ) :: recv_field(*)
4445 integer ( kind=c_int ) :: send_info
4446 integer ( kind=c_int ) :: recv_info
4447 integer ( kind=c_int ) :: ierror
4448
4449 end subroutine yac_cexchange__c
4450
4451 end interface
4452
4453 integer, intent (in) :: send_field_id
4454 integer, intent (in) :: recv_field_id
4455 integer, intent (in) :: send_nbr_hor_points
4456 integer, intent (in) :: send_nbr_pointsets
4457 integer, intent (in) :: recv_nbr_hor_points
4458 integer, intent (in) :: collection_size
4459 double precision, intent (in) :: &
4460 send_field( &
4461 send_nbr_hor_points, &
4462 send_nbr_pointsets, &
4463 collection_size)
4464 double precision, intent (inout):: &
4465 recv_field( &
4466 recv_nbr_hor_points, &
4467 collection_size)
4468 integer, intent (out) :: send_info
4469 integer, intent (out) :: recv_info
4470 integer, intent (out) :: ierror
4471
4472 integer :: i
4473
4475 send_field_id, collection_size, send_nbr_pointsets, &
4476 (/(send_nbr_hor_points,i=1,send_nbr_pointsets)/) )
4478 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
4479
4480 call yac_cexchange__c ( send_field_id, &
4481 recv_field_id, &
4482 collection_size, &
4483 send_field, &
4484 recv_field, &
4485 send_info, &
4486 recv_info, &
4487 ierror )
4488
4489end subroutine yac_fexchange_dble
4490
4504subroutine yac_fexchange_frac_dble ( send_field_id, &
4505 recv_field_id, &
4506 send_nbr_hor_points, &
4507 send_nbr_pointsets, &
4508 recv_nbr_hor_points, &
4509 collection_size, &
4510 send_field, &
4511 send_frac_mask, &
4512 recv_field, &
4513 send_info, &
4514 recv_info, &
4515 ierror )
4516
4518
4519 implicit none
4520
4521 interface
4522
4523 subroutine yac_cexchange_frac__c ( send_field_id, &
4524 recv_field_id, &
4525 collection_size, &
4526 send_field, &
4527 send_frac_mask, &
4528 recv_field, &
4529 send_info, &
4530 recv_info, &
4531 ierror ) &
4532 bind( c, name='yac_cexchange_frac_' )
4533
4534 use, intrinsic :: iso_c_binding, only : c_int, c_double
4535
4536 integer ( kind=c_int ), value :: send_field_id
4537 integer ( kind=c_int ), value :: recv_field_id
4538 integer ( kind=c_int ), value :: collection_size
4539 real ( kind=c_double ) :: send_field(*)
4540 real ( kind=c_double ) :: send_frac_mask(*)
4541 real ( kind=c_double ) :: recv_field(*)
4542 integer ( kind=c_int ) :: send_info
4543 integer ( kind=c_int ) :: recv_info
4544 integer ( kind=c_int ) :: ierror
4545
4546 end subroutine yac_cexchange_frac__c
4547
4548 end interface
4549
4550 integer, intent (in) :: send_field_id
4551 integer, intent (in) :: recv_field_id
4552 integer, intent (in) :: send_nbr_hor_points
4553 integer, intent (in) :: send_nbr_pointsets
4554 integer, intent (in) :: recv_nbr_hor_points
4555 integer, intent (in) :: collection_size
4556 double precision, intent (in) :: &
4557 send_field( &
4558 send_nbr_hor_points, &
4559 send_nbr_pointsets, &
4560 collection_size)
4561 double precision, intent (in) :: &
4562 send_frac_mask( &
4563 send_nbr_hor_points, &
4564 send_nbr_pointsets, &
4565 collection_size)
4566 double precision, intent (inout):: &
4567 recv_field( &
4568 recv_nbr_hor_points, &
4569 collection_size)
4570 integer, intent (out) :: send_info
4571 integer, intent (out) :: recv_info
4572 integer, intent (out) :: ierror
4573
4574 integer :: i
4575
4577 send_field_id, collection_size, send_nbr_pointsets, &
4578 (/(send_nbr_hor_points,i=1,send_nbr_pointsets)/) )
4580 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
4581
4582 call yac_cexchange_frac__c ( send_field_id, &
4583 recv_field_id, &
4584 collection_size, &
4585 send_field, &
4586 send_frac_mask, &
4587 recv_field, &
4588 send_info, &
4589 recv_info, &
4590 ierror )
4591
4592end subroutine yac_fexchange_frac_dble
4593
4604subroutine yac_fexchange_dble_ptr ( send_field_id, &
4605 recv_field_id, &
4606 send_nbr_pointsets, &
4607 collection_size, &
4608 send_field, &
4609 recv_field, &
4610 send_info, &
4611 recv_info, &
4612 ierror )
4613
4615 use iso_c_binding, only: c_ptr, c_loc
4616
4617 implicit none
4618
4619 interface
4620
4621 subroutine yac_cexchange_ptr__c ( send_field_id, &
4622 recv_field_id, &
4623 collection_size, &
4624 send_field, &
4625 recv_field, &
4626 send_info, &
4627 recv_info, &
4628 ierror ) &
4629 bind( c, name='yac_cexchange_ptr_' )
4630
4631 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
4632
4633 integer ( kind=c_int ), value :: send_field_id
4634 integer ( kind=c_int ), value :: recv_field_id
4635 integer ( kind=c_int ), value :: collection_size
4636 type(c_ptr) :: send_field(*)
4637 type(c_ptr) :: recv_field(*)
4638 integer ( kind=c_int ) :: send_info
4639 integer ( kind=c_int ) :: recv_info
4640 integer ( kind=c_int ) :: ierror
4641
4642 end subroutine yac_cexchange_ptr__c
4643
4644 end interface
4645
4646 integer, intent (in) :: send_field_id
4647 integer, intent (in) :: recv_field_id
4648 integer, intent (in) :: send_nbr_pointsets
4649 integer, intent (in) :: collection_size
4650 type(yac_dble_ptr), intent (in) :: &
4651 send_field(send_nbr_pointsets, &
4652 collection_size)
4653 type(yac_dble_ptr) :: recv_field(collection_size)
4654 integer, intent (out) :: send_info
4655 integer, intent (out) :: recv_info
4656 integer, intent (out) :: ierror
4657
4658 integer :: i, j
4659 type(c_ptr) :: send_field_(send_nbr_pointsets, collection_size)
4660 type(c_ptr) :: recv_field_(collection_size)
4661
4663 send_field_id, collection_size, send_nbr_pointsets, &
4664 (/(SIZE(send_field(i,1)%p),i=1,send_nbr_pointsets)/) )
4666 recv_field_id, collection_size, 1, (/SIZE(recv_field(1)%p)/) )
4667
4668 do i = 1, collection_size
4669 do j = 1, send_nbr_pointsets
4670 send_field_(j, i) = c_loc(send_field(j, i)%p(1))
4671 yac_fassert(is_contiguous(send_field(j, i)%p), "ERROR(yac_fexchange_dble_ptr): send_field is not contiguous")
4672 end do
4673 end do
4674 do i = 1, collection_size
4675 recv_field_(i) = c_loc(recv_field(i)%p(1))
4676 yac_fassert(is_contiguous(recv_field(i)%p), "ERROR(yac_fexchange_dble_ptr): recv_field is not contiguous")
4677 end do
4678
4679 call yac_cexchange_ptr__c ( send_field_id, &
4680 recv_field_id, &
4681 collection_size, &
4682 send_field_, &
4683 recv_field_, &
4684 send_info, &
4685 recv_info, &
4686 ierror )
4687
4688end subroutine yac_fexchange_dble_ptr
4689
4701subroutine yac_fexchange_frac_dble_ptr ( send_field_id, &
4702 recv_field_id, &
4703 send_nbr_pointsets, &
4704 collection_size, &
4705 send_field, &
4706 send_frac_mask, &
4707 recv_field, &
4708 send_info, &
4709 recv_info, &
4710 ierror )
4711
4713 use iso_c_binding, only: c_ptr, c_loc
4714
4715 implicit none
4716
4717 interface
4718
4719 subroutine yac_cexchange_frac_ptr__c ( send_field_id, &
4720 recv_field_id, &
4721 collection_size, &
4722 send_field, &
4723 send_frac_mask, &
4724 recv_field, &
4725 send_info, &
4726 recv_info, &
4727 ierror ) &
4728 bind( c, name='yac_cexchange_frac_ptr_' )
4729
4730 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
4731
4732 integer ( kind=c_int ), value :: send_field_id
4733 integer ( kind=c_int ), value :: recv_field_id
4734 integer ( kind=c_int ), value :: collection_size
4735 type(c_ptr) :: send_field(*)
4736 type(c_ptr) :: send_frac_mask(*)
4737 type(c_ptr) :: recv_field(*)
4738 integer ( kind=c_int ) :: send_info
4739 integer ( kind=c_int ) :: recv_info
4740 integer ( kind=c_int ) :: ierror
4741
4742 end subroutine yac_cexchange_frac_ptr__c
4743
4744 end interface
4745
4746 integer, intent (in) :: send_field_id
4747 integer, intent (in) :: recv_field_id
4748 integer, intent (in) :: send_nbr_pointsets
4749 integer, intent (in) :: collection_size
4750 type(yac_dble_ptr), intent (in) :: &
4751 send_field(send_nbr_pointsets, &
4752 collection_size)
4753 type(yac_dble_ptr), intent (in) :: &
4754 send_frac_mask(send_nbr_pointsets, &
4755 collection_size)
4756 type(yac_dble_ptr) :: recv_field(collection_size)
4757 integer, intent (out) :: send_info
4758 integer, intent (out) :: recv_info
4759 integer, intent (out) :: ierror
4760
4761 integer :: i, j
4762 type(c_ptr) :: send_field_(send_nbr_pointsets, collection_size)
4763 type(c_ptr) :: send_frac_mask_(send_nbr_pointsets, collection_size)
4764 type(c_ptr) :: recv_field_(collection_size)
4765
4767 send_field_id, collection_size, send_nbr_pointsets, &
4768 (/(SIZE(send_field(i,1)%p),i=1,send_nbr_pointsets)/) )
4770 send_field_id, collection_size, send_nbr_pointsets, &
4771 (/(SIZE(send_frac_mask(i,1)%p),i=1,send_nbr_pointsets)/) )
4773 recv_field_id, collection_size, 1, (/SIZE(recv_field(1)%p)/) )
4774
4775 do i = 1, collection_size
4776 do j = 1, send_nbr_pointsets
4777 send_field_(j, i) = c_loc(send_field(j, i)%p(1))
4778 yac_fassert(is_contiguous(send_field(j, i)%p), "ERROR(yac_fexchange_frac_dble_ptr): send_field is not contiguous")
4779 send_frac_mask_(j, i) = c_loc(send_frac_mask(j, i)%p(1))
4780 yac_fassert(is_contiguous(send_frac_mask(j, i)%p), "ERROR(yac_fexchange_frac_dble_ptr): send_frac_mask is not contiguous")
4781 end do
4782 end do
4783 do i = 1, collection_size
4784 recv_field_(i) = c_loc(recv_field(i)%p(1))
4785 yac_fassert(is_contiguous(recv_field(i)%p), "ERROR(yac_fexchange_frac_dble_ptr): recv_field is not contiguous")
4786 end do
4787
4788 call yac_cexchange_frac_ptr__c ( send_field_id, &
4789 recv_field_id, &
4790 collection_size, &
4791 send_field_, &
4792 send_frac_mask_, &
4793 recv_field_, &
4794 send_info, &
4795 recv_info, &
4796 ierror )
4797
4798end subroutine yac_fexchange_frac_dble_ptr
4799
4811subroutine yac_fexchange_single_pointset_dble ( send_field_id, &
4812 recv_field_id, &
4813 send_nbr_hor_points, &
4814 recv_nbr_hor_points, &
4815 collection_size, &
4816 send_field, &
4817 recv_field, &
4818 send_info, &
4819 recv_info, &
4820 ierror )
4821
4823
4824 implicit none
4825
4826 interface
4827
4828 subroutine yac_cexchange__c ( send_field_id, &
4829 recv_field_id, &
4830 collection_size, &
4831 send_field, &
4832 recv_field, &
4833 send_info, &
4834 recv_info, &
4835 ierror ) &
4836 bind( c, name='yac_cexchange_' )
4837
4838 use, intrinsic :: iso_c_binding, only : c_int, c_double
4839
4840 integer ( kind=c_int ), value :: send_field_id
4841 integer ( kind=c_int ), value :: recv_field_id
4842 integer ( kind=c_int ), value :: collection_size
4843 real ( kind=c_double ) :: send_field(*)
4844 real ( kind=c_double ) :: recv_field(*)
4845 integer ( kind=c_int ) :: send_info
4846 integer ( kind=c_int ) :: recv_info
4847 integer ( kind=c_int ) :: ierror
4848
4849 end subroutine yac_cexchange__c
4850
4851 end interface
4852
4853 integer, intent (in) :: send_field_id
4854 integer, intent (in) :: recv_field_id
4855 integer, intent (in) :: send_nbr_hor_points
4856 integer, intent (in) :: recv_nbr_hor_points
4857 integer, intent (in) :: collection_size
4858 double precision, intent (in) :: &
4859 send_field(send_nbr_hor_points, &
4860 collection_size)
4861 double precision, intent (inout):: &
4862 recv_field(recv_nbr_hor_points, &
4863 collection_size)
4864 integer, intent (out) :: send_info
4865 integer, intent (out) :: recv_info
4866 integer, intent (out) :: ierror
4867
4869 send_field_id, collection_size, 1, (/send_nbr_hor_points/) )
4871 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
4872
4873 call yac_cexchange__c ( send_field_id, &
4874 recv_field_id, &
4875 collection_size, &
4876 send_field, &
4877 recv_field, &
4878 send_info, &
4879 recv_info, &
4880 ierror )
4881
4883
4896subroutine yac_fexchange_frac_single_pointset_dble ( send_field_id, &
4897 recv_field_id, &
4898 send_nbr_hor_points, &
4899 recv_nbr_hor_points, &
4900 collection_size, &
4901 send_field, &
4902 send_frac_mask, &
4903 recv_field, &
4904 send_info, &
4905 recv_info, &
4906 ierror )
4907
4909
4910 implicit none
4911
4912 interface
4913
4914 subroutine yac_cexchange_frac__c ( send_field_id, &
4915 recv_field_id, &
4916 collection_size, &
4917 send_field, &
4918 send_frac_mask, &
4919 recv_field, &
4920 send_info, &
4921 recv_info, &
4922 ierror ) &
4923 bind( c, name='yac_cexchange_frac_' )
4924
4925 use, intrinsic :: iso_c_binding, only : c_int, c_double
4926
4927 integer ( kind=c_int ), value :: send_field_id
4928 integer ( kind=c_int ), value :: recv_field_id
4929 integer ( kind=c_int ), value :: collection_size
4930 real ( kind=c_double ) :: send_field(*)
4931 real ( kind=c_double ) :: send_frac_mask(*)
4932 real ( kind=c_double ) :: recv_field(*)
4933 integer ( kind=c_int ) :: send_info
4934 integer ( kind=c_int ) :: recv_info
4935 integer ( kind=c_int ) :: ierror
4936
4937 end subroutine yac_cexchange_frac__c
4938
4939 end interface
4940
4941 integer, intent (in) :: send_field_id
4942 integer, intent (in) :: recv_field_id
4943 integer, intent (in) :: send_nbr_hor_points
4944 integer, intent (in) :: recv_nbr_hor_points
4945 integer, intent (in) :: collection_size
4946 double precision, intent (in) :: &
4947 send_field(send_nbr_hor_points, &
4948 collection_size)
4949 double precision, intent (in) :: &
4950 send_frac_mask(send_nbr_hor_points, &
4951 collection_size)
4952 double precision, intent (inout):: &
4953 recv_field(recv_nbr_hor_points, &
4954 collection_size)
4955 integer, intent (out) :: send_info
4956 integer, intent (out) :: recv_info
4957 integer, intent (out) :: ierror
4958
4960 send_field_id, collection_size, 1, (/send_nbr_hor_points/) )
4962 recv_field_id, collection_size, 1, (/recv_nbr_hor_points/) )
4963
4964 call yac_cexchange_frac__c ( send_field_id, &
4965 recv_field_id, &
4966 collection_size, &
4967 send_field, &
4968 send_frac_mask, &
4969 recv_field, &
4970 send_info, &
4971 recv_info, &
4972 ierror )
4973
4975
4976! ----------------------------------------------------------------------
4977
4978subroutine yac_ftest_i ( field_id, flag )
4979
4980 use mo_yac_finterface, dummy => yac_ftest_i
4981
4982 implicit none
4983
4984 interface
4985
4986 subroutine yac_ctest_c ( field_id, flag ) &
4987 bind( c, name='yac_ctest' )
4988
4989 use, intrinsic :: iso_c_binding, only : c_int
4990
4991 integer ( kind=c_int ), value :: field_id
4992 integer ( kind=c_int ) :: flag
4993
4994 end subroutine yac_ctest_c
4995
4996 end interface
4997
4998 integer, intent (in) :: field_id
4999 integer, intent (out) :: flag
5000
5001 call yac_ctest_c ( field_id, flag )
5002
5003end subroutine yac_ftest_i
5004
5005subroutine yac_ftest_l ( field_id, flag )
5006
5007 use mo_yac_finterface, dummy => yac_ftest_l
5008
5009 implicit none
5010
5011 interface
5012
5013 subroutine yac_ctest_c ( field_id, flag ) &
5014 bind( c, name='yac_ctest' )
5015
5016 use, intrinsic :: iso_c_binding, only : c_int
5017
5018 integer ( kind=c_int ), value :: field_id
5019 integer ( kind=c_int ) :: flag
5020
5021 end subroutine yac_ctest_c
5022
5023 end interface
5024
5025 integer, intent (in) :: field_id
5026 logical, intent (out) :: flag
5027
5028 integer :: iflag
5029
5030 call yac_ctest_c ( field_id, iflag )
5031
5032 flag = iflag /= 0
5033
5034end subroutine yac_ftest_l
5035
5036! ----------------------------------------------------------------------
5037
5038subroutine yac_fwait ( field_id )
5039
5040 use mo_yac_finterface, dummy => yac_fwait
5041
5042 implicit none
5043
5044 interface
5045
5046 subroutine yac_cwait_c ( field_id ) &
5047 bind( c, name='yac_cwait' )
5048
5049 use, intrinsic :: iso_c_binding, only : c_int
5050
5051 integer ( kind=c_int ), value :: field_id
5052
5053 end subroutine yac_cwait_c
5054
5055 end interface
5056
5057 integer, intent (in) :: field_id
5058
5059 call yac_cwait_c ( field_id )
5060
5061end subroutine yac_fwait
5062
5063! ----------------------------------------------------------------------
5064
5065subroutine yac_fget_comp_comm ( comp_id, comp_comm )
5066
5068
5069 implicit none
5070
5071 interface
5072
5073 subroutine yac_get_comp_comm_c ( comp_id, comp_comm ) &
5074 bind( c, name='yac_get_comp_comm_f2c' )
5075
5076 use, intrinsic :: iso_c_binding, only : c_int
5078
5079 integer ( kind=c_int ), value :: comp_id
5080 integer ( kind=YAC_MPI_FINT_KIND ) :: comp_comm
5081
5082 end subroutine yac_get_comp_comm_c
5083
5084 end interface
5085
5086 integer, intent (in) :: comp_id
5087 integer, intent (out) :: comp_comm
5088
5089 call yac_get_comp_comm_c ( comp_id, comp_comm )
5090
5091end subroutine yac_fget_comp_comm
5092
5093! ----------------------------------------------------------------------
5094
5095subroutine yac_fget_comps_comm ( comp_names, num_comps, comps_comm )
5096
5097 use, intrinsic :: iso_c_binding, only : c_null_char, c_ptr, c_loc, c_char
5100
5101 implicit none
5102
5103 interface
5104
5105 subroutine yac_cget_comps_comm_c ( comp_names, &
5106 num_comps, &
5107 comps_comm) &
5108 bind( c, name='yac_cget_comps_comm_f2c' )
5109
5110 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
5112
5113 type ( c_ptr ) :: comp_names(*)
5114 integer ( kind=c_int ), value :: num_comps
5115 integer ( kind=YAC_MPI_FINT_KIND ) :: comps_comm
5116
5117 end subroutine yac_cget_comps_comm_c
5118
5119 end interface
5120
5121 integer, intent(in) :: num_comps
5122 character(kind=c_char, len=*), intent(in) :: &
5123 comp_names(num_comps)
5124 integer, intent (out) :: comps_comm
5125
5126 integer :: i, j
5127 character(kind=c_char), target :: comp_names_cpy(YAC_MAX_CHARLEN+1, num_comps)
5128 type(c_ptr) :: comp_name_ptrs(num_comps)
5129
5130 comp_names_cpy = c_null_char
5131
5132 do i = 1, num_comps
5133 call yac_check_strlength(comp_names(i))
5134 do j = 1, len_trim(comp_names(i))
5135 comp_names_cpy(j,i) = comp_names(i)(j:j)
5136 end do
5137 comp_name_ptrs(i) = c_loc(comp_names_cpy(1,i))
5138 end do
5139
5140 call yac_cget_comps_comm_c ( comp_name_ptrs, &
5141 num_comps, &
5142 comps_comm )
5143
5144end subroutine yac_fget_comps_comm
5145
5146subroutine yac_fget_comps_comm_instance ( yac_instance_id, &
5147 comp_names, &
5148 num_comps, &
5149 comps_comm )
5150
5151 use, intrinsic :: iso_c_binding, only : c_null_char, c_ptr, c_loc, c_char
5154
5155 implicit none
5156
5157 interface
5158
5159 subroutine yac_cget_comps_comm_instance_c ( yac_instance_id, &
5160 comp_names, &
5161 num_comps, &
5162 comps_comm) &
5163 bind( c, name='yac_cget_comps_comm_instance_f2c' )
5164
5165 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
5167
5168 integer ( kind=c_int ), value :: yac_instance_id
5169 type ( c_ptr ) :: comp_names(*)
5170 integer ( kind=c_int ), value :: num_comps
5171 integer ( kind=YAC_MPI_FINT_KIND ) :: comps_comm
5172
5173 end subroutine yac_cget_comps_comm_instance_c
5174
5175 end interface
5176
5177 integer, intent(in) :: yac_instance_id
5178 integer, intent(in) :: num_comps
5179 character(kind=c_char, len=*), intent(in) :: &
5180 comp_names(num_comps)
5181 integer, intent (out) :: comps_comm
5182
5183 integer :: i, j
5184 character(kind=c_char), target :: comp_names_cpy(YAC_MAX_CHARLEN+1, num_comps)
5185 type(c_ptr) :: comp_name_ptrs(num_comps)
5186
5187 comp_names_cpy = c_null_char
5188
5189 do i = 1, num_comps
5190 call yac_check_strlength(comp_names(i))
5191 do j = 1, len_trim(comp_names(i))
5192 comp_names_cpy(j,i) = comp_names(i)(j:j)
5193 end do
5194 comp_name_ptrs(i) = c_loc(comp_names_cpy(1,i))
5195 end do
5196
5197 call yac_cget_comps_comm_instance_c ( yac_instance_id, &
5198 comp_name_ptrs, &
5199 num_comps, &
5200 comps_comm )
5201
5202end subroutine yac_fget_comps_comm_instance
5203
5204! ------------------- search/end of definition -------------------------
5205
5206subroutine yac_fsync_def ( )
5207
5208 use mo_yac_finterface, dummy => yac_fsync_def
5209
5210 implicit none
5211
5212 interface
5213
5214 subroutine yac_csync_def_c ( ) bind ( c, name='yac_csync_def' )
5215
5216 end subroutine yac_csync_def_c
5217
5218 end interface
5219
5220 call yac_csync_def_c ( )
5221
5222end subroutine yac_fsync_def
5223
5224subroutine yac_fsync_def_instance ( yac_instance_id )
5225
5227
5228 implicit none
5229
5230 interface
5231
5232 subroutine yac_csync_def_instance_c ( yac_instance_id ) &
5233 bind( c, name='yac_csync_def_instance' )
5234
5235 use, intrinsic :: iso_c_binding, only : c_int
5236
5237 integer ( kind=c_int ), value :: yac_instance_id
5238
5239 end subroutine yac_csync_def_instance_c
5240
5241 end interface
5242
5243 integer, intent(in) :: yac_instance_id
5244
5245 call yac_csync_def_instance_c ( yac_instance_id )
5246
5247end subroutine yac_fsync_def_instance
5248
5249
5250subroutine yac_fenddef ( )
5251
5252 use mo_yac_finterface, dummy => yac_fenddef
5253
5254 implicit none
5255
5256 interface
5257
5258 subroutine yac_cenddef_c ( ) bind ( c, name='yac_cenddef' )
5259
5260 end subroutine yac_cenddef_c
5261
5262 end interface
5263
5264 call yac_cenddef_c ( )
5265
5266end subroutine yac_fenddef
5267
5268subroutine yac_fenddef_instance ( yac_instance_id )
5269
5271
5272 implicit none
5273
5274 interface
5275
5276 subroutine yac_cenddef_instance_c ( yac_instance_id ) &
5277 bind( c, name='yac_cenddef_instance' )
5278
5279 use, intrinsic :: iso_c_binding, only : c_int
5280
5281 integer ( kind=c_int ), value :: yac_instance_id
5282
5283 end subroutine yac_cenddef_instance_c
5284
5285 end interface
5286
5287 integer, intent(in) :: yac_instance_id
5288
5289 call yac_cenddef_instance_c ( yac_instance_id )
5290
5291end subroutine yac_fenddef_instance
5292
5293subroutine yac_fenddef_and_emit_config(emit_flags, config)
5294
5295 use, intrinsic :: iso_c_binding, only : c_ptr
5298
5299 implicit none
5300
5301 interface
5302 subroutine yac_fenddef_and_emit_config_c ( &
5303 emit_flags, config) &
5304 bind( c, name='yac_cenddef_and_emit_config' )
5305
5306 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
5307 integer ( kind=c_int ), value :: emit_flags
5308 type(c_ptr) :: config
5309
5310 end subroutine yac_fenddef_and_emit_config_c
5311
5312 subroutine free_c ( ptr ) bind ( c, NAME='free' )
5313
5314 use, intrinsic :: iso_c_binding, only : c_ptr
5315
5316 type ( c_ptr ), intent(in), value :: ptr
5317
5318 end subroutine free_c
5319 end interface
5320
5321 integer, intent (in) :: emit_flags
5322 character (len=:), ALLOCATABLE :: config
5323
5324 type (c_ptr) :: c_string_ptr
5325
5326 call yac_fenddef_and_emit_config_c(emit_flags, c_string_ptr)
5327 config = yac_internal_cptr2char(c_string_ptr)
5328 call free_c(c_string_ptr)
5329
5330end subroutine yac_fenddef_and_emit_config
5331
5333 yac_instance_id, emit_flags, config)
5334
5335 use, intrinsic :: iso_c_binding, only : c_ptr
5338
5339 implicit none
5340
5341 interface
5342 subroutine yac_fenddef_and_emit_config_instance_c ( &
5343 yac_instance_id, emit_flags, config) &
5344 bind( c, name='yac_cenddef_and_emit_config_instance' )
5345
5346 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
5347 integer ( kind=c_int ), value :: yac_instance_id
5348 integer ( kind=c_int ), value :: emit_flags
5349 type(c_ptr) :: config
5350
5351 end subroutine yac_fenddef_and_emit_config_instance_c
5352
5353 subroutine free_c ( ptr ) bind ( c, NAME='free' )
5354
5355 use, intrinsic :: iso_c_binding, only : c_ptr
5356
5357 type ( c_ptr ), intent(in), value :: ptr
5358
5359 end subroutine free_c
5360 end interface
5361
5362 integer, intent (in) :: yac_instance_id
5363 integer, intent (in) :: emit_flags
5364 character (len=:), ALLOCATABLE :: config
5365
5366 type (c_ptr) :: c_string_ptr
5367
5368 call yac_fenddef_and_emit_config_instance_c( &
5369 yac_instance_id, emit_flags, c_string_ptr)
5370 config = yac_internal_cptr2char(c_string_ptr)
5371 call free_c(c_string_ptr)
5372
5374
5375! ------------------------ query routines -----------------------------
5376
5377 function yac_fget_comp_names ( ) result( comp_names )
5378
5381
5382 use, intrinsic :: iso_c_binding, only: c_ptr
5383 implicit none
5384
5385 interface
5386 function yac_cget_nbr_comps_c() result( nbr_comps ) &
5387 bind(c, name='yac_cget_nbr_comps')
5388 use, intrinsic :: iso_c_binding, only: c_int
5389 integer(kind=c_int) :: nbr_comps
5390
5391 end function yac_cget_nbr_comps_c
5392
5393 subroutine yac_cget_comp_names_c( nbr_comps, comp_names ) &
5394 bind(c, name='yac_cget_comp_names')
5395 use, intrinsic :: iso_c_binding, only: c_int, c_ptr
5396 integer(kind=c_int), intent(in), value :: nbr_comps
5397 TYPE(c_ptr), intent(out) :: comp_names(nbr_comps)
5398 end subroutine yac_cget_comp_names_c
5399 end interface
5400
5401 type(yac_string), allocatable :: comp_names(:)
5402 integer :: nbr_comps
5403 INTEGER :: i
5404 TYPE(c_ptr), allocatable :: comp_ptr(:)
5405
5406 nbr_comps = yac_cget_nbr_comps_c()
5407 allocate(comp_ptr(nbr_comps))
5408 allocate(comp_names(nbr_comps))
5409 CALL yac_cget_comp_names_c(nbr_comps, comp_ptr)
5410 DO i=1,nbr_comps
5411 comp_names(i)%string = yac_internal_cptr2char(comp_ptr(i))
5412 END DO
5413 end function yac_fget_comp_names
5414
5415 function yac_fget_comp_names_instance ( yac_instance_id ) result ( comp_names )
5416
5419 use, intrinsic :: iso_c_binding, only: c_ptr
5420 implicit none
5421
5422 interface
5423 function yac_cget_nbr_comps_instance_c( yac_instance_id ) &
5424 result( nbr_comps ) &
5425 bind(c, name='yac_cget_nbr_comps_instance')
5426 use, intrinsic :: iso_c_binding, only: c_int
5427 integer(kind=c_int), value, intent(in) :: yac_instance_id
5428 integer(kind=c_int) :: nbr_comps
5429 end function yac_cget_nbr_comps_instance_c
5430
5431 subroutine yac_cget_comp_names_instance_c( yac_instance_id, &
5432 nbr_comps, &
5433 comp_names ) &
5434 bind(c, name='yac_cget_comp_names_instance')
5435 use, intrinsic :: iso_c_binding, only: c_int, c_ptr
5436 integer(kind=c_int), intent(in), value :: yac_instance_id
5437 integer(kind=c_int), intent(in), value :: nbr_comps
5438 TYPE(c_ptr), intent(out) :: comp_names(nbr_comps)
5439 end subroutine yac_cget_comp_names_instance_c
5440 end interface
5441
5442 integer, intent(in) :: yac_instance_id
5443 type(yac_string), allocatable :: comp_names(:)
5444 integer :: nbr_comps
5445 INTEGER :: i
5446 TYPE(c_ptr), allocatable :: comp_ptr(:)
5447
5448 nbr_comps = yac_cget_nbr_comps_instance_c(yac_instance_id)
5449 allocate(comp_names(nbr_comps))
5450 allocate(comp_ptr(nbr_comps))
5451 CALL yac_cget_comp_names_instance_c(yac_instance_id, &
5452 nbr_comps, &
5453 comp_ptr)
5454 DO i=1,nbr_comps
5455 comp_names(i)%string = yac_internal_cptr2char(comp_ptr(i))
5456 END DO
5457 end function yac_fget_comp_names_instance
5458
5459! ---------------------------------------------------------------------
5460
5461 function yac_fget_grid_names ( ) result ( grid_names )
5462
5465 use, intrinsic :: iso_c_binding, only: c_ptr
5466
5467 implicit none
5468
5469 interface
5470 function yac_cget_nbr_grids_c() result( nbr_grids ) &
5471 bind(c, name='yac_cget_nbr_grids')
5472 use, intrinsic :: iso_c_binding, only: c_int
5473 integer(kind=c_int) :: nbr_grids
5474 end function yac_cget_nbr_grids_c
5475
5476 subroutine yac_cget_grid_names_c( nbr_grids, grid_names ) &
5477 bind(c, name='yac_cget_grid_names')
5478 use, intrinsic :: iso_c_binding, only: c_int, c_ptr
5479 integer(kind=c_int), intent(in), value :: nbr_grids
5480 TYPE(c_ptr), intent(out) :: grid_names(nbr_grids)
5481 end subroutine yac_cget_grid_names_c
5482 end interface
5483
5484 type(yac_string), allocatable :: grid_names(:)
5485 integer :: nbr_grids
5486 INTEGER :: i
5487 TYPE(c_ptr), allocatable :: grid_ptr(:)
5488
5489 nbr_grids = yac_cget_nbr_grids_c()
5490 allocate(grid_ptr(nbr_grids))
5491 CALL yac_cget_grid_names_c(nbr_grids, grid_ptr)
5492 allocate(grid_names(nbr_grids))
5493 DO i=1,nbr_grids
5494 grid_names(i)%string = yac_internal_cptr2char(grid_ptr(i))
5495 END DO
5496 end function yac_fget_grid_names
5497
5498 function yac_fget_grid_names_instance ( yac_instance_id ) result ( grid_names )
5499
5502 use, intrinsic :: iso_c_binding, only: c_ptr
5503
5504 implicit none
5505
5506 interface
5507 function yac_cget_nbr_grids_instance_c( yac_instance_id ) &
5508 result( nbr_grids ) &
5509 bind(c, name='yac_cget_nbr_grids_instance')
5510 use, intrinsic :: iso_c_binding, only: c_int
5511 integer(kind=c_int), value, intent(in) :: yac_instance_id
5512 integer(kind=c_int) :: nbr_grids
5513
5514 end function yac_cget_nbr_grids_instance_c
5515
5516 subroutine yac_cget_grid_names_instance_c( yac_instance_id, &
5517 nbr_grids, &
5518 grid_names ) &
5519 bind(c, name='yac_cget_grid_names_instance')
5520 use, intrinsic :: iso_c_binding, only: c_int, c_ptr
5521 integer(kind=c_int), intent(in), value :: yac_instance_id
5522 integer(kind=c_int), intent(in), value :: nbr_grids
5523 TYPE(c_ptr), intent(out) :: grid_names(nbr_grids)
5524 end subroutine yac_cget_grid_names_instance_c
5525 end interface
5526
5527 integer, intent(in) :: yac_instance_id
5528 type(yac_string), allocatable :: grid_names(:)
5529 integer :: nbr_grids
5530 INTEGER :: i
5531 TYPE(c_ptr), allocatable :: grid_ptr(:)
5532
5533 nbr_grids = yac_cget_nbr_grids_instance_c(yac_instance_id)
5534 allocate(grid_ptr(nbr_grids))
5535 CALL yac_cget_grid_names_instance_c(yac_instance_id, &
5536 nbr_grids, &
5537 grid_ptr)
5538 allocate(grid_names(nbr_grids))
5539 DO i=1,nbr_grids
5540 grid_names(i)%string = yac_internal_cptr2char(grid_ptr(i))
5541 END DO
5542 end function yac_fget_grid_names_instance
5543
5544 ! ---------------------------------------------------------------------
5545
5546 function yac_fget_comp_grid_names ( comp_name ) result ( grid_names )
5547
5550 use, intrinsic :: iso_c_binding, only: c_ptr, c_null_char
5551
5552 implicit none
5553
5554 interface
5555 function yac_cget_comp_nbr_grids_c( comp_name ) result( nbr_grids ) &
5556 bind(c, name='yac_cget_comp_nbr_grids')
5557 use, intrinsic :: iso_c_binding, only: c_int, c_char
5558 character(kind=c_char), dimension(*), intent(in) :: comp_name
5559 integer(kind=c_int) :: nbr_grids
5560
5561 end function yac_cget_comp_nbr_grids_c
5562
5563 subroutine yac_cget_comp_grid_names_c( comp_name, &
5564 nbr_grids, &
5565 grid_names ) &
5566 bind(c, name='yac_cget_comp_grid_names')
5567 use, intrinsic :: iso_c_binding, only: c_int, c_ptr, c_char
5568 character(kind=c_char), dimension(*), intent(in) :: comp_name
5569 integer(kind=c_int), intent(in), value :: nbr_grids
5570 TYPE(c_ptr), intent(out) :: grid_names(nbr_grids)
5571 end subroutine yac_cget_comp_grid_names_c
5572 end interface
5573
5574 type(yac_string), allocatable :: grid_names(:)
5575 CHARACTER(len=*), intent(in) :: comp_name
5576 integer :: nbr_grids
5577 INTEGER :: i
5578 TYPE(c_ptr), allocatable :: grid_ptr(:)
5579
5580 nbr_grids = yac_cget_comp_nbr_grids_c(trim(comp_name) // c_null_char)
5581 allocate(grid_ptr(nbr_grids))
5582 CALL yac_cget_comp_grid_names_c(trim(comp_name) // c_null_char, &
5583 nbr_grids, &
5584 grid_ptr)
5585 allocate(grid_names(nbr_grids))
5586 DO i=1,nbr_grids
5587 grid_names(i)%string = yac_internal_cptr2char(grid_ptr(i))
5588 END DO
5589 end function yac_fget_comp_grid_names
5590
5591 function yac_fget_comp_grid_names_instance ( yac_instance_id, comp_name) result ( grid_names )
5592
5595 use, intrinsic :: iso_c_binding, only: c_ptr, c_null_char
5596
5597 implicit none
5598
5599 interface
5600 function yac_cget_comp_nbr_grids_instance_c( yac_instance_id, &
5601 comp_name ) &
5602 result( nbr_grids ) &
5603 bind(c, name='yac_cget_comp_nbr_grids_instance')
5604 use, intrinsic :: iso_c_binding, only: c_int, c_char
5605 character(kind=c_char), dimension(*), intent(in) :: comp_name
5606 integer(kind=c_int), value, intent(in) :: yac_instance_id
5607 integer(kind=c_int) :: nbr_grids
5608 end function yac_cget_comp_nbr_grids_instance_c
5609
5610 subroutine yac_cget_comp_grid_names_instance_c( yac_instance_id, &
5611 comp_name, &
5612 nbr_grids, &
5613 grid_names ) &
5614 bind(c, name='yac_cget_comp_grid_names_instance')
5615 use, intrinsic :: iso_c_binding, only: c_int, c_ptr, c_char
5616 character(kind=c_char), dimension(*), intent(in) :: comp_name
5617 integer(kind=c_int), intent(in), value :: yac_instance_id
5618 integer(kind=c_int), intent(in), value :: nbr_grids
5619 TYPE(c_ptr), intent(out) :: grid_names(nbr_grids)
5620 end subroutine yac_cget_comp_grid_names_instance_c
5621 end interface
5622
5623 integer, intent(in) :: yac_instance_id
5624 character(len=*), intent(in) :: comp_name
5625 type(yac_string), allocatable :: grid_names(:)
5626 integer :: nbr_grids
5627 INTEGER :: i
5628 TYPE(c_ptr), allocatable :: grid_ptr(:)
5629
5630 nbr_grids = &
5631 yac_cget_comp_nbr_grids_instance_c(yac_instance_id, &
5632 trim(comp_name) // c_null_char)
5633 allocate(grid_ptr(nbr_grids))
5634 CALL yac_cget_comp_grid_names_instance_c(yac_instance_id, &
5635 trim(comp_name) // c_null_char, &
5636 nbr_grids, &
5637 grid_ptr)
5638 allocate(grid_names(nbr_grids))
5639 DO i=1,nbr_grids
5640 grid_names(i)%string = yac_internal_cptr2char(grid_ptr(i))
5641 END DO
5643
5644 ! ---------------------------------------------------------------------
5645
5646 function yac_fget_field_names ( comp_name, grid_name ) result( field_names )
5647
5650 use, intrinsic :: iso_c_binding, only: c_ptr, c_null_char
5651
5652 implicit none
5653
5654 interface
5655 function yac_cget_nbr_fields_c(comp_name, grid_name) &
5656 result( nbr_fields ) &
5657 bind(c, name='yac_cget_nbr_fields')
5658 use, intrinsic :: iso_c_binding, only: c_int, c_char
5659 character(kind=c_char), dimension(*), intent(in) :: comp_name
5660 character(kind=c_char), dimension(*), intent(in) :: grid_name
5661 integer(kind=c_int) :: nbr_fields
5662 end function yac_cget_nbr_fields_c
5663
5664 subroutine yac_cget_field_names_c( comp_name, &
5665 grid_name, &
5666 nbr_fields, &
5667 field_names ) &
5668 bind(c, name='yac_cget_field_names')
5669 use, intrinsic :: iso_c_binding, only: c_int, c_ptr, c_char
5670 character(kind=c_char), dimension(*), intent(in) :: comp_name
5671 character(kind=c_char), dimension(*), intent(in) :: grid_name
5672 integer(kind=c_int), intent(in), value :: nbr_fields
5673 TYPE(c_ptr), intent(out) :: field_names(nbr_fields)
5674 end subroutine yac_cget_field_names_c
5675 end interface
5676
5677 character(len=*), intent(in) :: comp_name
5678 character(len=*), intent(in) :: grid_name
5679 type(yac_string), allocatable :: field_names(:)
5680 integer :: nbr_fields
5681 INTEGER :: i
5682 TYPE(c_ptr), allocatable :: field_ptr(:)
5683
5684 nbr_fields = yac_cget_nbr_fields_c(trim(comp_name)//c_null_char, &
5685 trim(grid_name)//c_null_char)
5686 allocate(field_ptr(nbr_fields))
5687 CALL yac_cget_field_names_c(trim(comp_name)//c_null_char, &
5688 trim(grid_name)//c_null_char, &
5689 nbr_fields, &
5690 field_ptr)
5691 allocate(field_names(nbr_fields))
5692 DO i=1,nbr_fields
5693 field_names(i)%string = yac_internal_cptr2char(field_ptr(i))
5694 END DO
5695 end function yac_fget_field_names
5696
5697 function yac_fget_field_names_instance ( yac_instance_id, &
5698 comp_name, &
5699 grid_name ) &
5700 result( field_names )
5701
5704 use, intrinsic :: iso_c_binding, only: c_ptr, c_null_char
5705
5706 implicit none
5707
5708 interface
5709 function yac_cget_nbr_fields_instance_c( yac_instance_id, &
5710 comp_name, &
5711 grid_name ) &
5712 result( nbr_fields ) bind(c, name='yac_cget_nbr_fields_instance')
5713 use, intrinsic :: iso_c_binding, only: c_int, c_char
5714 integer(kind=c_int), value, intent(in) :: yac_instance_id
5715 character(kind=c_char), dimension(*), intent(in) :: comp_name
5716 character(kind=c_char), dimension(*), intent(in) :: grid_name
5717 integer(kind=c_int) :: nbr_fields
5718 end function yac_cget_nbr_fields_instance_c
5719
5720 subroutine yac_cget_field_names_instance_c( yac_instance_id, &
5721 comp_name, &
5722 grid_name, &
5723 nbr_fields, &
5724 field_names ) &
5725 bind(c, name='yac_cget_field_names_instance')
5726 use, intrinsic :: iso_c_binding, only: c_int, c_ptr, c_char
5727 integer(kind=c_int), intent(in), value :: yac_instance_id
5728 character(kind=c_char), dimension(*), intent(in) :: comp_name
5729 character(kind=c_char), dimension(*), intent(in) :: grid_name
5730 integer(kind=c_int), intent(in), value :: nbr_fields
5731 TYPE(c_ptr), intent(out) :: field_names(nbr_fields)
5732 end subroutine yac_cget_field_names_instance_c
5733 end interface
5734
5735 integer, intent(in) :: yac_instance_id
5736 character(len=*), intent(in) :: comp_name
5737 character(len=*), intent(in) :: grid_name
5738 type(yac_string), allocatable :: field_names(:)
5739 integer :: nbr_fields
5740 INTEGER :: i
5741 TYPE(c_ptr), allocatable :: field_ptr(:)
5742
5743 nbr_fields = &
5744 yac_cget_nbr_fields_instance_c(yac_instance_id, &
5745 trim(comp_name)//c_null_char, &
5746 trim(grid_name)//c_null_char)
5747 allocate(field_ptr(nbr_fields))
5748 CALL yac_cget_field_names_instance_c(yac_instance_id, &
5749 trim(comp_name)//c_null_char, &
5750 trim(grid_name)//c_null_char, &
5751 nbr_fields, &
5752 field_ptr)
5753 allocate(field_names(nbr_fields))
5754 DO i=1,nbr_fields
5755 field_names(i)%string = yac_internal_cptr2char(field_ptr(i))
5756 END DO
5758
5759! ---------------------------------------------------------------------
5760
5761function yac_fget_field_id ( comp_name, grid_name, field_name ) &
5762 result(field_id)
5763
5765 use, intrinsic :: iso_c_binding, only : c_null_char
5766
5767 implicit none
5768
5769 interface
5770
5771 function yac_cget_field_id_c ( comp_name, grid_name, field_name ) &
5772 result(field_id) &
5773 bind( c, name='yac_cget_field_id' )
5774
5775 use, intrinsic :: iso_c_binding, only : c_int, c_char
5776
5777 character ( kind=c_char ), dimension(*) :: comp_name
5778 character ( kind=c_char ), dimension(*) :: grid_name
5779 character ( kind=c_char ), dimension(*) :: field_name
5780 integer ( kind=c_int ) :: field_id
5781
5782 end function yac_cget_field_id_c
5783
5784 end interface
5785
5786 character(len=*), intent (in) :: comp_name
5787 character(len=*), intent (in) :: grid_name
5788 character(len=*), intent (in) :: field_name
5789 integer :: field_id
5790
5791 field_id = yac_cget_field_id_c( trim(comp_name)//c_null_char, &
5792 trim(grid_name)//c_null_char, &
5793 trim(field_name)//c_null_char )
5794
5795end function yac_fget_field_id
5796
5797function yac_fget_field_id_instance ( yac_id, &
5798 comp_name, &
5799 grid_name, &
5800 field_name ) &
5801 result(field_id)
5802
5804 use, intrinsic :: iso_c_binding, only : c_null_char
5805
5806 implicit none
5807
5808 interface
5809
5810 function yac_cget_field_id_instance_c ( yac_id, &
5811 comp_name, &
5812 grid_name, &
5813 field_name ) &
5814 result(field_id) &
5815 bind( c, name='yac_cget_field_id_instance' )
5816
5817 use, intrinsic :: iso_c_binding, only : c_int, c_char
5818
5819 integer( kind=c_int ), value, intent(in) :: yac_id
5820 character ( kind=c_char ), dimension(*) :: comp_name
5821 character ( kind=c_char ), dimension(*) :: grid_name
5822 character ( kind=c_char ), dimension(*) :: field_name
5823 integer ( kind=c_int ) :: field_id
5824
5825 end function yac_cget_field_id_instance_c
5826
5827 end interface
5828
5829 integer, intent(in) :: yac_id
5830 character(len=*), intent (in) :: comp_name
5831 character(len=*), intent (in) :: grid_name
5832 character(len=*), intent (in) :: field_name
5833 integer :: field_id
5834
5835 field_id = &
5836 yac_cget_field_id_instance_c( yac_id, &
5837 trim(comp_name)//c_null_char, &
5838 trim(grid_name)//c_null_char, &
5839 trim(field_name)//c_null_char )
5840
5841end function yac_fget_field_id_instance
5842
5843! ---------------------------------------------------------------------
5844
5845subroutine yac_fget_action ( field_id, action )
5846
5848
5849 implicit none
5850
5851 interface
5852
5853 subroutine yac_cget_action_c ( field_id, action ) &
5854 bind( c, name='yac_cget_action' )
5855
5856 use, intrinsic :: iso_c_binding, only : c_int
5857
5858 integer ( kind=c_int ), value :: field_id
5859 integer ( kind=c_int) :: action
5860
5861 end subroutine yac_cget_action_c
5862
5863 end interface
5864
5865 integer, intent (in) :: field_id
5866 integer, intent (out) :: action
5872
5873 call yac_cget_action_c(field_id, action)
5874
5875end subroutine yac_fget_action
5876
5877! ---------------------------------------------------------------------
5878
5879subroutine yac_fupdate ( field_id )
5880
5881 use mo_yac_finterface, dummy => yac_fupdate
5882
5883 implicit none
5884
5885 interface
5886
5887 subroutine yac_cupdate_c ( field_id ) &
5888 bind( c, name='yac_cupdate' )
5889
5890 use, intrinsic :: iso_c_binding, only : c_int
5891
5892 integer ( kind=c_int ), value :: field_id
5893
5894 end subroutine yac_cupdate_c
5895
5896 end interface
5897
5898 integer, intent (in) :: field_id
5899
5900 call yac_cupdate_c(field_id)
5901
5902end subroutine yac_fupdate
5903
5904subroutine yac_fdef_couple( src_comp_name, src_grid_name, src_field_name, &
5905 tgt_comp_name, tgt_grid_name, tgt_field_name, &
5906 coupling_timestep, time_unit, time_reduction, interp_stack_config_id, &
5907 src_lag, tgt_lag, weight_file, mapping_side, scale_factor, scale_summand, &
5908 src_mask_names, tgt_mask_name)
5909
5910 use, intrinsic :: iso_c_binding, only : c_null_char, c_ptr, c_null_ptr, c_loc
5913
5914 implicit none
5915
5916 interface
5917
5918 subroutine yac_cdef_couple__c( src_comp_name, &
5919 src_grid_name, &
5920 src_field_name, &
5921 tgt_comp_name, &
5922 tgt_grid_name, &
5923 tgt_field_name, &
5924 coupling_timestep, &
5925 time_unit, &
5926 time_reduction, &
5927 interp_stack_config_id, &
5928 src_lag, &
5929 tgt_lag, &
5930 weight_file, &
5931 mapping_side, &
5932 scale_factor, &
5933 scale_summand, &
5934 num_src_mask_names, &
5935 src_mask_names, &
5936 tgt_mask_name) &
5937 bind( c, name='yac_cdef_couple_' )
5938
5939 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_ptr, c_double
5940
5941 character ( kind=c_char ), dimension(*) :: src_comp_name
5942 character ( kind=c_char ), dimension(*) :: src_grid_name
5943 character ( kind=c_char ), dimension(*) :: src_field_name
5944 character ( kind=c_char ), dimension(*) :: tgt_comp_name
5945 character ( kind=c_char ), dimension(*) :: tgt_grid_name
5946 character ( kind=c_char ), dimension(*) :: tgt_field_name
5947 character ( kind=c_char ), dimension(*) :: coupling_timestep
5948 integer ( kind=c_int ), value :: time_unit
5949 integer ( kind=c_int ), value :: time_reduction
5950 integer ( kind=c_int ), value :: interp_stack_config_id
5951 integer ( kind=c_int ), value :: src_lag
5952 integer ( kind=c_int ), value :: tgt_lag
5953 type ( c_ptr ), value :: weight_file
5954 integer ( kind=c_int ), value :: mapping_side
5955 real ( kind=c_double ), value :: scale_factor
5956 real ( kind=c_double ), value :: scale_summand
5957 integer ( kind=c_int ), value :: num_src_mask_names
5958 type ( c_ptr ) :: src_mask_names(*)
5959 type ( c_ptr ), value :: tgt_mask_name
5960 end subroutine yac_cdef_couple__c
5961
5962 end interface
5963
5964 character ( len=* ), intent(in) :: src_comp_name
5965 character ( len=* ), intent(in) :: src_grid_name
5966 character ( len=* ), intent(in) :: src_field_name
5967 character ( len=* ), intent(in) :: tgt_comp_name
5968 character ( len=* ), intent(in) :: tgt_grid_name
5969 character ( len=* ), intent(in) :: tgt_field_name
5970 character ( len=* ), intent(in) :: coupling_timestep
5971 integer, intent(in) :: time_unit
5972 integer, intent(in) :: time_reduction
5973 integer, intent(in) :: interp_stack_config_id
5974 integer, intent(in), optional :: src_lag
5975 integer, intent(in), optional :: tgt_lag
5976 character ( len=* ), intent(in), optional :: weight_file
5977 integer, intent(in), optional :: mapping_side
5978 double precision, intent(in), optional :: scale_factor
5979 double precision, intent(in), optional :: scale_summand
5980 type(yac_string), intent(in), optional :: src_mask_names(:)
5981 character ( len=* ), intent(in), optional :: tgt_mask_name
5982
5983 integer :: i, j
5984 integer :: src_lag_cpy, tgt_lag_cpy, mapping_side_cpy
5985 character(kind=c_char), target :: weight_file_cpy(YAC_MAX_CHARLEN+1)
5986 type(c_ptr) :: weight_file_ptr
5987 double precision :: scale_factor_cpy, scale_summand_cpy
5988 integer :: num_src_mask_names
5989 character(kind=c_char), allocatable, target :: src_mask_names_cpy(:,:)
5990 type(c_ptr), allocatable :: src_mask_names_ptr(:)
5991 character(kind=c_char), target :: tgt_mask_name_cpy(YAC_MAX_CHARLEN+1)
5992 type(c_ptr) :: tgt_mask_name_ptr
5993
5994 call yac_check_strlength ( src_comp_name )
5995 call yac_check_strlength ( src_grid_name )
5996 call yac_check_strlength ( src_field_name )
5997 call yac_check_strlength ( tgt_comp_name )
5998 call yac_check_strlength ( tgt_grid_name )
5999 call yac_check_strlength ( tgt_field_name )
6000 call yac_check_strlength ( coupling_timestep )
6001 if ( present(src_lag) ) then
6002 src_lag_cpy = src_lag
6003 else
6004 src_lag_cpy = 0
6005 end if
6006 if ( present(tgt_lag) ) then
6007 tgt_lag_cpy = tgt_lag
6008 else
6009 tgt_lag_cpy = 0
6010 end if
6011 if ( present(weight_file) ) then
6012 call yac_check_strlength ( weight_file )
6013 weight_file_cpy = c_null_char
6014 do i = 1, len_trim(weight_file)
6015 weight_file_cpy(i) = weight_file(i:i)
6016 end do
6017 weight_file_ptr = c_loc(weight_file_cpy(1))
6018 else
6019 weight_file_ptr = c_null_ptr
6020 end if
6021 if ( present(mapping_side) ) then
6022 mapping_side_cpy = mapping_side
6023 else
6024 mapping_side_cpy = 1
6025 end if
6026 if ( present(scale_factor) ) then
6027 scale_factor_cpy = scale_factor
6028 else
6029 scale_factor_cpy = 1.0
6030 end if
6031 if ( present(scale_summand) ) then
6032 scale_summand_cpy = scale_summand
6033 else
6034 scale_summand_cpy = 0.0
6035 end if
6036 if ( present(src_mask_names) ) then
6037 num_src_mask_names = size(src_mask_names)
6038 allocate(src_mask_names_ptr(num_src_mask_names))
6039 allocate(src_mask_names_cpy(yac_max_charlen+1,num_src_mask_names))
6040 src_mask_names_cpy = c_null_char
6041 do i = 1, num_src_mask_names
6042 yac_fassert(allocated(src_mask_names(i)%string), "ERROR(yac_fdef_couple): source mask name not allocated")
6043 call yac_check_strlength ( src_mask_names(i)%string )
6044 do j = 1, len_trim(src_mask_names(i)%string)
6045 src_mask_names_cpy(j, i) = src_mask_names(i)%string(j:j)
6046 end do
6047 src_mask_names_ptr(i) = c_loc(src_mask_names_cpy(1,i))
6048 end do
6049 else
6050 num_src_mask_names = 0
6051 allocate(src_mask_names_ptr(0))
6052 end if
6053 if ( present(tgt_mask_name) ) then
6054 call yac_check_strlength ( tgt_mask_name )
6055 tgt_mask_name_cpy = c_null_char
6056 do i = 1, len_trim(tgt_mask_name)
6057 tgt_mask_name_cpy(i) = tgt_mask_name(i:i)
6058 end do
6059 tgt_mask_name_ptr = c_loc(tgt_mask_name_cpy(1))
6060 else
6061 tgt_mask_name_ptr = c_null_ptr
6062 end if
6063
6064 call yac_cdef_couple__c( trim(src_comp_name) // c_null_char, &
6065 trim(src_grid_name) // c_null_char, &
6066 trim(src_field_name) // c_null_char, &
6067 trim(tgt_comp_name) // c_null_char, &
6068 trim(tgt_grid_name) // c_null_char, &
6069 trim(tgt_field_name) // c_null_char, &
6070 trim(coupling_timestep) // c_null_char, &
6071 time_unit, &
6072 time_reduction, &
6073 interp_stack_config_id, &
6074 src_lag_cpy, &
6075 tgt_lag_cpy, &
6076 weight_file_ptr, &
6077 mapping_side_cpy, &
6078 scale_factor_cpy, &
6079 scale_summand_cpy, &
6080 num_src_mask_names, &
6081 src_mask_names_ptr, &
6082 tgt_mask_name_ptr)
6083
6084end subroutine yac_fdef_couple
6085
6086subroutine yac_fdef_couple_instance( instance_id, &
6087 src_comp_name, src_grid_name, src_field_name, &
6088 tgt_comp_name, tgt_grid_name, tgt_field_name, &
6089 coupling_timestep, time_unit, time_reduction, &
6090 interp_stack_config_id, src_lag, tgt_lag, &
6091 weight_file, mapping_side, scale_factor, &
6092 scale_summand, src_mask_names, tgt_mask_name )
6093
6094 use, intrinsic :: iso_c_binding, only : c_null_char, c_ptr, c_null_ptr, c_loc
6097
6098 implicit none
6099
6100 interface
6101
6102 subroutine yac_cdef_couple_instance__c( instance_id, &
6103 src_comp_name, &
6104 src_grid_name, &
6105 src_field_name, &
6106 tgt_comp_name, &
6107 tgt_grid_name, &
6108 tgt_field_name, &
6109 coupling_timestep, &
6110 time_unit, &
6111 time_reduction, &
6112 interp_stack_config_id, &
6113 src_lag, &
6114 tgt_lag, &
6115 weight_file, &
6116 mapping_side, &
6117 scale_factor, &
6118 scale_summand, &
6119 num_src_mask_names, &
6120 src_mask_names, &
6121 tgt_mask_name) &
6122 bind( c, name='yac_cdef_couple_instance_' )
6123
6124 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_ptr, c_double
6125
6126 integer ( kind=c_int ), value :: instance_id
6127 character ( kind=c_char ), dimension(*) :: src_comp_name
6128 character ( kind=c_char ), dimension(*) :: src_grid_name
6129 character ( kind=c_char ), dimension(*) :: src_field_name
6130 character ( kind=c_char ), dimension(*) :: tgt_comp_name
6131 character ( kind=c_char ), dimension(*) :: tgt_grid_name
6132 character ( kind=c_char ), dimension(*) :: tgt_field_name
6133 character ( kind=c_char ), dimension(*) :: coupling_timestep
6134 integer ( kind=c_int ), value :: time_unit
6135 integer ( kind=c_int ), value :: time_reduction
6136 integer ( kind=c_int ), value :: interp_stack_config_id
6137 integer ( kind=c_int ), value :: src_lag
6138 integer ( kind=c_int ), value :: tgt_lag
6139 type ( c_ptr ), value :: weight_file
6140 integer ( kind=c_int ), value :: mapping_side
6141 real ( kind=c_double ), value :: scale_factor
6142 real ( kind=c_double ), value :: scale_summand
6143 integer ( kind=c_int ), value :: num_src_mask_names
6144 type ( c_ptr ) :: src_mask_names(*)
6145 type ( c_ptr ), value :: tgt_mask_name
6146 end subroutine yac_cdef_couple_instance__c
6147
6148 end interface
6149
6150 integer, intent(in) :: instance_id
6151 character ( len=* ), intent(in) :: src_comp_name
6152 character ( len=* ), intent(in) :: src_grid_name
6153 character ( len=* ), intent(in) :: src_field_name
6154 character ( len=* ), intent(in) :: tgt_comp_name
6155 character ( len=* ), intent(in) :: tgt_grid_name
6156 character ( len=* ), intent(in) :: tgt_field_name
6157 character ( len=* ), intent(in) :: coupling_timestep
6158 integer, intent(in) :: time_unit
6159 integer, intent(in) :: time_reduction
6160 integer, intent(in) :: interp_stack_config_id
6161 integer, intent(in), optional :: src_lag
6162 integer, intent(in), optional :: tgt_lag
6163 character ( len=* ), intent(in), optional :: weight_file
6164 integer, intent(in), optional :: mapping_side
6165 double precision, intent(in), optional :: scale_factor
6166 double precision, intent(in), optional :: scale_summand
6167 type(yac_string), intent(in), optional :: src_mask_names(:)
6168 character ( len=* ), intent(in), optional :: tgt_mask_name
6169
6170 integer :: i, j
6171 integer :: src_lag_cpy, tgt_lag_cpy, mapping_side_cpy
6172 character(kind=c_char), target :: weight_file_cpy(YAC_MAX_CHARLEN+1)
6173 type(c_ptr) :: weight_file_ptr
6174 double precision :: scale_factor_cpy, scale_summand_cpy
6175 integer :: num_src_mask_names
6176 character(kind=c_char), allocatable, target :: src_mask_names_cpy(:,:)
6177 type(c_ptr), allocatable :: src_mask_names_ptr(:)
6178 character(kind=c_char), target :: tgt_mask_name_cpy(YAC_MAX_CHARLEN+1)
6179 type(c_ptr) :: tgt_mask_name_ptr
6180
6181 call yac_check_strlength ( src_comp_name )
6182 call yac_check_strlength ( src_grid_name )
6183 call yac_check_strlength ( src_field_name )
6184 call yac_check_strlength ( tgt_comp_name )
6185 call yac_check_strlength ( tgt_grid_name )
6186 call yac_check_strlength ( tgt_field_name )
6187 call yac_check_strlength ( coupling_timestep )
6188 if ( present(src_lag) ) then
6189 src_lag_cpy = src_lag
6190 else
6191 src_lag_cpy = 0
6192 end if
6193 if ( present(tgt_lag) ) then
6194 tgt_lag_cpy = tgt_lag
6195 else
6196 tgt_lag_cpy = 0
6197 end if
6198 if ( present(weight_file) ) then
6199 call yac_check_strlength ( weight_file )
6200 weight_file_cpy = c_null_char
6201 do i = 1, len_trim(weight_file)
6202 weight_file_cpy(i) = weight_file(i:i)
6203 end do
6204 weight_file_ptr = c_loc(weight_file_cpy(1))
6205 else
6206 weight_file_ptr = c_null_ptr
6207 end if
6208 if ( present(mapping_side) ) then
6209 mapping_side_cpy = mapping_side
6210 else
6211 mapping_side_cpy = 1
6212 end if
6213 if ( present(scale_factor) ) then
6214 scale_factor_cpy = scale_factor
6215 else
6216 scale_factor_cpy = 1.0
6217 end if
6218 if ( present(scale_summand) ) then
6219 scale_summand_cpy = scale_summand
6220 else
6221 scale_summand_cpy = 0.0
6222 end if
6223 if ( present(src_mask_names) ) then
6224 num_src_mask_names = size(src_mask_names)
6225 allocate(src_mask_names_ptr(num_src_mask_names))
6226 allocate(src_mask_names_cpy(yac_max_charlen+1,num_src_mask_names))
6227 src_mask_names_cpy = c_null_char
6228 do i = 1, num_src_mask_names
6229 yac_fassert(allocated(src_mask_names(i)%string), "ERROR(yac_fdef_couple): source mask name not allocated")
6230 call yac_check_strlength ( src_mask_names(i)%string )
6231 do j = 1, len_trim(src_mask_names(i)%string)
6232 src_mask_names_cpy(j, i) = src_mask_names(i)%string(j:j)
6233 end do
6234 src_mask_names_ptr(i) = c_loc(src_mask_names_cpy(1,i))
6235 end do
6236 else
6237 num_src_mask_names = 0
6238 allocate(src_mask_names_ptr(0))
6239 end if
6240 if ( present(tgt_mask_name) ) then
6241 call yac_check_strlength ( tgt_mask_name )
6242 tgt_mask_name_cpy = c_null_char
6243 do i = 1, len_trim(tgt_mask_name)
6244 tgt_mask_name_cpy(i) = tgt_mask_name(i:i)
6245 end do
6246 tgt_mask_name_ptr = c_loc(tgt_mask_name_cpy(1))
6247 else
6248 tgt_mask_name_ptr = c_null_ptr
6249 end if
6250
6251 call yac_cdef_couple_instance__c( instance_id, &
6252 trim(src_comp_name) // c_null_char, &
6253 trim(src_grid_name) // c_null_char, &
6254 trim(src_field_name) // c_null_char, &
6255 trim(tgt_comp_name) // c_null_char, &
6256 trim(tgt_grid_name) // c_null_char, &
6257 trim(tgt_field_name) // c_null_char, &
6258 trim(coupling_timestep) // c_null_char, &
6259 time_unit, &
6260 time_reduction, &
6261 interp_stack_config_id, &
6262 src_lag_cpy, &
6263 tgt_lag_cpy, &
6264 weight_file_ptr, &
6265 mapping_side_cpy, &
6266 scale_factor_cpy, &
6267 scale_summand_cpy, &
6268 num_src_mask_names, &
6269 src_mask_names_ptr, &
6270 tgt_mask_name_ptr )
6271
6272end subroutine yac_fdef_couple_instance
6273
6274! ---------------------------------------------------------------------
6275
6277 result(comp_name)
6278
6281 use, intrinsic :: iso_c_binding, only: c_null_char
6282
6283 implicit none
6284
6285 interface
6286
6287 function yac_cget_component_name_from_field_id_c ( field_id ) &
6288 result(comp_name) &
6289 bind( c, name='yac_cget_component_name_from_field_id' )
6290
6291 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
6292
6293 integer ( kind=c_int ), value :: field_id
6294 TYPE(c_ptr) :: comp_name
6295
6296 end function yac_cget_component_name_from_field_id_c
6297
6298 end interface
6299
6300 integer, intent (in) :: field_id
6301 character (len=:), allocatable :: comp_name
6302
6303 comp_name = yac_internal_cptr2char( &
6304 yac_cget_component_name_from_field_id_c( field_id ))
6305
6307
6308 ! ---------------------------------------------------------------------
6309
6311 result(grid_name)
6312
6315 use, intrinsic :: iso_c_binding, only: c_null_char
6316
6317 implicit none
6318
6319 interface
6320
6321 function yac_cget_grid_name_from_field_id_c ( field_id ) &
6322 result(grid_name) &
6323 bind( c, name='yac_cget_grid_name_from_field_id' )
6324
6325 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
6326
6327 integer ( kind=c_int ), value :: field_id
6328 TYPE(c_ptr) :: grid_name
6329
6330 end function yac_cget_grid_name_from_field_id_c
6331
6332 end interface
6333
6334 integer, intent (in) :: field_id
6335 character (len=:), ALLOCATABLE :: grid_name
6336
6337 grid_name = yac_internal_cptr2char( &
6338 yac_cget_grid_name_from_field_id_c( field_id ))
6339
6341
6342! ---------------------------------------------------------------------
6343
6345 result(field_name)
6346
6349 use, intrinsic :: iso_c_binding, only: c_null_char
6350
6351 implicit none
6352
6353 interface
6354
6355 function yac_cget_field_name_from_field_id_c ( field_id ) &
6356 result(field_name) &
6357 bind( c, name='yac_cget_field_name_from_field_id' )
6358
6359 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
6360
6361 integer ( kind=c_int ), value :: field_id
6362 TYPE(c_ptr) :: field_name
6363
6364 end function yac_cget_field_name_from_field_id_c
6365
6366 end interface
6367
6368 integer, intent (in) :: field_id
6369 character (len=:), ALLOCATABLE :: field_name
6370
6371 field_name = yac_internal_cptr2char( &
6372 yac_cget_field_name_from_field_id_c( field_id ))
6373
6375
6376! ---------------------------------------------------------------------
6377
6378 function yac_fget_role_from_field_id ( field_id )
6379
6381 use, intrinsic :: iso_c_binding, only: c_null_char
6382
6383 implicit none
6384
6385 interface
6386
6387 function yac_cget_role_from_field_id_c ( field_id ) &
6388 bind( c, name='yac_cget_role_from_field_id' )
6389
6390 use, intrinsic :: iso_c_binding, only : c_int, c_char
6391
6392 integer ( kind=c_int ), value :: field_id
6393 integer ( kind=c_int ) :: yac_cget_role_from_field_id_c
6394
6395 end function yac_cget_role_from_field_id_c
6396
6397 end interface
6398
6399 integer, intent (in) :: field_id
6401
6403 yac_cget_role_from_field_id_c( field_id )
6404
6405 end function yac_fget_role_from_field_id
6406
6407 ! Note that in contrast to most of the other functions in this file, we have to
6408 ! introduce a separate result variable below. Otherwise, NVHPC fails to compile
6409 ! the file due to the fact that the name of the function is also a name of the
6410 ! interface in mo_yac_finterface.
6411 function yac_fget_field_role ( comp_name, grid_name, field_name ) result( res )
6412
6414 use, intrinsic :: iso_c_binding, only: c_null_char
6415
6416 implicit none
6417
6418 interface
6419
6420 function yac_cget_field_role_c ( comp_name, grid_name, field_name ) &
6421 bind( c, name='yac_cget_field_role' )
6422
6423 use, intrinsic :: iso_c_binding, only : c_int, c_char
6424
6425 character( kind=c_char), dimension(*), intent(in) :: comp_name
6426 character( kind=c_char), dimension(*), intent(in) :: grid_name
6427 character( kind=c_char), dimension(*), intent(in) :: field_name
6428 integer ( kind=c_int ) :: yac_cget_field_role_c
6429
6430 end function yac_cget_field_role_c
6431
6432 end interface
6433
6434 character(len=*), intent(in) :: comp_name
6435 character(len=*), intent(in) :: grid_name
6436 character(len=*), intent(in) :: field_name
6437 integer :: res
6438
6439 res = yac_cget_field_role_c( &
6440 trim(comp_name) // c_null_char, &
6441 trim(grid_name) // c_null_char, &
6442 trim(field_name) // c_null_char )
6443
6444 end function yac_fget_field_role
6445
6446 function yac_fget_field_role_instance ( yac_instance_id, comp_name, grid_name, field_name )
6447
6449 use, intrinsic :: iso_c_binding, only: c_null_char
6450
6451 implicit none
6452
6453 interface
6454
6455 function yac_cget_field_role_instance_c ( yac_instance_id, &
6456 comp_name, &
6457 grid_name, &
6458 field_name ) &
6459 bind( c, name='yac_cget_field_role_instance' )
6460
6461 use, intrinsic :: iso_c_binding, only : c_int, c_char
6462
6463 integer( kind=c_int ), intent(in), value :: yac_instance_id
6464 character( kind=c_char), dimension(*), intent(in) :: comp_name
6465 character( kind=c_char), dimension(*), intent(in) :: grid_name
6466 character( kind=c_char), dimension(*), intent(in) :: field_name
6467 integer ( kind=c_int ) :: yac_cget_field_role_instance_c
6468
6469 end function yac_cget_field_role_instance_c
6470
6471 end interface
6472
6473 integer, intent(in) :: yac_instance_id
6474 character(len=*), intent(in) :: comp_name
6475 character(len=*), intent(in) :: grid_name
6476 character(len=*), intent(in) :: field_name
6478
6480 yac_cget_field_role_instance_c( &
6481 yac_instance_id, &
6482 trim(comp_name) // c_null_char, &
6483 trim(grid_name) // c_null_char, &
6484 trim(field_name) // c_null_char )
6485
6486 end function yac_fget_field_role_instance
6487
6488! ---------------------------------------------------------------------
6489
6490function yac_fget_timestep_from_field_id ( field_id ) result(string)
6491
6494
6495 implicit none
6496
6497 interface
6498
6499 function yac_cget_timestep_from_field_id_c ( field_id ) &
6500 result(string) &
6501 bind( c, name='yac_cget_timestep_from_field_id' )
6502
6503 use, intrinsic :: iso_c_binding, only : c_int, c_ptr
6504
6505 integer ( kind=c_int ), value :: field_id
6506 type(c_ptr) :: string
6507
6508 end function yac_cget_timestep_from_field_id_c
6509
6510 end interface
6511
6512 integer, intent (in) :: field_id
6513 character (len=:), ALLOCATABLE :: string
6514
6515 string = &
6517 yac_cget_timestep_from_field_id_c(field_id))
6518
6520
6521 function yac_fget_field_timestep ( comp_name, grid_name, field_name ) &
6522 result( timestep )
6523
6526 use, intrinsic :: iso_c_binding, only: c_ptr, c_null_char
6527
6528 implicit none
6529
6530 interface
6531
6532 function yac_cget_field_timestep_c ( comp_name, grid_name, field_name) &
6533 result( timestep ) &
6534 bind( c, name='yac_cget_field_timestep' )
6535
6536 use, intrinsic :: iso_c_binding, only : c_int, c_char, c_ptr
6537
6538 character( kind=c_char), dimension(*), intent(in) :: comp_name
6539 character( kind=c_char), dimension(*), intent(in) :: grid_name
6540 character( kind=c_char), dimension(*), intent(in) :: field_name
6541 type(c_ptr) :: timestep
6542 end function yac_cget_field_timestep_c
6543
6544 end interface
6545
6546 character(len=*), intent(in) :: comp_name
6547 character(len=*), intent(in) :: grid_name
6548 character(len=*), intent(in) :: field_name
6549 character(len=:), ALLOCATABLE :: timestep
6550 TYPE(c_ptr) :: c_char_ptr
6551
6552 c_char_ptr = &
6553 yac_cget_field_timestep_c( &
6554 trim(comp_name) // c_null_char, &
6555 trim(grid_name) // c_null_char, &
6556 trim(field_name) // c_null_char)
6557
6558 timestep = yac_internal_cptr2char(c_char_ptr)
6559 end function yac_fget_field_timestep
6560