133 integer(ip_i4_p),
intent(in) :: rcode
134 character(*),
intent(in) :: string
137 character(*),
parameter :: subname =
'(oasis_mpi_chkerr)'
138 character(MPI_MAX_ERROR_STRING) :: lstring
139 integer(ip_i4_p) :: len
140 integer(ip_i4_p) :: ierr
149 if (rcode /= mpi_success)
then
150 call mpi_error_string(rcode,lstring,len,ierr)
168 integer(ip_i4_p),
intent(in) :: lvec
169 integer(ip_i4_p),
intent(in) :: pid
170 integer(ip_i4_p),
intent(in) :: tag
171 integer(ip_i4_p),
intent(in) :: comm
172 character(*),
optional,
intent(in) :: string
175 character(*),
parameter :: subname =
'(oasis_mpi_sendi0)'
176 integer(ip_i4_p) :: lsize
177 integer(ip_i4_p) :: ierr
187 call mpi_send(lvec,lsize,mpi_integer,pid,tag,comm,ierr)
188 if (
present(string))
then
208 integer(ip_i4_p),
intent(in) :: lvec(:)
209 integer(ip_i4_p),
intent(in) :: pid
210 integer(ip_i4_p),
intent(in) :: tag
211 integer(ip_i4_p),
intent(in) :: comm
212 character(*),
optional,
intent(in) :: string
215 character(*),
parameter :: subname =
'(oasis_mpi_sendi1)'
216 integer(ip_i4_p) :: lsize
217 integer(ip_i4_p) :: ierr
227 call mpi_send(lvec,lsize,mpi_integer,pid,tag,comm,ierr)
228 if (
present(string))
then
248 real(ip_double_p),
intent(in) :: lvec
249 integer(ip_i4_p),
intent(in) :: pid
250 integer(ip_i4_p),
intent(in) :: tag
251 integer(ip_i4_p),
intent(in) :: comm
252 character(*),
optional,
intent(in) :: string
255 character(*),
parameter :: subname =
'(oasis_mpi_sendr0)'
256 integer(ip_i4_p) :: lsize
257 integer(ip_i4_p) :: ierr
267 call mpi_send(lvec,lsize,mpi_real8,pid,tag,comm,ierr)
268 if (
present(string))
then
288 real(ip_double_p),
intent(in) :: lvec(:)
289 integer(ip_i4_p),
intent(in) :: pid
290 integer(ip_i4_p),
intent(in) :: tag
291 integer(ip_i4_p),
intent(in) :: comm
292 character(*),
optional,
intent(in) :: string
295 character(*),
parameter :: subname =
'(oasis_mpi_sendr1)'
296 integer(ip_i4_p) :: lsize
297 integer(ip_i4_p) :: ierr
307 call mpi_send(lvec,lsize,mpi_real8,pid,tag,comm,ierr)
308 if (
present(string))
then
328 real(ip_double_p),
intent(in) :: array(:,:,:)
329 integer(ip_i4_p),
intent(in) :: pid
330 integer(ip_i4_p),
intent(in) :: tag
331 integer(ip_i4_p),
intent(in) :: comm
332 character(*),
optional,
intent(in) :: string
335 character(*),
parameter :: subname =
'(oasis_mpi_sendr3)'
336 integer(ip_i4_p) :: lsize
337 integer(ip_i4_p) :: ierr
347 call mpi_send(array,lsize,mpi_real8,pid,tag,comm,ierr)
348 if (
present(string))
then
368 integer(ip_i4_p),
intent(out):: lvec
369 integer(ip_i4_p),
intent(in) :: pid
370 integer(ip_i4_p),
intent(in) :: tag
371 integer(ip_i4_p),
intent(in) :: comm
372 character(*),
optional,
intent(in) :: string
375 character(*),
parameter :: subname =
'(oasis_mpi_recvi0)'
376 integer(ip_i4_p) :: lsize
377 integer(ip_i4_p) :: status(mpi_status_size)
378 integer(ip_i4_p) :: ierr
388 call mpi_recv(lvec,lsize,mpi_integer,pid,tag,comm,status,ierr)
389 if (
present(string))
then
409 integer(ip_i4_p),
intent(out):: lvec(:)
410 integer(ip_i4_p),
intent(in) :: pid
411 integer(ip_i4_p),
intent(in) :: tag
412 integer(ip_i4_p),
intent(in) :: comm
413 character(*),
optional,
intent(in) :: string
416 character(*),
parameter :: subname =
'(oasis_mpi_recvi1)'
417 integer(ip_i4_p) :: lsize
418 integer(ip_i4_p) :: status(mpi_status_size)
419 integer(ip_i4_p) :: ierr
429 call mpi_recv(lvec,lsize,mpi_integer,pid,tag,comm,status,ierr)
430 if (
present(string))
then
450 real(ip_double_p),
intent(out):: lvec
451 integer(ip_i4_p),
intent(in) :: pid
452 integer(ip_i4_p),
intent(in) :: tag
453 integer(ip_i4_p),
intent(in) :: comm
454 character(*),
optional,
intent(in) :: string
457 character(*),
parameter :: subname =
'(oasis_mpi_recvr0)'
458 integer(ip_i4_p) :: lsize
459 integer(ip_i4_p) :: status(mpi_status_size)
460 integer(ip_i4_p) :: ierr
470 call mpi_recv(lvec,lsize,mpi_real8,pid,tag,comm,status,ierr)
471 if (
present(string))
then
491 real(ip_double_p),
intent(out):: lvec(:)
492 integer(ip_i4_p),
intent(in) :: pid
493 integer(ip_i4_p),
intent(in) :: tag
494 integer(ip_i4_p),
intent(in) :: comm
495 character(*),
optional,
intent(in) :: string
498 character(*),
parameter :: subname =
'(oasis_mpi_recvr1)'
499 integer(ip_i4_p) :: lsize
500 integer(ip_i4_p) :: status(mpi_status_size)
501 integer(ip_i4_p) :: ierr
511 call mpi_recv(lvec,lsize,mpi_real8,pid,tag,comm,status,ierr)
512 if (
present(string))
then
532 real(ip_double_p),
intent(out):: array(:,:,:)
533 integer(ip_i4_p),
intent(in) :: pid
534 integer(ip_i4_p),
intent(in) :: tag
535 integer(ip_i4_p),
intent(in) :: comm
536 character(*),
optional,
intent(in) :: string
539 character(*),
parameter :: subname =
'(oasis_mpi_recvr3)'
540 integer(ip_i4_p) :: lsize
541 integer(ip_i4_p) :: status(mpi_status_size)
542 integer(ip_i4_p) :: ierr
552 call mpi_recv(array,lsize,mpi_real8,pid,tag,comm,status,ierr)
553 if (
present(string))
then
573 integer(ip_i4_p),
intent(inout):: vec
574 integer(ip_i4_p),
intent(in) :: comm
575 character(*),
optional,
intent(in) :: string
576 integer(ip_i4_p),
optional,
intent(in) :: pebcast
579 character(*),
parameter :: subname =
'(oasis_mpi_bcasti0)'
580 integer(ip_i4_p) :: ierr
581 integer(ip_i4_p) :: lsize
582 integer(ip_i4_p) :: lpebcast
592 if (
present(pebcast)) lpebcast = pebcast
594 call mpi_bcast(vec,lsize,mpi_integer,lpebcast,comm,ierr)
595 if (
present(string))
then
615 logical,
intent(inout):: vec
616 integer(ip_i4_p),
intent(in) :: comm
617 character(*),
optional,
intent(in) :: string
618 integer(ip_i4_p),
optional,
intent(in) :: pebcast
621 character(*),
parameter :: subname =
'(oasis_mpi_bcastl0)'
622 integer(ip_i4_p) :: ierr
623 integer(ip_i4_p) :: lsize
624 integer(ip_i4_p) :: lpebcast
634 if (
present(pebcast)) lpebcast = pebcast
636 call mpi_bcast(vec,lsize,mpi_logical,lpebcast,comm,ierr)
637 if (
present(string))
then
657 character(len=*),
intent(inout):: vec
658 integer(ip_i4_p),
intent(in) :: comm
659 character(*),
optional,
intent(in) :: string
660 integer(ip_i4_p),
optional,
intent(in) :: pebcast
663 character(*),
parameter :: subname =
'(oasis_mpi_bcastc0)'
664 integer(ip_i4_p) :: ierr
665 integer(ip_i4_p) :: lsize
666 integer(ip_i4_p) :: lpebcast
676 if (
present(pebcast)) lpebcast = pebcast
678 call mpi_bcast(vec,lsize,mpi_character,lpebcast,comm,ierr)
679 if (
present(string))
then
699 character(len=*),
intent(inout):: vec(:)
700 integer(ip_i4_p),
intent(in) :: comm
701 character(*),
optional,
intent(in) :: string
702 integer(ip_i4_p),
optional,
intent(in) :: pebcast
705 character(*),
parameter :: subname =
'(oasis_mpi_bcastc1)'
706 integer(ip_i4_p) :: ierr
707 integer(ip_i4_p) :: lsize
708 integer(ip_i4_p) :: lpebcast
716 lsize =
size(vec)*len(vec)
718 if (
present(pebcast)) lpebcast = pebcast
720 call mpi_bcast(vec,lsize,mpi_character,lpebcast,comm,ierr)
721 if (
present(string))
then
741 real(ip_double_p),
intent(inout):: vec
742 integer(ip_i4_p),
intent(in) :: comm
743 character(*),
optional,
intent(in) :: string
744 integer(ip_i4_p),
optional,
intent(in) :: pebcast
747 character(*),
parameter :: subname =
'(oasis_mpi_bcastr0)'
748 integer(ip_i4_p) :: ierr
749 integer(ip_i4_p) :: lsize
750 integer(ip_i4_p) :: lpebcast
760 if (
present(pebcast)) lpebcast = pebcast
762 call mpi_bcast(vec,lsize,mpi_real8,lpebcast,comm,ierr)
763 if (
present(string))
then
783 integer(ip_i4_p),
intent(inout):: vec(:)
784 integer(ip_i4_p),
intent(in) :: comm
785 character(*),
optional,
intent(in) :: string
786 integer(ip_i4_p),
optional,
intent(in) :: pebcast
789 character(*),
parameter :: subname =
'(oasis_mpi_bcasti1)'
790 integer(ip_i4_p) :: ierr
791 integer(ip_i4_p) :: lsize
792 integer(ip_i4_p) :: lpebcast
802 if (
present(pebcast)) lpebcast = pebcast
804 call mpi_bcast(vec,lsize,mpi_integer,lpebcast,comm,ierr)
805 if (
present(string))
then
825 logical,
intent(inout):: vec(:)
826 integer(ip_i4_p),
intent(in) :: comm
827 character(*),
optional,
intent(in) :: string
828 integer(ip_i4_p),
optional,
intent(in) :: pebcast
831 character(*),
parameter :: subname =
'(oasis_mpi_bcastl1)'
832 integer(ip_i4_p) :: ierr
833 integer(ip_i4_p) :: lsize
834 integer(ip_i4_p) :: lpebcast
844 if (
present(pebcast)) lpebcast = pebcast
846 call mpi_bcast(vec,lsize,mpi_logical,lpebcast,comm,ierr)
847 if (
present(string))
then
867 real(ip_double_p),
intent(inout):: vec(:)
868 integer(ip_i4_p),
intent(in) :: comm
869 character(*),
optional,
intent(in) :: string
870 integer(ip_i4_p),
optional,
intent(in) :: pebcast
873 character(*),
parameter :: subname =
'(oasis_mpi_bcastr1)'
874 integer(ip_i4_p) :: ierr
875 integer(ip_i4_p) :: lsize
876 integer(ip_i4_p) :: lpebcast
886 if (
present(pebcast)) lpebcast = pebcast
888 call mpi_bcast(vec,lsize,mpi_real8,lpebcast,comm,ierr)
889 if (
present(string))
then
909 real(ip_double_p),
intent(inout):: arr(:,:)
910 integer(ip_i4_p),
intent(in) :: comm
911 character(*),
optional,
intent(in) :: string
912 integer(ip_i4_p),
optional,
intent(in) :: pebcast
915 integer(ip_i4_p) :: ierr
916 integer(ip_i4_p) :: lsize
917 integer(ip_i4_p) :: lpebcast
920 character(*),
parameter :: subname =
'(oasis_mpi_bcastr2)'
930 if (
present(pebcast)) lpebcast = pebcast
932 call mpi_bcast(arr,lsize,mpi_real8,lpebcast,comm,ierr)
933 if (
present(string))
then
953 integer,
intent(inout):: arr(:,:)
954 integer(ip_i4_p),
intent(in) :: comm
955 character(*),
optional,
intent(in) :: string
956 integer(ip_i4_p),
optional,
intent(in) :: pebcast
959 integer(ip_i4_p) :: ierr
960 integer(ip_i4_p) :: lsize
961 integer(ip_i4_p) :: lpebcast
964 character(*),
parameter :: subname =
'(oasis_mpi_bcasti2)'
974 if (
present(pebcast)) lpebcast = pebcast
976 call mpi_bcast(arr,lsize,mpi_integer,lpebcast,comm,ierr)
977 if (
present(string))
then
997 real(ip_double_p),
intent(inout):: arr(:,:,:)
998 integer(ip_i4_p),
intent(in) :: comm
999 character(*),
optional,
intent(in) :: string
1000 integer(ip_i4_p),
optional,
intent(in) :: pebcast
1003 integer(ip_i4_p) :: ierr
1004 integer(ip_i4_p) :: lsize
1005 integer(ip_i4_p) :: lpebcast
1008 character(*),
parameter :: subname =
'(oasis_mpi_bcastr3)'
1018 if (
present(pebcast)) lpebcast = pebcast
1020 call mpi_bcast(arr,lsize,mpi_real8,lpebcast,comm,ierr)
1021 if (
present(string))
then
1046 integer(ip_i4_p),
intent(in) :: comm
1047 integer(ip_i4_p),
intent(in) :: rootid
1048 real(ip_double_p),
intent(in) :: locArr(:)
1049 real(ip_double_p),
pointer :: glob1DArr(:)
1050 integer(ip_i4_p),
pointer :: globSize(:)
1051 integer(ip_i4_p),
pointer :: displs(:)
1052 character(*),
optional,
intent(in):: string
1055 integer(ip_i4_p) :: npes
1056 integer(ip_i4_p) :: locSize
1057 integer(ip_i4_p),
pointer :: sendSize(:)
1058 integer(ip_i4_p) :: i
1059 integer(ip_i4_p) :: rank
1060 integer(ip_i4_p) :: nSize
1061 integer(ip_i4_p) :: ierr
1062 integer(ip_i4_p) :: nSiz1D
1063 integer(ip_i4_p) :: maxSize
1066 character(*),
parameter :: subname =
'(oasis_mpi_gathScatvInitr1)'
1074 locsize =
size(locarr)
1077 allocate( globsize(npes) )
1081 allocate( sendsize(npes) )
1084 call mpi_gather( locsize, 1, mpi_integer, globsize, sendsize, &
1085 mpi_integer, rootid, comm, ierr )
1086 if (
present(string))
then
1091 deallocate( sendsize )
1095 allocate( displs(npes) )
1097 if ( rootid /= rank )
then
1101 maxsize = maxval(globsize)
1103 nsiz1d = min(maxsize,globsize(1))
1105 nsize = min(maxsize,globsize(i-1))
1106 displs(i) = displs(i-1) + nsize
1107 nsiz1d = nsiz1d + min(maxsize,globsize(i))
1109 allocate( glob1darr(nsiz1d) )
1111 if ( rootid == rank )
then
1112 if ( nsiz1d /= sum(globsize) ) &
1113 call
oasis_mpi_abort( subname//
" : Error, size of global array not right" )
1114 if ( any(displs < 0) .or. any(displs >= nsiz1d) ) &
1115 call
oasis_mpi_abort( subname//
" : Error, displacement array not right" )
1116 if ( (displs(npes)+globsize(npes)) /= nsiz1d ) &
1117 call
oasis_mpi_abort( subname//
" : Error, displacement array values too big" )
1140 real(ip_double_p),
intent(in) :: locArr(:)
1141 real(ip_double_p),
intent(inout) :: glob1DArr(:)
1142 integer(ip_i4_p),
intent(in) :: locSize
1143 integer(ip_i4_p),
intent(in) :: globSize(:)
1144 integer(ip_i4_p),
intent(in) :: displs(:)
1145 integer(ip_i4_p),
intent(in) :: rootid
1146 integer(ip_i4_p),
intent(in) :: comm
1147 character(*),
optional,
intent(in):: string
1150 integer(ip_i4_p) :: ierr
1153 character(*),
parameter :: subname =
'(oasis_mpi_gathervr1)'
1161 call mpi_gatherv( locarr, locsize, mpi_real8, glob1darr, globsize, displs, &
1162 mpi_real8, rootid, comm, ierr )
1163 if (
present(string))
then
1189 real(ip_double_p),
intent(out) :: locarr(:)
1190 real(ip_double_p),
intent(in) :: glob1Darr(:)
1191 integer(ip_i4_p),
intent(in) :: locSize
1192 integer(ip_i4_p),
intent(in) :: globSize(:)
1193 integer(ip_i4_p),
intent(in) :: displs(:)
1194 integer(ip_i4_p),
intent(in) :: rootid
1195 integer(ip_i4_p),
intent(in) :: comm
1196 character(*),
optional,
intent(in):: string
1199 integer(ip_i4_p) :: ierr
1202 character(*),
parameter :: subname =
'(oasis_mpi_scattervr1)'
1210 call mpi_scatterv( glob1darr, globsize, displs, mpi_real8, locarr, locsize, &
1211 mpi_real8, rootid, comm, ierr )
1212 if (
present(string))
then
1233 integer(ip_i4_p),
intent(in) :: lvec
1234 integer(ip_i4_p),
intent(out):: gvec
1235 integer(ip_i4_p),
intent(in) :: comm
1236 character(*),
optional,
intent(in) :: string
1237 logical,
optional,
intent(in) :: all
1240 character(*),
parameter :: subname =
'(oasis_mpi_sumi0)'
1242 character(len=256) :: lstring
1243 integer(ip_i4_p) :: reduce_type
1244 integer(ip_i4_p) :: lsize
1245 integer(ip_i4_p) :: gsize
1246 integer(ip_i4_p) :: ierr
1255 reduce_type = mpi_sum
1256 if (
present(all))
then
1261 if (
present(string))
then
1262 lstring = trim(subname)//
":"//trim(string)
1264 lstring = trim(subname)
1270 if (lsize /= gsize)
then
1271 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1275 call mpi_allreduce(lvec,gvec,gsize,mpi_integer,reduce_type,comm,ierr)
1278 call mpi_reduce(lvec,gvec,gsize,mpi_integer,reduce_type,0,comm,ierr)
1299 integer(ip_i4_p),
intent(in) :: lvec(:)
1300 integer(ip_i4_p),
intent(out):: gvec(:)
1301 integer(ip_i4_p),
intent(in) :: comm
1302 character(*),
optional,
intent(in) :: string
1303 logical,
optional,
intent(in) :: all
1306 character(*),
parameter :: subname =
'(oasis_mpi_sumi1)'
1308 character(len=256) :: lstring
1309 integer(ip_i4_p) :: reduce_type
1310 integer(ip_i4_p) :: lsize
1311 integer(ip_i4_p) :: gsize
1312 integer(ip_i4_p) :: ierr
1321 reduce_type = mpi_sum
1322 if (
present(all))
then
1327 if (
present(string))
then
1328 lstring = trim(subname)//
":"//trim(string)
1330 lstring = trim(subname)
1336 if (lsize /= gsize)
then
1337 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1341 call mpi_allreduce(lvec,gvec,gsize,mpi_integer,reduce_type,comm,ierr)
1344 call mpi_reduce(lvec,gvec,gsize,mpi_integer,reduce_type,0,comm,ierr)
1362 integer(ip_i8_p),
intent(in) :: lvec
1363 integer(ip_i8_p),
intent(out):: gvec
1364 integer(ip_i4_p),
intent(in) :: comm
1365 character(*),
optional,
intent(in) :: string
1366 logical,
optional,
intent(in) :: all
1369 character(*),
parameter :: subname =
'(oasis_mpi_sumb0)'
1371 character(len=256) :: lstring
1372 integer(ip_i4_p) :: reduce_type
1373 integer(ip_i4_p) :: lsize
1374 integer(ip_i4_p) :: gsize
1375 integer(ip_i4_p) :: ierr
1384 reduce_type = mpi_sum
1385 if (
present(all))
then
1390 if (
present(string))
then
1391 lstring = trim(subname)//
":"//trim(string)
1393 lstring = trim(subname)
1399 if (lsize /= gsize)
then
1400 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1404 call mpi_allreduce(lvec,gvec,gsize,mpi_integer8,reduce_type,comm,ierr)
1407 call mpi_reduce(lvec,gvec,gsize,mpi_integer8,reduce_type,0,comm,ierr)
1428 integer(ip_i8_p),
intent(in) :: lvec(:)
1429 integer(ip_i8_p),
intent(out):: gvec(:)
1430 integer(ip_i4_p),
intent(in) :: comm
1431 character(*),
optional,
intent(in) :: string
1432 logical,
optional,
intent(in) :: all
1435 character(*),
parameter :: subname =
'(oasis_mpi_sumb1)'
1437 character(len=256) :: lstring
1438 integer(ip_i4_p) :: reduce_type
1439 integer(ip_i4_p) :: lsize
1440 integer(ip_i4_p) :: gsize
1441 integer(ip_i4_p) :: ierr
1450 reduce_type = mpi_sum
1451 if (
present(all))
then
1456 if (
present(string))
then
1457 lstring = trim(subname)//
":"//trim(string)
1459 lstring = trim(subname)
1465 if (lsize /= gsize)
then
1466 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1470 call mpi_allreduce(lvec,gvec,gsize,mpi_integer8,reduce_type,comm,ierr)
1473 call mpi_reduce(lvec,gvec,gsize,mpi_integer8,reduce_type,0,comm,ierr)
1491 real(ip_double_p),
intent(in) :: lvec
1492 real(ip_double_p),
intent(out):: gvec
1493 integer(ip_i4_p),
intent(in) :: comm
1494 character(*),
optional,
intent(in) :: string
1495 logical,
optional,
intent(in) :: all
1498 character(*),
parameter :: subname =
'(oasis_mpi_sumr0)'
1500 character(len=256) :: lstring
1501 integer(ip_i4_p) :: reduce_type
1502 integer(ip_i4_p) :: lsize
1503 integer(ip_i4_p) :: gsize
1504 integer(ip_i4_p) :: ierr
1513 reduce_type = mpi_sum
1514 if (
present(all))
then
1519 if (
present(string))
then
1520 lstring = trim(subname)//
":"//trim(string)
1522 lstring = trim(subname)
1528 if (lsize /= gsize)
then
1529 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1533 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
1536 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
1557 real(ip_double_p),
intent(in) :: lvec(:)
1558 real(ip_double_p),
intent(out):: gvec(:)
1559 integer(ip_i4_p),
intent(in) :: comm
1560 character(*),
optional,
intent(in) :: string
1561 logical,
optional,
intent(in) :: all
1564 character(*),
parameter :: subname =
'(oasis_mpi_sumr1)'
1566 character(len=256) :: lstring
1567 integer(ip_i4_p) :: reduce_type
1568 integer(ip_i4_p) :: lsize
1569 integer(ip_i4_p) :: gsize
1570 integer(ip_i4_p) :: ierr
1579 reduce_type = mpi_sum
1580 if (
present(all))
then
1585 if (
present(string))
then
1586 lstring = trim(subname)//
":"//trim(string)
1588 lstring = trim(subname)
1594 if (lsize /= gsize)
then
1595 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1599 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
1602 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
1623 real(ip_double_p),
intent(in) :: lvec(:,:)
1624 real(ip_double_p),
intent(out):: gvec(:,:)
1625 integer(ip_i4_p),
intent(in) :: comm
1626 character(*),
optional,
intent(in) :: string
1627 logical,
optional,
intent(in) :: all
1630 character(*),
parameter :: subname =
'(oasis_mpi_sumr2)'
1632 character(len=256) :: lstring
1633 integer(ip_i4_p) :: reduce_type
1634 integer(ip_i4_p) :: lsize
1635 integer(ip_i4_p) :: gsize
1636 integer(ip_i4_p) :: ierr
1645 reduce_type = mpi_sum
1646 if (
present(all))
then
1651 if (
present(string))
then
1652 lstring = trim(subname)//
":"//trim(string)
1654 lstring = trim(subname)
1660 if (lsize /= gsize)
then
1661 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1665 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
1668 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
1689 real(ip_double_p),
intent(in) :: lvec(:,:,:)
1690 real(ip_double_p),
intent(out):: gvec(:,:,:)
1691 integer(ip_i4_p),
intent(in) :: comm
1692 character(*),
optional,
intent(in) :: string
1693 logical,
optional,
intent(in) :: all
1696 character(*),
parameter :: subname =
'(oasis_mpi_sumr3)'
1698 character(len=256) :: lstring
1699 integer(ip_i4_p) :: reduce_type
1700 integer(ip_i4_p) :: lsize
1701 integer(ip_i4_p) :: gsize
1702 integer(ip_i4_p) :: ierr
1711 reduce_type = mpi_sum
1712 if (
present(all))
then
1717 if (
present(string))
then
1718 lstring = trim(subname)//
":"//trim(string)
1720 lstring = trim(subname)
1726 if (lsize /= gsize)
then
1727 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1731 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
1734 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
1752 integer(ip_i4_p),
intent(in) :: lvec
1753 integer(ip_i4_p),
intent(out):: gvec
1754 integer(ip_i4_p),
intent(in) :: comm
1755 character(*),
optional,
intent(in) :: string
1756 logical,
optional,
intent(in) :: all
1759 character(*),
parameter :: subname =
'(oasis_mpi_mini0)'
1761 character(len=256) :: lstring
1762 integer(ip_i4_p) :: reduce_type
1763 integer(ip_i4_p) :: lsize
1764 integer(ip_i4_p) :: gsize
1765 integer(ip_i4_p) :: ierr
1774 reduce_type = mpi_min
1775 if (
present(all))
then
1780 if (
present(string))
then
1781 lstring = trim(subname)//
":"//trim(string)
1783 lstring = trim(subname)
1789 if (lsize /= gsize)
then
1790 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1794 call mpi_allreduce(lvec,gvec,gsize,mpi_integer,reduce_type,comm,ierr)
1797 call mpi_reduce(lvec,gvec,gsize,mpi_integer,reduce_type,0,comm,ierr)
1815 integer(ip_i4_p),
intent(in) :: lvec(:)
1816 integer(ip_i4_p),
intent(out):: gvec(:)
1817 integer(ip_i4_p),
intent(in) :: comm
1818 character(*),
optional,
intent(in) :: string
1819 logical,
optional,
intent(in) :: all
1822 character(*),
parameter :: subname =
'(oasis_mpi_mini1)'
1824 character(len=256) :: lstring
1825 integer(ip_i4_p) :: reduce_type
1826 integer(ip_i4_p) :: lsize
1827 integer(ip_i4_p) :: gsize
1828 integer(ip_i4_p) :: ierr
1837 reduce_type = mpi_min
1838 if (
present(all))
then
1843 if (
present(string))
then
1844 lstring = trim(subname)//
":"//trim(string)
1846 lstring = trim(subname)
1852 if (lsize /= gsize)
then
1853 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1857 call mpi_allreduce(lvec,gvec,gsize,mpi_integer,reduce_type,comm,ierr)
1860 call mpi_reduce(lvec,gvec,gsize,mpi_integer,reduce_type,0,comm,ierr)
1878 real(ip_double_p),
intent(in) :: lvec
1879 real(ip_double_p),
intent(out):: gvec
1880 integer(ip_i4_p),
intent(in) :: comm
1881 character(*),
optional,
intent(in) :: string
1882 logical,
optional,
intent(in) :: all
1885 character(*),
parameter :: subname =
'(oasis_mpi_minr0)'
1887 character(len=256) :: lstring
1888 integer(ip_i4_p) :: reduce_type
1889 integer(ip_i4_p) :: lsize
1890 integer(ip_i4_p) :: gsize
1891 integer(ip_i4_p) :: ierr
1900 reduce_type = mpi_min
1901 if (
present(all))
then
1906 if (
present(string))
then
1907 lstring = trim(subname)//
":"//trim(string)
1909 lstring = trim(subname)
1915 if (lsize /= gsize)
then
1916 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1920 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
1923 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
1941 real(ip_double_p),
intent(in) :: lvec(:)
1942 real(ip_double_p),
intent(out):: gvec(:)
1943 integer(ip_i4_p),
intent(in) :: comm
1944 character(*),
optional,
intent(in) :: string
1945 logical,
optional,
intent(in) :: all
1948 character(*),
parameter :: subname =
'(oasis_mpi_minr1)'
1950 character(len=256) :: lstring
1951 integer(ip_i4_p) :: reduce_type
1952 integer(ip_i4_p) :: lsize
1953 integer(ip_i4_p) :: gsize
1954 integer(ip_i4_p) :: ierr
1963 reduce_type = mpi_min
1964 if (
present(all))
then
1969 if (
present(string))
then
1970 lstring = trim(subname)//
":"//trim(string)
1972 lstring = trim(subname)
1978 if (lsize /= gsize)
then
1979 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
1983 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
1986 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
2004 integer(ip_i4_p),
intent(in) :: lvec
2005 integer(ip_i4_p),
intent(out):: gvec
2006 integer(ip_i4_p),
intent(in) :: comm
2007 character(*),
optional,
intent(in) :: string
2008 logical,
optional,
intent(in) :: all
2011 character(*),
parameter :: subname =
'(oasis_mpi_maxi0)'
2013 character(len=256) :: lstring
2014 integer(ip_i4_p) :: reduce_type
2015 integer(ip_i4_p) :: lsize
2016 integer(ip_i4_p) :: gsize
2017 integer(ip_i4_p) :: ierr
2026 reduce_type = mpi_max
2027 if (
present(all))
then
2032 if (
present(string))
then
2033 lstring = trim(subname)//
":"//trim(string)
2035 lstring = trim(subname)
2041 if (lsize /= gsize)
then
2042 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
2046 call mpi_allreduce(lvec,gvec,gsize,mpi_integer,reduce_type,comm,ierr)
2049 call mpi_reduce(lvec,gvec,gsize,mpi_integer,reduce_type,0,comm,ierr)
2067 integer(ip_i4_p),
intent(in) :: lvec(:)
2068 integer(ip_i4_p),
intent(out):: gvec(:)
2069 integer(ip_i4_p),
intent(in) :: comm
2070 character(*),
optional,
intent(in) :: string
2071 logical,
optional,
intent(in) :: all
2074 character(*),
parameter :: subname =
'(oasis_mpi_maxi1)'
2076 character(len=256) :: lstring
2077 integer(ip_i4_p) :: reduce_type
2078 integer(ip_i4_p) :: lsize
2079 integer(ip_i4_p) :: gsize
2080 integer(ip_i4_p) :: ierr
2089 reduce_type = mpi_max
2090 if (
present(all))
then
2095 if (
present(string))
then
2096 lstring = trim(subname)//
":"//trim(string)
2098 lstring = trim(subname)
2104 if (lsize /= gsize)
then
2105 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
2109 call mpi_allreduce(lvec,gvec,gsize,mpi_integer,reduce_type,comm,ierr)
2112 call mpi_reduce(lvec,gvec,gsize,mpi_integer,reduce_type,0,comm,ierr)
2130 real(ip_double_p),
intent(in) :: lvec
2131 real(ip_double_p),
intent(out):: gvec
2132 integer(ip_i4_p),
intent(in) :: comm
2133 character(*),
optional,
intent(in) :: string
2134 logical,
optional,
intent(in) :: all
2137 character(*),
parameter :: subname =
'(oasis_mpi_maxr0)'
2139 character(len=256) :: lstring
2140 integer(ip_i4_p) :: reduce_type
2141 integer(ip_i4_p) :: lsize
2142 integer(ip_i4_p) :: gsize
2143 integer(ip_i4_p) :: ierr
2152 reduce_type = mpi_max
2153 if (
present(all))
then
2158 if (
present(string))
then
2159 lstring = trim(subname)//
":"//trim(string)
2161 lstring = trim(subname)
2167 if (lsize /= gsize)
then
2168 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
2172 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
2175 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
2193 real(ip_double_p),
intent(in) :: lvec(:)
2194 real(ip_double_p),
intent(out):: gvec(:)
2195 integer(ip_i4_p) ,
intent(in) :: comm
2196 character(*),
optional,
intent(in) :: string
2197 logical,
optional,
intent(in) :: all
2200 character(*),
parameter :: subname =
'(oasis_mpi_maxr1)'
2202 character(len=256) :: lstring
2203 integer(ip_i4_p) :: reduce_type
2204 integer(ip_i4_p) :: lsize
2205 integer(ip_i4_p) :: gsize
2206 integer(ip_i4_p) :: ierr
2215 reduce_type = mpi_max
2216 if (
present(all))
then
2221 if (
present(string))
then
2222 lstring = trim(subname)//
":"//trim(string)
2224 lstring = trim(subname)
2230 if (lsize /= gsize)
then
2231 call
oasis_mpi_abort(subname//
" lsize,gsize incompatable "//trim(string))
2235 call mpi_allreduce(lvec,gvec,gsize,mpi_real8,reduce_type,comm,ierr)
2238 call mpi_reduce(lvec,gvec,gsize,mpi_real8,reduce_type,0,comm,ierr)
2256 integer,
intent(in) :: comm
2257 integer,
intent(out) :: size
2258 character(*),
optional,
intent(in) :: string
2261 character(*),
parameter :: subname =
'(oasis_mpi_commsize)'
2262 integer(ip_i4_p) :: ierr
2270 call mpi_comm_size(comm,
size,ierr)
2271 if (
present(string))
then
2291 integer,
intent(in) :: comm
2292 integer,
intent(out) :: rank
2293 character(*),
optional,
intent(in) :: string
2296 character(*),
parameter :: subname =
'(oasis_mpi_commrank)'
2297 integer(ip_i4_p) :: ierr
2305 call mpi_comm_rank(comm,rank,ierr)
2306 if (
present(string))
then
2326 logical,
intent(out) :: flag
2327 character(*),
optional,
intent(in) :: string
2330 character(*),
parameter :: subName =
'(oasis_mpi_initialized)'
2331 integer(ip_i4_p) :: ierr
2339 call mpi_initialized(flag,ierr)
2340 if (
present(string))
then
2360 real(ip_r8_p),
intent(out) :: wtime
2363 character(*),
parameter :: subName =
'(oasis_mpi_wtime)'
2387 character(*),
optional,
intent(in) :: string
2388 integer,
optional,
intent(in) :: rcode
2391 character(*),
parameter :: subName =
'(oasis_mpi_abort)'
2392 character(len=256) :: lstr
2393 integer(ip_i4_p) :: ierr
2402 if (
present(string) .and.
present(rcode))
then
2403 write(lstr,
'(a,i6.6)') trim(string)//
' rcode = ',rcode
2404 elseif (
present(string))
then
2410 call
oasis_abort(cd_routine=subname,cd_message=trim(string))
2426 integer,
intent(in) :: comm
2427 character(*),
optional,
intent(in) :: string
2430 character(*),
parameter :: subname =
'(oasis_mpi_barrier)'
2431 integer(ip_i4_p) :: ierr
2439 call mpi_barrier(comm,ierr)
2440 if (
present(string))
then
2460 character(*),
optional,
intent(in) :: string
2463 character(*),
parameter :: subname =
'(oasis_mpi_init)'
2464 integer(ip_i4_p) :: ierr
2473 if (
present(string))
then
2493 character(*),
optional,
intent(in) :: string
2496 character(*),
parameter :: subname =
'(oasis_mpi_finalize)'
2497 integer(ip_i4_p) :: ierr
2505 call mpi_finalize(ierr)
2506 if (
present(string))
then
2522 linp2,lout2,spval2,linp3,lout3,spval3)
2527 character(*),
pointer,
intent(in) :: linp1(:)
2528 integer ,
intent(in) :: comm
2529 integer ,
intent(out) :: cntout
2530 character(*),
pointer,
intent(inout) :: lout1(:)
2531 character(*) ,
intent(in) :: callstr
2532 logical ,
intent(in) ,
optional :: fastcheck
2533 logical ,
intent(out) ,
optional :: fastcheckout
2534 character(*),
pointer,
intent(in) ,
optional :: linp2(:)
2535 character(*),
pointer,
intent(inout),
optional :: lout2(:)
2536 character(*) ,
intent(in) ,
optional :: spval2
2537 integer ,
pointer,
intent(in) ,
optional :: linp3(:)
2538 integer ,
pointer,
intent(inout),
optional :: lout3(:)
2539 integer ,
intent(in) ,
optional :: spval3
2542 integer(kind=ip_i4_p) :: m,n,k,p
2543 integer(kind=ip_i4_p) :: llen,lsize
2544 integer(kind=ip_i4_p) :: cnt, cntr
2545 integer(kind=ip_i4_p) :: commrank, commsize
2546 integer(kind=ip_i4_p) :: listcheck, listcheckall
2547 integer(kind=ip_i4_p) :: maxloops, sendid, recvid, kfac
2548 logical :: found, present2, present3
2549 integer(kind=ip_i4_p) :: status(mpi_status_size)
2550 character(len=ic_lvar2),
pointer :: recv_varf1(:),varf1a(:),varf1b(:)
2551 character(len=ic_lvar2),
pointer :: recv_varf2(:),varf2a(:),varf2b(:)
2552 integer(kind=ip_i4_p) ,
pointer :: recv_varf3(:),varf3a(:),varf3b(:)
2553 character(len=ic_lvar2) :: string
2554 logical,
parameter :: local_timers_on = .false.
2555 integer(ip_i4_p) :: ierr
2556 character(*),
parameter :: subname =
'(oasis_mpi_reducelists)'
2571 string = trim(callstr)
2572 if (
present(fastcheckout)) fastcheckout = .false.
2580 if ((
present(linp2) .and. .not.
present(lout2)) .or. &
2581 (
present(lout2) .and. .not.
present(linp2)))
then
2582 call
oasis_mpi_abort(subname//trim(string)//
" linp2 lout2 both must be present ")
2584 present2 =
present(linp2)
2586 if ((
present(linp3) .and. .not.
present(lout3)) .or. &
2587 (
present(lout3) .and. .not.
present(linp3)))
then
2588 call
oasis_mpi_abort(subname//trim(string)//
" linp3 lout3 both must be present ")
2590 present3 =
present(linp3)
2592 if (len(linp1) > len(varf1a))
then
2596 if (
present(linp2))
then
2597 if (
size(linp2) /=
size(linp1))
then
2598 call
oasis_mpi_abort(subname//trim(string)//
" linp1 linp2 not same size ")
2600 if (len(linp2) > len(varf2a))
then
2603 if (len(varf1a) /= len(varf2a))
then
2604 call
oasis_mpi_abort(subname//trim(string)//
" varf1a varf2a not same len ")
2608 if (
present(linp3))
then
2609 if (
size(linp3) /=
size(linp1))
then
2610 call
oasis_mpi_abort(subname//trim(string)//
" linp1 linp3 not same size ")
2619 if (
present(fastcheck))
then
2625 if (commrank == 0)
then
2628 call
oasis_mpi_bcast(lsize, comm, subname//trim(string)//
' lsize check')
2631 allocate(varf1a(lsize))
2633 if (commrank == 0)
then
2634 varf1a(1:lsize) = linp1(1:lsize)
2636 call
oasis_mpi_bcast(varf1a, comm, subname//trim(string)//
' varf1a check')
2639 if (oasis_debug >= 20)
then
2640 write(nulprt,*) subname//trim(string),
' sizes ',lsize,
size(linp1)
2642 if (lsize /=
size(linp1)) listcheck = 0
2644 do while (listcheck == 1 .and. n < lsize)
2646 if (varf1a(n) /= linp1(n)) listcheck = 0
2647 if (oasis_debug >= 20)
then
2648 write(nulprt,*) subname//trim(string),
' fcheck varf1a ',n,trim(linp1(n)),
' ',trim(linp1(n)),listcheck
2652 call
oasis_mpi_min(listcheck,listcheckall,comm, subname//trim(string)//
' listcheck',all=.true.)
2654 if (oasis_debug >= 15)
then
2655 write(nulprt,*) subname//trim(string),
' listcheck = ',listcheck,listcheckall
2663 if (listcheckall == 1)
then
2665 allocate(lout1(lsize))
2666 lout1(1:lsize) = linp1(1:lsize)
2668 allocate(lout2(lsize))
2669 lout2(1:lsize) = linp2(1:lsize)
2672 allocate(lout3(lsize))
2673 lout3(1:lsize) = linp3(1:lsize)
2676 if (
present(fastcheckout)) fastcheckout = .true.
2689 if (oasis_debug >= 15)
then
2690 write(nulprt,*) subname//trim(string),
' len, size = ',llen,lsize
2694 allocate(varf1a(max(lsize,20)))
2695 if (present2)
allocate(varf2a(max(lsize,20)))
2696 if (present3)
allocate(varf3a(max(lsize,20)))
2701 do while (p < cnt .and. .not.found)
2703 if (linp1(n) == varf1a(p)) found = .true.
2705 if (.not.found)
then
2707 varf1a(cnt) = linp1(n)
2708 if (present2) varf2a(cnt) = linp2(n)
2709 if (present3) varf3a(cnt) = linp3(n)
2717 maxloops = int(sqrt(float(commsize+1)))+1
2722 recvid = commrank + kfac/2
2723 if (mod(commrank,kfac) /= 0 .or. &
2724 recvid < 0 .or. recvid > commsize-1) &
2727 sendid = commrank - kfac/2
2728 if (mod(commrank+kfac/2,kfac) /= 0 .or. &
2729 sendid < 0 .or. sendid > commsize-1) &
2732 if (oasis_debug >= 15)
then
2733 write(nulprt,*) subname//trim(string),
' send/recv ids ',m,commrank,sendid,recvid
2741 if (sendid >= 0)
then
2743 call mpi_send(cnt, 1, mpi_integer, sendid, 5900+m, comm, ierr)
2746 if (oasis_debug >= 15)
then
2747 write(nulprt,*) subname//trim(string),
' send size ',commrank,m,cnt,ic_lvar2
2750 call mpi_send(varf1a(1:cnt), cnt*ic_lvar2, mpi_character, sendid, 6900+m, comm, ierr)
2753 call mpi_send(varf2a(1:cnt), cnt*ic_lvar2, mpi_character, sendid, 7900+m, comm, ierr)
2757 call mpi_send(varf3a(1:cnt), cnt, mpi_integer, sendid, 8900+m, comm, ierr)
2769 if (recvid >= 0)
then
2771 call mpi_recv(cntr, 1, mpi_integer, recvid, 5900+m, comm, status, ierr)
2774 if (oasis_debug >= 15)
then
2775 write(nulprt,*) subname//trim(string),
' recv size ',commrank,m,cntr,ic_lvar2
2778 allocate(recv_varf1(cntr))
2779 call mpi_recv(recv_varf1, cntr*ic_lvar2, mpi_character, recvid, 6900+m, comm, status, ierr)
2782 allocate(recv_varf2(cntr))
2783 call mpi_recv(recv_varf2, cntr*ic_lvar2, mpi_character, recvid, 7900+m, comm, status, ierr)
2787 allocate(recv_varf3(cntr))
2788 call mpi_recv(recv_varf3, cntr, mpi_integer, recvid, 8900+m, comm, status, ierr)
2796 if (oasis_debug >= 15)
write(nulprt,*) subname//trim(string),
' check recv_varf1 ',m,n,trim(recv_varf1(n))
2800 do while (p < cnt .and. .not.found)
2802 if (recv_varf1(n) == varf1a(p))
then
2805 if (
present(spval2))
then
2807 if (varf2a(p) == spval2)
then
2808 varf2a(p) = recv_varf2(n)
2809 elseif (recv_varf2(n) /= spval2 .and. varf2a(p) /= recv_varf2(n))
then
2810 call
oasis_abort(cd_routine=subname//trim(string),cd_message= &
2811 'inconsistent linp2 value: '//trim(recv_varf2(n))//
':'//trim(varf1a(p))//
':'//trim(varf2a(p)))
2814 if (varf2a(p) /= recv_varf2(n))
then
2815 call
oasis_abort(cd_routine=subname//trim(string),cd_message= &
2816 'inconsistent linp2 value: '//trim(recv_varf2(n))//
':'//trim(varf1a(p))//
':'//trim(varf2a(p)))
2821 if (
present(spval3))
then
2823 if (varf3a(p) == spval3)
then
2824 varf3a(p) = recv_varf3(n)
2825 elseif (recv_varf3(n) /= spval3 .and. varf3a(p) /= recv_varf3(n))
then
2826 write(nulprt,*) subname//trim(string),astr,
'inconsistent linp3 var: ',&
2827 recv_varf3(n),
':',trim(varf1a(p)),
':',varf3a(p)
2828 call
oasis_abort(cd_routine=subname//trim(string),cd_message= &
2829 'inconsistent linp3 value: '//trim(varf1a(p)))
2832 if (varf3a(p) /= recv_varf3(n))
then
2833 write(nulprt,*) subname//trim(string),astr,
'inconsistent linp3 var: ',&
2834 recv_varf3(n),
':',trim(varf1a(p)),
':',varf3a(p)
2835 call
oasis_abort(cd_routine=subname//trim(string),cd_message= &
2836 'inconsistent linp3 value: '//trim(varf1a(p)))
2842 if (.not.found)
then
2844 if (cnt >
size(varf1a))
then
2845 allocate(varf1b(
size(varf1a)))
2848 if (oasis_debug >= 15)
then
2849 write(nulprt,*) subname//trim(string),
' resize varf1a ',
size(varf1b),cnt+cntr
2852 allocate(varf1a(cnt+cntr))
2853 varf1a(1:
size(varf1b)) = varf1b(1:
size(varf1b))
2856 allocate(varf2b(
size(varf2a)))
2859 if (oasis_debug >= 15)
then
2860 write(nulprt,*) subname//trim(string),
' resize varf2a ',
size(varf2b),cnt+cntr
2863 allocate(varf2a(cnt+cntr))
2864 varf2a(1:
size(varf2b)) = varf2b(1:
size(varf2b))
2868 allocate(varf3b(
size(varf3a)))
2871 if (oasis_debug >= 15)
then
2872 write(nulprt,*) subname//trim(string),
' resize varf3a ',
size(varf3b),cnt+cntr
2875 allocate(varf3a(cnt+cntr))
2876 varf3a(1:
size(varf3b)) = varf3b(1:
size(varf3b))
2880 varf1a(cnt) = recv_varf1(n)
2881 if (present2) varf2a(cnt) = recv_varf2(n)
2882 if (present3) varf3a(cnt) = recv_varf3(n)
2887 deallocate(recv_varf1)
2888 if (present2)
deallocate(recv_varf2)
2889 if (present3)
deallocate(recv_varf3)
2900 if (local_timers_on)
then
2902 if (comm /= mpi_comm_null) &
2903 call mpi_barrier(comm, ierr)
2909 allocate(lout1(cntout))
2910 if (commrank == 0)
then
2911 lout1(1:cntout) = varf1a(1:cntout)
2917 allocate(lout2(cntout))
2918 if (commrank == 0)
then
2919 lout2(1:cntout) = varf2a(1:cntout)
2926 allocate(lout3(cntout))
2927 if (commrank == 0)
then
2928 lout3(1:cntout) = varf3a(1:cntout)
2936 if (oasis_debug >= 15)
then
2938 if (present2 .and. present3)
then
2939 write(nulprt,*) subname,trim(string),
' list: ',n,trim(lout1(n)),
' ',trim(lout2(n)),lout3(n)
2940 elseif (present2)
then
2941 write(nulprt,*) subname,trim(string),
' list: ',n,trim(lout1(n)),
' ',trim(lout2(n))
2942 elseif (present3)
then
2943 write(nulprt,*) subname,trim(string),
' list: ',n,trim(lout1(n)),lout3(n)
2945 write(nulprt,*) subname,trim(string),
' list: ',n,trim(lout1(n))
subroutine oasis_mpi_bcastr3(arr, comm, string, pebcast)
Broadcast an array of 3D doubles.
Generic overloaded interface into MPI sum reduction.
Generic interfaces into an MPI vector gather.
subroutine oasis_mpi_recvr0(lvec, pid, tag, comm, string)
Receive a scalar double.
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
subroutine oasis_mpi_bcasti1(vec, comm, string, pebcast)
Broadcast an array of 1D integers.
subroutine oasis_mpi_sumi1(lvec, gvec, comm, string, all)
Compute a 1D array of global sums for an array of 1D integers.
subroutine oasis_mpi_maxi0(lvec, gvec, comm, string, all)
Compute a global maximum for a scalar integer.
Generic overloaded interface into MPI send.
subroutine oasis_mpi_maxr1(lvec, gvec, comm, string, all)
Compute an array of global maximums for an array of 1D doubles.
Generic overloaded interface into MPI max reduction.
subroutine, public oasis_mpi_initialized(flag, string)
Check whether MPI has been initialized.
Provides a generic and simpler interface into MPI calls for OASIS.
subroutine oasis_mpi_sendi0(lvec, pid, tag, comm, string)
Send a scalar integer.
Generic overloaded interface into MPI broadcast.
subroutine oasis_mpi_mini0(lvec, gvec, comm, string, all)
Compute a global minimum for a scalar integer.
subroutine oasis_mpi_mini1(lvec, gvec, comm, string, all)
Compute an array of global minimums for an array of 1D integers.
subroutine, public oasis_mpi_init(string)
Call MPI_INIT.
subroutine, public oasis_mpi_wtime(wtime)
Return a timestamp from MPI_WTIME.
subroutine oasis_mpi_bcastl1(vec, comm, string, pebcast)
Broadcast an array of 1D logicals.
subroutine, public oasis_mpi_commsize(comm, size, string)
Get the total number of tasks associated with a communicator.
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
subroutine, public oasis_mpi_abort(string, rcode)
Write error messages and Call MPI_ABORT.
subroutine oasis_mpi_recvi0(lvec, pid, tag, comm, string)
Receive a scalar integer.
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
Provides a common location for several OASIS variables.
Generic interfaces into an MPI vector scatter.
subroutine, public oasis_mpi_reducelists(linp1, comm, cntout, lout1, callstr, fastcheck, fastcheckout, linp2, lout2, spval2, linp3, lout3, spval3)
Custom method for reducing MPI lists across pes for OASIS.
subroutine oasis_mpi_sumi0(lvec, gvec, comm, string, all)
Compute a global Sum for a scalar integer.
subroutine oasis_mpi_bcastr1(vec, comm, string, pebcast)
Broadcast an array of 1D doubles.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
subroutine, public oasis_flush(nu)
Flushes output to file.
subroutine oasis_mpi_sumr1(lvec, gvec, comm, string, all)
Compute a 1D array of global sums for an array of 1D doubles.
subroutine, public oasis_mpi_commrank(comm, rank, string)
Get the rank (task ID) for a task in a communicator.
subroutine oasis_mpi_minr0(lvec, gvec, comm, string, all)
Compute an global minimum for a scalar double.
Generic overloaded interface into MPI min reduction.
subroutine oasis_mpi_sendi1(lvec, pid, tag, comm, string)
Send an array of 1D integers.
subroutine oasis_mpi_sumr2(lvec, gvec, comm, string, all)
Compute a 2D array of global sums for an array of 2D doubles.
subroutine oasis_mpi_sumr0(lvec, gvec, comm, string, all)
Compute a global sum for a scalar double.
subroutine oasis_mpi_maxi1(lvec, gvec, comm, string, all)
Compute an array of global maximums for an array of 1D integers.
subroutine oasis_mpi_gathervr1(locarr, locSize, glob1DArr, globSize, displs, rootid, comm, string)
Gather a vector of distributed data to a rootid.
subroutine oasis_mpi_bcasti0(vec, comm, string, pebcast)
Broadcast a scalar integer.
subroutine, public oasis_mpi_chkerr(rcode, string)
Checks MPI error codes and aborts.
subroutine oasis_mpi_bcasti2(arr, comm, string, pebcast)
Broadcast an array of 2D integers.
Performance timer methods.
Generic interface to oasis_mpi_gathScatVInit.
subroutine oasis_mpi_gathscatvinitr1(comm, rootid, locArr, glob1DArr, globSize, displs, string)
Initialize variables for oasis_mpi_gatherv and oasis_mpi_scatterv.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine oasis_mpi_sendr3(array, pid, tag, comm, string)
Send an array of 3D doubles.
subroutine oasis_mpi_bcastc1(vec, comm, string, pebcast)
Broadcast an array of 1D character strings.
subroutine oasis_mpi_sumb0(lvec, gvec, comm, string, all)
Compute a global sum for a scalar 8 byte integer.
subroutine oasis_mpi_sendr0(lvec, pid, tag, comm, string)
Send a scalar double.
subroutine, public oasis_mpi_finalize(string)
Call MPI_FINALZE.
subroutine oasis_mpi_scattervr1(locarr, locSize, glob1Darr, globSize, displs, rootid, comm, string)
Scatter a vector of global data from a rootid.
subroutine, public oasis_mpi_barrier(comm, string)
Call MPI_BARRIER for a particular communicator.
subroutine oasis_mpi_bcastc0(vec, comm, string, pebcast)
Broadcast a character string.
subroutine oasis_mpi_minr1(lvec, gvec, comm, string, all)
Compute an array of global minimums for an array of 1D doubles.
subroutine oasis_mpi_bcastr0(vec, comm, string, pebcast)
Broadcast a scalar double.
subroutine oasis_mpi_bcastl0(vec, comm, string, pebcast)
Broadcast a scalar logical.
subroutine oasis_mpi_recvr1(lvec, pid, tag, comm, string)
Receive an array of 1D doubles.
subroutine oasis_mpi_sumr3(lvec, gvec, comm, string, all)
Compute a 3D array of global sums for an array of 3D doubles.
subroutine oasis_mpi_sendr1(lvec, pid, tag, comm, string)
Send an array of 1D doubles.
subroutine oasis_mpi_bcastr2(arr, comm, string, pebcast)
Broadcast an array of 2D doubles.
subroutine oasis_mpi_maxr0(lvec, gvec, comm, string, all)
Compute a global maximum for a scalar double.
Generic overloaded interface into MPI receive.
subroutine oasis_mpi_sumb1(lvec, gvec, comm, string, all)
Compute a 1D array of global sums for an array of 1D 8 byte integers.
subroutine oasis_mpi_recvi1(lvec, pid, tag, comm, string)
Receive an array of 1D integers.
subroutine oasis_mpi_recvr3(array, pid, tag, comm, string)
Receive an array of 3D doubles.