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
58 localcomm = mpi_comm_local
59 IF (oasis_debug >= 2)
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
91 mpi_comm_local = localcomm
99 if (mpi_comm_local /= mpi_comm_null)
then
100 CALL mpi_comm_size(mpi_comm_local,mpi_size_local,ierr)
101 CALL mpi_comm_rank(mpi_comm_local,mpi_rank_local,ierr)
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
146 IF (oasis_debug >= 2)
THEN
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
198 if (oasis_debug >= 2)
then
199 write(nulprt,*) subname,
' set OASIS_debug to ',oasis_debug
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
218 integer(kind=ip_intwp_p) :: n, il, ierr, tag
221 character(len=*),
parameter :: subname =
'(oasis_get_intercomm)'
225 if (
present(kinfo))
then
230 do n = 1,prism_amodels
231 if (trim(cdnam) == trim(prism_modnam(n)))
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'
246 IF (oasis_debug >= 2)
THEN
247 WRITE(nulprt,*) subname,
'cdnam :',trim(cdnam),
' il :',il, &
248 'mpi_root_global(il) :',mpi_root_global(il),&
249 'mpi_comm_local :',mpi_comm_local
253 tag=ichar(trim(compnm))+ichar(trim(cdnam))
254 CALL mpi_intercomm_create(mpi_comm_local, 0, mpi_comm_global, &
255 mpi_root_global(il), tag, new_comm, ierr)
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
272 integer(kind=ip_intwp_p) :: tmp_intercomm
273 integer(kind=ip_intwp_p) :: ierr
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'
308 IF (mpi_comm_local == mpi_comm_null)
THEN
309 WRITE(nulprt,*) subname,estr,
'called on non coupling task'
314 vname = prism_var(varid)%name
316 IF (varid == oasis_var_uncpl)
THEN
317 WRITE(nulprt,*) subname,estr, &
318 'Routine is called for a variable not in namcouple: it will not be sent'
322 ncpl = prism_var(varid)%ncpl
325 IF (oasis_debug >= 2)
WRITE(nulprt,*) subname,
' Variable not coupled ',&
328 IF (oasis_debug >= 2)
WRITE(nulprt,*) subname,
' Variable: ',trim(vname),&
329 ' used in ',ncpl,
' couplings'
343 INTEGER(kind=ip_i4_p) ,
INTENT(in) :: varid
344 INTEGER(kind=ip_i4_p) ,
INTENT(in) :: mop
345 INTEGER(kind=ip_i4_p) ,
INTENT(in) :: ncpl
346 INTEGER(kind=ip_i4_p) ,
INTENT(out) :: cpl_freqs(ncpl)
347 INTEGER(kind=ip_i4_p) ,
INTENT(out) :: kinfo
349 CHARACTER(len=ic_lvar) :: vname
350 INTEGER(kind=ip_i4_p) :: ncpl_calc, cplid, nc
351 CHARACTER(len=*),
PARAMETER :: subname =
'oasis_get_freqs'
356 IF (mpi_comm_local == mpi_comm_null)
THEN
357 WRITE(nulprt,*) subname,estr,
'called on non coupling task'
362 vname = prism_var(varid)%name
364 IF (varid == oasis_var_uncpl)
THEN
365 WRITE(nulprt,*) subname,estr, &
366 'Routine is called for a variable not in namcouple: it will not be sent'
370 ncpl_calc = prism_var(varid)%ncpl
372 IF (ncpl_calc /= ncpl)
THEN
373 WRITE(nulprt,*) subname,estr,
' Wrong number of couplings for variable: ',trim(vname), &
379 IF (oasis_debug >= 2)
WRITE(nulprt,*) subname,
' variable not coupled ',&
384 cplid = prism_var(varid)%cpl(nc)
385 IF (mop == oasis_out)
THEN
386 cpl_freqs(nc) = prism_coupler_put(cplid)%dt
388 IF (mop == oasis_in )
THEN
389 cpl_freqs(nc) = prism_coupler_get(cplid)%dt
392 IF (oasis_debug >=2 )
THEN
393 WRITE(nulprt,*) subname,
' Coupling frequency of this field ',trim(vname),&
394 ' for coupling ',nc,
' is ',cpl_freqs(nc)
397 IF (cpl_freqs(nc) .le. 0)
THEN
398 WRITE(nulprt,*) subname,estr,
' The coupling frequency is < or equal to 0'
414 integer(kind=ip_i4_p) ,
intent(in) :: varid
415 integer(kind=ip_i4_p) ,
intent(in) :: msec
416 integer(kind=ip_i4_p) ,
intent(out) :: kinfo
418 character(len=ic_lvar) :: vname
419 INTEGER(kind=ip_i4_p) :: ncpl, nc, cplid
420 INTEGER(kind=ip_i4_p) :: lag, mseclag, trans, dt, getput, maxtime
421 LOGICAL :: time_now, sndrcv, output
422 character(len=*),
parameter :: subname =
'oasis_put_inquire'
427 IF (mpi_comm_local == mpi_comm_null)
THEN
428 WRITE(nulprt,*) subname,estr,
'called on non coupling task'
433 vname = prism_var(varid)%name
435 IF (varid == oasis_var_uncpl)
THEN
436 WRITE(nulprt,*) subname,estr, &
437 'Routine oasis_put is called for a variable not in namcouple: it will not be sent'
441 ncpl = prism_var(varid)%ncpl
444 IF (oasis_debug >= 2)
WRITE(nulprt,*) subname,
' variable not coupled ',&
450 cplid = prism_var(varid)%cpl(nc)
451 dt = prism_coupler_put(cplid)%dt
452 lag = prism_coupler_put(cplid)%lag
453 getput = prism_coupler_put(cplid)%getput
454 sndrcv = prism_coupler_put(cplid)%sndrcv
455 maxtime = prism_coupler_put(cplid)%maxtime
456 output = prism_coupler_put(cplid)%output
457 trans = prism_coupler_put(cplid)%trans
463 IF (abs(lag) > dt)
THEN
464 WRITE(nulprt,*) subname,estr,
' ERROR lag gt dt for cplid',cplid
472 IF (getput == oasis3_get)
THEN
473 WRITE(nulprt,*) subname,estr,
'routine can only be called for OASIS_PUT variable'
478 IF (getput == oasis3_put)
THEN
486 if (msec >= maxtime)
then
487 write(nulprt,*) subname,
' at ',msec,mseclag,
' ERROR: ',trim(vname)
488 write(nulprt,*) subname,estr,
'model time beyond namcouple maxtime',&
494 IF (mod(mseclag,dt) == 0) time_now = .true.
500 IF (time_now .EQV. .true.)
THEN
502 IF (oasis_debug >= 2)
THEN
503 WRITE(nulprt,*) subname,
' Coupling time for : ',trim(vname)
504 WRITE(nulprt,*) subname,
' Coupling time for var for nc : ',&
505 trim(mct_avect_exportrlist2c(prism_coupler_put(cplid)%avect1)),nc
506 WRITE(nulprt,*) subname,
' dt,msec,mseclag = ',dt,msec,mseclag
510 IF ( (trans == ip_average) .OR. (trans == ip_accumul) .OR. (trans == ip_max) &
511 .OR. (trans == ip_min) )
THEN
512 IF (kinfo == oasis_ok) kinfo = oasis_loctrans
513 IF (oasis_debug >= 2)
THEN
514 WRITE(nulprt,*) subname,
' status at ',msec,mseclag,
' WTRN '
524 IF (mseclag >= maxtime)
THEN
525 IF (getput == oasis3_put .AND. lag > 0 .AND. mseclag == maxtime)
THEN
527 IF (oasis_debug >= 2)
THEN
528 WRITE(nulprt,*) subname,
' status at ',msec,mseclag,
' WRST '
538 IF (getput == oasis3_put)
THEN
540 IF (oasis_debug >= 2)
THEN
541 WRITE(nulprt,*) subname,
' status at ',msec,mseclag,
' will be SENT '
551 IF (kinfo == oasis_sent)
THEN
552 kinfo = oasis_sentout
553 ELSEIF (kinfo == oasis_torest)
THEN
554 kinfo = oasis_torestout
558 IF (oasis_debug >= 2)
THEN
559 WRITE(nulprt,*) subname,
' status at ',msec,mseclag,
' will be WRIT '
569 IF (mseclag + dt >= maxtime .AND. &
570 getput == oasis3_put .and. trans /= ip_instant)
then
571 IF (oasis_debug >= 2)
THEN
572 WRITE(nulprt,*) subname,
' at ',msec,mseclag,
' will be WTRN: '
577 IF (oasis_debug >=2)
THEN
578 WRITE(nulprt,*)
'Nothing to do'
582 IF (oasis_debug >= 2)
THEN
583 WRITE(nulprt,*) subname,
' kinfo: ',kinfo
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
subroutine, public oasis_get_intracomm(new_comm, cdnam, kinfo)
OASIS user interface to establish an intracomm communicator between the root of two models...
subroutine, public oasis_get_intercomm(new_comm, cdnam, kinfo)
OASIS user interface to establish an intercomm communicator between the root of two models...
Provides a generic and simpler interface into MPI calls for OASIS.
subroutine, public oasis_set_debug(debug, kinfo)
OASIS user interface to set debug level.
subroutine, public oasis_get_localcomm(localcomm, kinfo)
OASIS user query for the local MPI communicator.
subroutine, public oasis_set_couplcomm(localcomm, kinfo)
OASIS user call to specify a local communicator.
subroutine, public oasis_get_debug(debug, kinfo)
OASIS user interface to query debug level.
Provides a common location for several OASIS variables.
subroutine, public oasis_get_freqs(varid, mop, ncpl, cpl_freqs, kinfo)
OASIS user query for the coupling periods for a given variable.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
subroutine, public oasis_debug_note(string)
Used to write information from a subroutine, write info to log file at some debug level...
subroutine, public oasis_flush(nu)
Flushes output to file.
Initialize the OASIS coupler infrastructure.
Auxiliary OASIS user interfaces.
Performance timer methods.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine, public oasis_create_couplcomm(icpl, allcomm, cplcomm, kinfo)
OASIS user call to create a new communicator.
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_get_ncpl(varid, ncpl, kinfo)
OASIS user query for the number of unique couplings associated with a variable.
Provides reusable IO routines for OASIS.
OASIS variable data and methods.
Defines parameters for OASIS.