11 character(len=*),
parameter,
public ::
astr =
' ABORT: ' 12 character(len=*),
parameter,
public ::
estr =
' ERROR: ' 13 character(len=*),
parameter,
public ::
wstr =
' WARNING: ' 30 integer(ip_intwp_p),
save ::
minion = 1024
31 integer(ip_intwp_p),
save ::
maxion = 9999
43 SUBROUTINE oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
47 INTEGER(kind=ip_intwp_p),
INTENT(in),
optional :: id_compid
48 CHARACTER(len=*),
INTENT(in),
optional :: cd_routine
49 CHARACTER(len=*),
INTENT(in),
optional :: cd_message
50 CHARACTER(len=*),
INTENT(in),
optional :: file
51 INTEGER,
INTENT(in),
optional :: line
52 INTEGER,
INTENT(in),
optional :: rcode
54 INTEGER :: ierror, errcode
55 character(len=*),
parameter :: subname =
'(oasis_abort)' 58 if (
present(id_compid)) &
59 WRITE (
nulprt,*) subname,
astr,
'compid = ',id_compid
60 if (
present(cd_routine)) &
61 WRITE (
nulprt,*) subname,
astr,
'called by = ',trim(cd_routine)
62 if (
present(cd_message)) &
63 WRITE (
nulprt,*) subname,
astr,
'message = ',trim(cd_message)
65 WRITE (
nulprt,*) subname,
astr,
'file = ',trim(file)
68 IF (
PRESENT(rcode))
THEN 70 WRITE (
nulprt,*) subname,
astr,
'errcode = ',errcode
78 WRITE (
nulprt,*) subname,
astr,
'CALLING ABORT FROM OASIS LAYER NOW' 81 #if defined use_comm_MPI1 || defined use_comm_MPI2 98 INTEGER(kind=ip_intwp_p),
INTENT(in) :: nu
100 character(len=*),
parameter :: subname =
'(oasis_flush)' 116 INTEGER(kind=ip_intwp_p),
INTENT(out) :: uio
118 INTEGER(kind=ip_intwp_p) :: n1
119 logical :: found,l_open
120 character(len=*),
parameter :: subname =
'(oasis_unitget)' 126 do while (n1 >
minion .and. .not.found)
128 inquire(unit=n1,opened=l_open)
129 if(.not.l_open) found=.true.
134 write(
nulprt,*) subname,
estr,
'no unit number available ' 152 INTEGER(kind=ip_intwp_p),
INTENT(in) :: uio
154 character(len=*),
parameter :: subname =
'(oasis_unitsetmin)' 171 INTEGER(kind=ip_intwp_p),
INTENT(in) :: uio
173 character(len=*),
parameter :: subname =
'(oasis_unitsetmax)' 190 INTEGER(kind=ip_intwp_p),
INTENT(in) :: uio
192 character(len=*),
parameter :: subname =
'(oasis_unitfree)' 213 CHARACTER(len=*),
INTENT(in) :: string
215 character(len=*),
parameter :: subname =
'(oasis_debug_enter)' 216 CHARACTER(len=1),
pointer :: ch_blank(:)
217 CHARACTER(len=500) :: tree_enter
222 tree_enter=
'-- ENTER '//trim(string)
223 WRITE(
nulprt,*) ch_blank,trim(tree_enter)
225 DEALLOCATE (ch_blank)
240 CHARACTER(len=*),
INTENT(in) :: string
242 character(len=*),
parameter :: subname =
'(oasis_debug_exit)' 243 CHARACTER(len=1),
pointer :: ch_blank(:)
244 CHARACTER(len=500) :: tree_exit
250 tree_exit=
'-- EXIT '//trim(string)
251 WRITE(
nulprt,*) ch_blank,trim(tree_exit)
252 DEALLOCATE (ch_blank)
267 CHARACTER(len=*),
INTENT(in) :: string
269 character(len=*),
parameter :: subname =
'(oasis_debug_note)' 270 CHARACTER(len=1),
pointer :: ch_blank(:)
271 CHARACTER(len=500) :: tree_note
276 tree_note=
'-- NOTE '//trim(string)
277 WRITE(
nulprt,*) ch_blank,trim(tree_note)
300 integer,
parameter :: IN =
ip_i4_p 301 integer,
parameter :: CL =
ic_lvar 305 integer(IN),
intent(in) :: num
306 character(len=CL),
intent(inout) :: fld(:)
307 integer(IN) ,
intent(inout) :: sortkey(:)
313 character(CL),
pointer :: tmpfld(:)
314 integer(IN) ,
pointer :: tmpkey(:)
317 character(*),
parameter :: subName =
'(oasis_sys_sortC) ' 325 allocate(tmpfld((num+1)/2))
326 allocate(tmpkey((num+1)/2))
351 integer,
parameter :: IN =
ip_i4_p 352 integer,
parameter :: CL =
ic_lvar 356 integer(IN),
intent(in) :: num
357 integer(IN),
intent(inout) :: fld(:)
358 integer(IN),
intent(inout) :: sortkey(:)
364 integer(IN),
pointer :: tmpfld(:)
365 integer(IN),
pointer :: tmpkey(:)
368 character(*),
parameter :: subName =
'(oasis_sys_sortI) ' 376 allocate(tmpfld((num+1)/2))
377 allocate(tmpkey((num+1)/2))
401 integer,
parameter :: IN =
ip_i4_p 402 integer,
parameter :: CL =
ic_lvar 406 integer(IN),
intent(in) :: num
407 integer(IN),
intent(inout) :: arr(:)
408 integer(IN),
intent(in) :: sortkey(:)
414 integer(IN),
pointer :: tmparr(:)
417 character(*),
parameter :: subName =
'(oasis_sys_sortIkey) ' 425 if (num /=
size(arr) .or. num /=
size(sortkey))
then 426 WRITE(
nulprt,*) subname,
estr,
'on size of input arrays :',num,
size(arr),
size(sortkey)
430 allocate(tmparr(num))
431 tmparr(1:num) = arr(1:num)
433 arr(n1) = tmparr(sortkey(n1))
450 integer,
parameter :: IN =
ip_i4_p 451 integer,
parameter :: CL =
ic_lvar 453 integer ,
intent(in) :: N
454 character(CL),
dimension(N) ,
intent(inout) :: A
455 character(CL),
dimension((N+1)/2),
intent(out) :: T
456 integer(IN) ,
dimension(N) ,
intent(inout) :: S
457 integer(IN) ,
dimension((N+1)/2),
intent(out) :: Z
462 character(*),
parameter :: subName =
'(oasis_sys_mergesortC) ' 468 if (a(1) > a(2))
then 484 if (a(na) > a(na+1))
then 501 integer,
parameter :: IN =
ip_i4_p 502 integer,
parameter :: CL =
ic_lvar 504 integer,
intent(in) :: NA,NB,NC
505 character(CL),
intent(inout) :: A(na)
506 integer(IN) ,
intent(inout) :: X(na)
507 character(CL),
intent(in) :: B(nb)
508 integer(IN) ,
intent(in) :: Y(nb)
509 character(CL),
intent(inout) :: C(nc)
510 integer(IN) ,
intent(inout) :: Z(nc)
513 character(*),
parameter :: subName =
'(oasis_sys_mergeC) ' 518 do while(i <= na .and. j <= nb)
519 if (a(i) <= b(j))
then 548 integer,
parameter :: IN =
ip_i4_p 549 integer,
parameter :: CL =
ic_lvar 551 integer ,
intent(in) :: N
552 integer(IN),
dimension(N) ,
intent(inout) :: A
553 integer(IN),
dimension((N+1)/2),
intent(out) :: T
554 integer(IN),
dimension(N) ,
intent(inout) :: S
555 integer(IN),
dimension((N+1)/2),
intent(out) :: Z
560 character(*),
parameter :: subName =
'(oasis_sys_mergesortI) ' 566 if (a(1) > a(2))
then 582 if (a(na) > a(na+1))
then 599 integer,
parameter :: IN =
ip_i4_p 600 integer,
parameter :: CL =
ic_lvar 602 integer,
intent(in) :: NA,NB,NC
603 integer(IN),
intent(inout) :: A(na)
604 integer(IN),
intent(inout) :: X(na)
605 integer(IN),
intent(in) :: B(nb)
606 integer(IN),
intent(in) :: Y(nb)
607 integer(IN),
intent(inout) :: C(nc)
608 integer(IN),
intent(inout) :: Z(nc)
611 character(*),
parameter :: subName =
'(oasis_sys_mergeI) ' 616 do while(i <= na .and. j <= nb)
617 if (a(i) <= b(j))
then
subroutine, public oasis_debug_note(string)
Used to write information from a subroutine, write info to log file at some debug level...
character(len= *), parameter, public astr
Provides a common location for several OASIS variables.
integer(ip_intwp_p), save minion
subroutine, public oasis_unitfree(uio)
Release a unit number for reuse.
integer(kind=ip_intwp_p) nulprt
integer(kind=ip_i4_p) mpi_comm_global
integer(ip_intwp_p), parameter tree_delta
subroutine oasis_sys_mergec(A, X, NA, B, Y, NB, C, Z, NC)
Merge routine needed for mergesortC for character strings.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
integer, parameter ip_i4_p
recursive subroutine oasis_sys_mergesortc(N, A, T, S, Z)
Generic oasis_sys_mergesortC routine for character strings.
integer(kind=ip_i4_p) mpi_rank_local
integer, parameter ip_double_p
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
subroutine, public oasis_sys_sortikey(num, arr, sortkey)
Sort an integer array using a sort key.
integer(kind=ip_i4_p) mpi_rank_global
subroutine, public oasis_sys_sortc(num, fld, sortkey)
Sort a character array and compute a sort key.
subroutine, public oasis_unitsetmin(uio)
Set the minimum unit number allowed.
character(len=ic_lvar) compnm
integer(kind=ip_i4_p) oasis_debug
character(len= *), parameter, public estr
integer, parameter ic_lvar
subroutine, public oasis_unitget(uio)
Get a free unit number.
integer(ip_intwp_p), save tree_indent
subroutine, public oasis_flush(nu)
Flushes output to file.
subroutine, public oasis_sys_sorti(num, fld, sortkey)
Sort a integer array and compute a sort key.
recursive subroutine oasis_sys_mergesorti(N, A, T, S, Z)
Generic oasis_sys_mergesortI routine for an integer array.
integer(ip_intwp_p), save maxion
subroutine oasis_sys_mergei(A, X, NA, B, Y, NB, C, Z, NC)
Merge routine needed for mergesortI for integer array.
subroutine, public oasis_unitsetmax(uio)
Set the maximum unit number allowed.
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
character(len= *), parameter, public wstr