34 integer(kind=ip_i4_p) istatus(mpi_status_size)
46 INTEGER (kind=ip_intwp_p),
intent(out) :: localcomm
47 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
49 character(len=*),
parameter :: subname =
'(oasis_get_localcomm)' 53 if (
present(kinfo))
then 60 WRITE(
nulprt,*)
'localcomm :',localcomm
75 INTEGER (kind=ip_intwp_p),
intent(in) :: localcomm
76 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
78 integer(kind=ip_intwp_p) :: ierr
79 character(len=*),
parameter :: subname =
'(oasis_set_couplcomm)' 83 if (
present(kinfo))
then 116 INTEGER (kind=ip_intwp_p),
intent(in) :: icpl
117 INTEGER (kind=ip_intwp_p),
intent(in) :: allcomm
118 INTEGER (kind=ip_intwp_p),
intent(out) :: cplcomm
119 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
121 integer(kind=ip_intwp_p) :: ierr
122 character(len=*),
parameter :: subname =
'(oasis_create_couplcomm)' 126 if (
present(kinfo))
then 134 CALL mpi_comm_split(allcomm,icpl,1,cplcomm,ierr)
136 WRITE (
nulprt,*) subname,
estr,
'MPI_Comm_Split ierr = ',ierr
147 WRITE (
nulprt,*)
'New local coupling comm =',cplcomm
162 INTEGER (kind=ip_intwp_p),
intent(out) :: debug
163 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
165 character(len=*),
parameter :: subname =
'(oasis_get_debug)' 169 if (
present(kinfo))
then 186 INTEGER (kind=ip_intwp_p),
intent(in) :: debug
187 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
189 character(len=*),
parameter :: subname =
'(oasis_set_debug)' 193 if (
present(kinfo))
then 214 INTEGER (kind=ip_intwp_p),
intent(out) :: new_comm
215 CHARACTER(len=*),
intent(in) :: cdnam
216 INTEGER (kind=ip_intwp_p),
intent(out),
optional :: kinfo
221 character(len=*),
parameter :: subname =
'(oasis_get_intercomm)' 225 if (
present(kinfo))
then 233 write(
nulprt,*) subname,
estr,
'found same model name twice' 241 if (.not. found)
then 242 write(
nulprt,*) subname,
estr,
'input model name not found' 247 WRITE(
nulprt,*) subname,
'cdnam :',trim(cdnam),
' il :',il, &
253 tag=ichar(trim(
compnm))+ichar(trim(cdnam))
268 INTEGER (kind=ip_intwp_p),
intent(out) :: new_comm
269 CHARACTER(len=*),
intent(in) :: cdnam
270 INTEGER (kind=ip_intwp_p),
intent(out),
optional :: kinfo
275 character(len=*),
parameter :: subname =
'(oasis_get_intracomm)' 279 if (
present(kinfo))
then 285 CALL mpi_intercomm_merge(tmp_intercomm,.false., new_comm, ierr)
298 INTEGER(kind=ip_i4_p) ,
INTENT(in) :: varid
299 INTEGER(kind=ip_i4_p) ,
INTENT(out) :: ncpl
300 INTEGER(kind=ip_i4_p) ,
INTENT(out) :: kinfo
302 CHARACTER(len=ic_lvar) :: vname
303 CHARACTER(len=*),
PARAMETER :: subname =
'oasis_get_ncpl' 309 WRITE(
nulprt,*) subname,
estr,
'called on non coupling task' 317 WRITE(
nulprt,*) subname,
estr,
'Routine is called for an invalid varid' 328 ' used in ',ncpl,
' couplings' 342 INTEGER(kind=ip_i4_p) ,
INTENT(in) :: varid
343 INTEGER(kind=ip_i4_p) ,
INTENT(in) :: mop
344 INTEGER(kind=ip_i4_p) ,
INTENT(in) :: ncpl
345 INTEGER(kind=ip_i4_p) ,
INTENT(out) :: cpl_freqs(ncpl)
346 INTEGER(kind=ip_i4_p) ,
INTENT(out) :: kinfo
348 CHARACTER(len=ic_lvar) :: vname
349 INTEGER(kind=ip_i4_p) :: ncpl_calc, cplid, nc
350 CHARACTER(len=*),
PARAMETER :: subname =
'oasis_get_freqs' 356 WRITE(
nulprt,*) subname,
estr,
'called on non coupling task' 364 WRITE(
nulprt,*) subname,
estr,
'Routine is called for an invalid varid' 370 IF (ncpl_calc /= ncpl)
THEN 371 WRITE(
nulprt,*) subname,
estr,
' Wrong number of couplings for variable: ',trim(vname), &
391 WRITE(
nulprt,*) subname,
' Coupling frequency of this field ',trim(vname),&
392 ' for coupling ',nc,
' is ',cpl_freqs(nc)
395 IF (cpl_freqs(nc) .le. 0)
THEN 396 WRITE(
nulprt,*) subname,
estr,
' The coupling frequency is < or equal to 0' 412 integer(kind=ip_i4_p) ,
intent(in) :: varid
413 integer(kind=ip_i4_p) ,
intent(in) :: msec
414 integer(kind=ip_i4_p) ,
intent(out) :: kinfo
416 character(len=ic_lvar) :: vname
417 INTEGER(kind=ip_i4_p) :: ncpl, nc, cplid
418 INTEGER(kind=ip_i4_p) :: lag, mseclag, trans, dt, getput, maxtime
419 LOGICAL :: time_now, sndrcv, output
420 character(len=*),
parameter :: subname =
'oasis_put_inquire' 426 WRITE(
nulprt,*) subname,
estr,
'called on non coupling task' 435 'Routine oasis_put is called for a variable not in namcouple: it will not be sent' 461 IF (abs(lag) > dt)
THEN 462 WRITE(
nulprt,*) subname,
estr,
' ERROR lag gt dt for cplid',cplid
471 WRITE(
nulprt,*) subname,
estr,
'routine can only be called for OASIS_PUT variable' 484 if (msec >= maxtime)
then 485 write(
nulprt,*) subname,
' at ',msec,mseclag,
' ERROR: ',trim(vname)
486 write(
nulprt,*) subname,
estr,
'model time beyond namcouple maxtime',&
492 IF (mod(mseclag,dt) == 0) time_now = .true.
498 IF (time_now .EQV. .true.)
THEN 501 WRITE(
nulprt,*) subname,
' Coupling time for : ',trim(vname)
502 WRITE(
nulprt,*) subname,
' Coupling time for var for nc : ',&
504 WRITE(
nulprt,*) subname,
' dt,msec,mseclag = ',dt,msec,mseclag
509 .OR. (trans ==
ip_min) )
THEN 512 WRITE(
nulprt,*) subname,
' status at ',msec,mseclag,
' WTRN ' 522 IF (mseclag >= maxtime)
THEN 523 IF (getput ==
oasis3_put .AND. lag > 0 .AND. mseclag == maxtime)
THEN 526 WRITE(
nulprt,*) subname,
' status at ',msec,mseclag,
' WRST ' 539 WRITE(
nulprt,*) subname,
' status at ',msec,mseclag,
' will be SENT ' 557 WRITE(
nulprt,*) subname,
' status at ',msec,mseclag,
' will be WRIT ' 567 IF (mseclag + dt >= maxtime .AND. &
570 WRITE(
nulprt,*) subname,
' at ',msec,mseclag,
' will be WTRN: ' 576 WRITE(
nulprt,*)
'Nothing to do' 581 WRITE(
nulprt,*) subname,
' kinfo: ',kinfo
integer(kind=ip_intwp_p), parameter oasis_sentout
subroutine, public oasis_debug_note(string)
Used to write information from a subroutine, write info to log file at some debug level...
Provides a common location for several OASIS variables.
Provides reusable IO routines for OASIS.
integer(kind=ip_intwp_p), parameter oasis_ok
integer(kind=ip_intwp_p), parameter oasis_in
integer(kind=ip_i4_p) mpi_size_local
Auxiliary OASIS user interfaces.
integer(kind=ip_intwp_p) nulprt
integer(kind=ip_i4_p) mpi_comm_global
type(prism_coupler_type), dimension(:), pointer, public prism_coupler_get
prism_coupler get array
integer(kind=ip_intwp_p), parameter ip_instant
subroutine, public oasis_get_intercomm(new_comm, cdnam, kinfo)
OASIS user interface to establish an intercomm communicator between the root of two models...
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
type(prism_coupler_type), dimension(:), pointer, public prism_coupler_put
prism_coupler put array
integer(kind=ip_intwp_p), parameter oasis_sent
integer(kind=ip_intwp_p), parameter oasis_torestout
subroutine, public oasis_get_intracomm(new_comm, cdnam, kinfo)
OASIS user interface to establish an intracomm communicator between the root of two models...
integer(kind=ip_intwp_p), parameter ip_min
integer(kind=ip_intwp_p), parameter oasis_torest
Initialize the OASIS coupler infrastructure.
integer(kind=ip_i4_p) mpi_rank_local
integer(kind=ip_intwp_p), parameter ip_accumul
integer(kind=ip_i4_p) prism_amodels
Provides a generic and simpler interface into MPI calls for OASIS.
subroutine, public oasis_set_couplcomm(localcomm, kinfo)
OASIS user call to specify a local communicator.
integer(kind=ip_intwp_p), parameter oasis3_get
subroutine, public oasis_set_debug(debug, kinfo)
OASIS user interface to set debug level.
integer(kind=ip_i4_p) mpi_root_local
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
integer(kind=ip_i4_p), dimension(mpi_status_size) istatus
subroutine, public oasis_get_freqs(varid, mop, ncpl, cpl_freqs, kinfo)
OASIS user query for the coupling periods for a given variable.
integer(kind=ip_intwp_p), parameter oasis3_put
integer(kind=ip_intwp_p), parameter oasis_output
integer(kind=ip_i4_p), dimension(:), allocatable mpi_root_global
subroutine, public oasis_get_ncpl(varid, ncpl, kinfo)
OASIS user query for the number of unique couplings associated with a variable.
integer(kind=ip_intwp_p), parameter ip_max
Defines parameters for OASIS.
integer(kind=ip_intwp_p), parameter oasis_loctrans
OASIS variable data and methods.
character(len=ic_lvar) compnm
integer(kind=ip_i4_p) oasis_debug
integer(kind=ip_intwp_p), parameter oasis_out
character(len= *), parameter, public estr
integer(kind=ip_i4_p) mpi_comm_local
subroutine, public oasis_get_debug(debug, kinfo)
OASIS user interface to query debug level.
integer(kind=ip_intwp_p), parameter ip_average
integer(kind=ip_intwp_p), parameter oasis_var_uncpl
subroutine, public oasis_get_localcomm(localcomm, kinfo)
OASIS user query for the local MPI communicator.
subroutine, public oasis_flush(nu)
Flushes output to file.
integer, parameter ip_intwp_p
subroutine, public oasis_put_inquire(varid, msec, kinfo)
OASIS user query to indicate put return code expected at a specified time for a given variable...
subroutine, public oasis_create_couplcomm(icpl, allcomm, cplcomm, kinfo)
OASIS user call to create a new communicator.
Performance timer methods.
type(prism_var_type), dimension(:), pointer, public prism_var
list of defined variables
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
character(len=ic_lvar), dimension(prism_mmodels) prism_modnam