32 integer(kind=ip_intwp_p),
parameter ::
debug=2
34 integer(kind=ip_intwp_p),
parameter ::
debug=1
51 INTEGER (kind=ip_intwp_p),
intent(out) :: mynummod
52 CHARACTER(len=*) ,
intent(in) :: cdnam
53 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
54 logical ,
intent(in) ,
optional :: coupled
55 integer (kind=ip_intwp_p),
intent(in) ,
optional :: commworld
57 integer(kind=ip_intwp_p) :: ierr
58 INTEGER(kind=ip_intwp_p) :: n,nns,iu
59 integer(kind=ip_intwp_p) :: icolor,ikey
60 CHARACTER(len=ic_med) :: filename,filename2
61 character(len=ic_med) :: pio_type
62 integer(kind=ip_intwp_p) :: pio_stride
63 integer(kind=ip_intwp_p) :: pio_root
64 integer(kind=ip_intwp_p) :: pio_numtasks
65 INTEGER(kind=ip_intwp_p),
ALLOCATABLE :: tmparr(:)
66 INTEGER(kind=ip_intwp_p) :: k,i,m,k1,k2
67 INTEGER(kind=ip_intwp_p) :: nt
68 INTEGER(kind=ip_intwp_p) :: nvar
69 INTEGER(kind=ip_intwp_p) :: mpi_size_world
70 INTEGER(kind=ip_intwp_p) :: mpi_rank_world
71 INTEGER(kind=ip_intwp_p) :: mall
73 character(len=ic_lvar),
pointer :: compnmlist(:)
74 logical,
pointer :: coupledlist(:)
75 character(len=ic_lvar) :: tmp_modnam
77 character(len=ic_lvar) :: i_name
78 character(len=*),
parameter :: subname =
'(oasis_init_comp)' 80 character(len=MPI_MAX_PROCESSOR_NAME),
dimension(:),
allocatable :: cla_nodes
81 character(len=MPI_MAX_PROCESSOR_NAME) :: cl_node
83 integer,
dimension(:),
allocatable :: ila_colors
86 if (
present(kinfo))
then 92 if (
present(coupled))
then 97 if (
present(commworld))
then 108 if (
oasis_debug >= 10)
WRITE (0,fmt=
'(A)') subname//
': Calling MPI_Init' 109 CALL mpi_init ( ierr )
111 if (
oasis_debug >= 10)
WRITE (0,fmt=
'(A)') subname//
': Not Calling MPI_Init' 117 #elif defined use_comm_MPI2 133 IF (mpi_rank_world == 0)
THEN 136 WRITE(filename,
'(a,i6.6)')
'nout.',mpi_rank_world
147 IF (mpi_rank_world == 0)
THEN 151 IF (mpi_rank_world /= 0)
THEN 170 IF (mpi_rank_world == 0)
THEN 172 'The models are not exchanging any field ($NFIELDS = 0) ' 173 WRITE (unit =
nulprt1,fmt = *) &
174 'so we force OASIS_debug = 0 for all processors ' 191 IF (mpi_rank_world == 0)
THEN 192 WRITE (unit =
nulprt1,fmt = *)
'Total number of coupling fields :',
maxvar 215 WRITE(
nulprt1,*) subname,
estr,
'namcouple fields do not agree in number' 218 WRITE(
nulprt1,*) subname,
estr,
'check your namcouple file ' 231 IF (
oasis_debug >= 15 .and. mpi_rank_world == 0)
THEN 233 WRITE (unit =
nulprt1,fmt = *) subname,
'Coupling fields namsrcfld:',&
235 WRITE (unit =
nulprt1,fmt = *) subname,
'Coupling fields namdstfld:',&
245 if (len_trim(cdnam) >
ic_lvar)
then 246 WRITE(
nulprt1,*) subname,
estr,
'model name too long = ',trim(cdnam)
258 allocate(compnmlist(mpi_size_world))
259 allocate(coupledlist(mpi_size_world))
266 if (mpi_rank_world == 0)
then 268 do n = 1,mpi_size_world
269 write(
nulprt1,*) subname,
' compnm gather ',n,trim(compnmlist(n)),coupledlist(n)
276 do n = 1,mpi_size_world
284 WRITE(
nulprt1,*) subname,
estr,
'inconsistent coupled flag' 285 WRITE(
nulprt1,*) subname,
estr,
'the optional argument, coupled' 286 WRITE(
nulprt1,*) subname,
estr,
'must be identical on all tasks of a component.' 294 WRITE(
nulprt1,*) subname,
estr,
'prism_nmodels too large, increase prism_mmodels in mod_oasis_data' 338 deallocate(compnmlist)
339 deallocate(coupledlist)
358 IF (mpi_rank_world == 0)
THEN 359 WRITE(
nulprt1,*) subname,
'cdnam :',trim(cdnam),
' mynummod :',mynummod
365 WRITE(
nulprt1,*) subname,
estr,
'prism_modnam internal inconsistency = ',trim(cdnam)
395 #elif defined use_comm_MPI2 409 ' With LUCIA load balance analysis ' 410 WRITE (unit =
nulprt1,fmt = *) &
411 ' we set OASIS_debug = 0 ' 416 IF (mpi_rank_world == 0)
CLOSE(
nulprt1)
446 ALLOCATE(cla_nodes(1))
447 ALLOCATE(ila_colors(1))
450 CALL mpi_gather (
mpi_node_name,mpi_max_processor_name,mpi_char,&
451 & cla_nodes, mpi_max_processor_name,mpi_char,&
458 DO WHILE (any(ila_colors == -1))
459 cl_node = cla_nodes(minloc(ila_colors,dim=1))
460 ila_colors(minloc(ila_colors,dim=1)) = 1
462 IF (ila_colors(i) == -1 .AND. cla_nodes(i) == cl_node)&
469 CALL mpi_scatter (ila_colors,1,mpi_int,&
470 & icolor, 1,mpi_int,&
494 DEALLOCATE(cla_nodes)
495 DEALLOCATE(ila_colors)
498 #elif defined use_comm_MPI2 512 WRITE(filename ,
'(a,i2.2)')
'debug.root.',
compid 513 WRITE(filename2,
'(a,i2.2)')
'debug.notroot.',
compid 515 OPEN(
nulprt,file=filename,status=
'REPLACE')
516 WRITE(
nulprt,
'(2a,2i8)') subname,
' OASIS RUNNING ' 521 OPEN(
nulprt,file=filename2,status=
'REPLACE')
522 WRITE(
nulprt,
'(2a,2i8)') subname,
' OASIS RUNNING ' 530 OPEN(
nulprt,file=filename2,position=
'APPEND')
537 OPEN(
nulprt,file=filename,status=
'REPLACE')
545 WRITE(
nulprt,
'(3a,i8)') subname,
' model compid ',trim(cdnam),
compid 566 OPEN(
nullucia,file=filename,status=
'REPLACE')
590 call oasis_ioshr_init(
mpi_comm_local,pio_type,pio_stride,pio_root,pio_numtasks)
635 write(
nulprt,*) subname,
' n,prism_model,root = ',&
645 WRITE(
nullucia, fmt=
'(A,F16.5)')
'Balance: IT ', mpi_wtime()
666 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
668 integer(kind=ip_intwp_p) :: ierr
669 character(len=*),
parameter :: subname =
'(oasis_terminate)' 678 if (
present(kinfo))
then 695 WRITE (
nulprt,fmt=
'(A)') subname//
': Calling MPI_Finalize' 698 CALL mpi_finalize ( ierr )
701 WRITE (
nulprt,fmt=
'(A)') subname//
': Not Calling MPI_Finalize' 714 WRITE(
nulprt,*) subname,
' SUCCESSFUL RUN' 733 INTEGER (kind=ip_intwp_p),
intent(inout),
optional :: kinfo
735 integer (kind=ip_intwp_p) :: n
736 integer (kind=ip_intwp_p) :: lkinfo
737 integer (kind=ip_intwp_p) :: icpl, ierr
738 integer (kind=ip_intwp_p) :: newcomm
739 logical,
parameter :: local_timers_on = .false.
740 character(len=*),
parameter :: subname =
'(oasis_enddef)' 766 write(
nulprt,*) subname,
estr,
'enddef called already' 769 enddef_called = .true.
825 write(
nulprt,*) subname,
' n,prism_model,root = ',&
880 WRITE(
nulprt,*) subname,
' done mct_world_init ' 892 WRITE(
nulprt,*) subname,
' done prism_coupler_setup ' 907 WRITE(
nulprt,*) subname,
' done prism_advance_init ' 920 if (
present(kinfo))
then 940 INTEGER(kind=ip_intwp_p) :: n, ierr
941 INTEGER(kind=ip_intwp_p),
ALLOCATABLE :: tmparr(:)
942 character(len=*),
parameter :: subname =
'(oasis_setrootglobal)' 948 if (
allocated(mpi_root_global))
then 949 deallocate(mpi_root_global)
951 allocate(mpi_root_global(prism_amodels))
952 allocate(tmparr(prism_amodels))
954 do n = 1,prism_amodels
955 if (compid == n .and. mpi_rank_local == mpi_root_local)
then 956 tmparr(n) = mpi_rank_global
959 call oasis_mpi_max(tmparr,mpi_root_global,mpi_comm_global, &
960 string=subname//
':mpi_root_global',all=.true.)
963 do n = 1,prism_amodels
964 IF (mpi_root_global(n) < 0)
THEN 965 WRITE(nulprt,*) subname,estr,
'global root invalid, check couplcomm for active tasks' 966 call oasis_abort(file=__file__,line=__line__)
character(len=jpeighty), dimension(:), pointer, public namsrcfld
list of src fields
Provides a common location for several OASIS variables.
integer(kind=ip_i4_p), public namuntmin
namcouple min IO unit value
integer(kind=ip_i4_p), public nnamcpl
number of namcouple inputs
integer(kind=ip_i4_p), public namtlogprt
namcouple ntlogprt value
integer(kind=ip_i4_p) mpi_comm_map
integer(kind=ip_intwp_p), parameter oasis_ok
subroutine, public oasis_mem_print(iunit, string)
Print memory use.
integer(kind=ip_i4_p) lucia_debug
Provides methods for querying memory use.
subroutine, public oasis_init_comp(mynummod, cdnam, kinfo, coupled, commworld)
OASIS user init method.
integer(kind=ip_i4_p) mpi_rank_map
integer(kind=ip_i4_p) mpi_size_local
subroutine, public oasis_write2files()
Interface that actually writes fields to grid files.
integer(kind=ip_i4_p) size_namfld
integer(kind=ip_intwp_p) nulprt
Generic overloaded interface into MPI broadcast.
logical, dimension(prism_mmodels) prism_modcpl
integer(kind=ip_i4_p) mpi_root_map
integer(kind=ip_i4_p) mpi_comm_global
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
integer(kind=ip_intwp_p) nulprt1
character(len=jpeighty), dimension(:), pointer, public namdstfld
list of dst fields
subroutine, public oasis_string_listgetname(list, k, name, rc)
Get name of k-th field in list.
integer(kind=ip_i4_p), public namlogprt
namcouple nlogprt value
subroutine, public oasis_mem_init(iunit)
Initialize memory conversion to MB.
integer(kind=ip_i4_p) compid
subroutine, public oasis_timer_init(app, file, nt)
Initializes the timer methods, called once in an application.
integer(kind=ip_intwp_p), parameter debug
Initialize the OASIS coupler infrastructure.
integer(kind=ip_i4_p) mpi_rank_local
integer(kind=ip_i4_p) mpi_size_global
integer(kind=ip_i4_p) prism_amodels
Character string manipulation methods.
integer(kind=ip_intwp_p) nullucia
Provides a generic and simpler interface into MPI calls for OASIS.
character(len=ic_lvar), dimension(:), pointer total_namsrcfld
integer(kind=ip_i4_p) prism_nmodels
subroutine, public oasis_terminate(kinfo)
OASIS user finalize method.
logical, parameter local_timers_on
subroutine, public oasis_namcouple_init()
Reads the namcouple.
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), public namuntmax
namcouple max IO unit value
character(len=mpi_max_processor_name) mpi_node_name
OASIS partition data and methods.
integer(kind=ip_i4_p) mpi_rank_global
subroutine, public oasis_advance_init(kinfo)
Initializes the OASIS fields.
subroutine, public oasis_unitsetmin(uio)
Set the minimum unit number allowed.
integer(kind=ip_i4_p), dimension(:), allocatable mpi_root_global
OASIS grid data and methods.
Defines parameters for OASIS.
subroutine, public oasis_timer_print(timer_label)
Print timers.
character(len=ic_lvar), dimension(:), pointer total_namdstfld
OASIS variable data and methods.
character(len=ic_lvar) compnm
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
integer(kind=ip_i4_p) oasis_debug
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
character(len= *), parameter, public estr
integer(kind=ip_i4_p) mpi_comm_local
integer(kind=ip_intwp_p) mpi_comm_global_world
integer function, public oasis_string_listgetnum(str)
return number of fields in string list
subroutine, public oasis_mpi_barrier(comm, string)
Call MPI_BARRIER for a particular communicator.
integer(kind=ip_i4_p), dimension(:), pointer, public namsort2nn
sorted namcpl for sort, define nn order, computed later
subroutine, public oasis_part_setup()
Synchronize partitions across all tasks, called at oasis enddef.
integer, parameter ic_lvar
subroutine, public oasis_unitget(uio)
Get a free unit number.
subroutine, public oasis_enddef(kinfo)
OASIS user interface specifying the OASIS definition phase is complete.
integer(kind=ip_i4_p), parameter prism_mmodels
logical, public allow_no_restart
flag to allow no restart files at startup
subroutine mod_oasis_setrootglobal()
Local method to compute each models' global task ids, exists for reuse in enddef. ...
Advances the OASIS coupling.
subroutine, public oasis_flush(nu)
Flushes output to file.
IO interfaces based on pio (not supported yet)
subroutine oasis_data_zero()
subroutine, public oasis_coupler_setup()
Main routine to setup couplers.
Performance timer methods.
subroutine, public oasis_var_setup()
Synchronize variables across all tasks, called at oasis enddef.
integer(ip_intwp_p), public maxvar
number of potential variables, derived from namcouple input
type(prism_var_type), dimension(:), pointer, public prism_var
list of defined variables
Reads the namcouple file for use in OASIS.
High level OASIS user interfaces.
subroutine, public oasis_unitsetmax(uio)
Set the maximum unit number allowed.
logical, public namnorest
namcouple allow no restarts
integer(kind=ip_i4_p) mpi_size_map
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
integer(kind=ip_i4_p) timer_debug
character(len= *), parameter, public wstr