Oasis3-MCT
 All Classes Files Functions Variables Macros Pages
mod_oasis_method.F90
Go to the documentation of this file.
1 
2 !> High level OASIS user interfaces
3 
5 
7  USE mod_oasis_mem
8  USE mod_oasis_sys
12  USE mod_oasis_part
13  USE mod_oasis_var
16  USE mod_oasis_timer
17  USE mod_oasis_ioshr
18  USE mod_oasis_grid
19  USE mod_oasis_mpi
21  USE mct_mod
22 
23  IMPLICIT NONE
24 
25  private
26 
27  public oasis_init_comp
28  public oasis_terminate
29  public oasis_enddef
30 
31 #ifdef __VERBOSE
32  integer(kind=ip_intwp_p),parameter :: debug=2
33 #else
34  integer(kind=ip_intwp_p),parameter :: debug=1
35 #endif
36  logical,save :: lg_mpiflag
37 
38 CONTAINS
39 
40 !----------------------------------------------------------------------
41 
42 !> OASIS user init method
43 
44  SUBROUTINE oasis_init_comp(mynummod,cdnam,kinfo,coupled)
45 
46  !> * This is COLLECTIVE, all pes must call
47 
48  IMPLICIT NONE
49 
50  INTEGER (kind=ip_intwp_p),intent(out) :: mynummod !< component model ID
51  CHARACTER(len=*) ,intent(in) :: cdnam !< model name
52  INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo !< return code
53  logical ,intent(in) ,optional :: coupled !< flag to specify whether this component is coupled in oasis
54 ! ---------------------------------------------------------
55  integer(kind=ip_intwp_p) :: ierr
56  INTEGER(kind=ip_intwp_p) :: n,nns,iu
57  integer(kind=ip_intwp_p) :: icolor,ikey
58  CHARACTER(len=ic_med) :: filename,filename2
59  character(len=ic_med) :: pio_type
60  integer(kind=ip_intwp_p) :: pio_stride
61  integer(kind=ip_intwp_p) :: pio_root
62  integer(kind=ip_intwp_p) :: pio_numtasks
63  INTEGER(kind=ip_intwp_p),ALLOCATABLE :: tmparr(:)
64  INTEGER(kind=ip_intwp_p) :: k,i,m,k1,k2
65  INTEGER(kind=ip_intwp_p) :: nt
66  INTEGER(kind=ip_intwp_p) :: nvar
67  INTEGER(kind=ip_intwp_p) :: mpi_size_world
68  INTEGER(kind=ip_intwp_p) :: mpi_rank_world
69  INTEGER(kind=ip_intwp_p) :: mall
70  logical :: found
71  character(len=ic_lvar),pointer :: compnmlist(:)
72  logical,pointer :: coupledlist(:)
73  character(len=ic_lvar) :: tmp_modnam
74  logical :: tmp_modcpl
75  character(len=ic_lvar) :: i_name
76  character(len=*),parameter :: subname = '(oasis_init_comp)'
77 ! ---------------------------------------------------------
78 
79  if (present(kinfo)) then
80  kinfo = oasis_ok
81  endif
82  call oasis_data_zero()
83 
84  oasis_coupled = .true.
85  if (present(coupled)) then
86  oasis_coupled = coupled
87  endif
88 
89  !------------------------
90  !> * Initialize MPI
91  !------------------------
92 
93  lg_mpiflag = .false.
94  CALL mpi_initialized( lg_mpiflag, ierr )
95  IF ( .NOT. lg_mpiflag ) THEN
96  if (oasis_debug >= 0) WRITE (0,fmt='(A)') subname//': Calling MPI_Init'
97  CALL mpi_init( ierr )
98  else
99  if (oasis_debug >= 0) WRITE (0,fmt='(A)') subname//': Not Calling MPI_Init'
100  ENDIF
101 
102 ! Initial default for early part of init
103 #ifdef use_comm_MPI1
104  mpi_comm_global = mpi_comm_world
105 #elif defined use_comm_MPI2
106  mpi_comm_global = ??
107 #endif
108 
109  CALL mpi_comm_size(mpi_comm_world,mpi_size_world,ierr)
110  CALL mpi_comm_rank(mpi_comm_world,mpi_rank_world,ierr)
111  mpi_rank_global = mpi_rank_world
112 
113  !------------------------
114  !> * Set initial output file, need mpi_rank_world
115  !------------------------
116 
117  iu=-1
118 
119  call oasis_unitsetmin(1024)
120  IF (mpi_rank_world == 0) THEN
121  CALL oasis_unitget(iu)
122  nulprt1 = iu
123  WRITE(filename,'(a,i6.6)') 'nout.',mpi_rank_world
124  OPEN(nulprt1,file=filename)
125  ENDIF
126 
127  !------------------------
128  !> * Initialize namcouple.
129  !> First on rank 0 to write error messages
130  !> then on all other ranks. All tasks will
131  !> read the namcouple file independently.
132  !------------------------
133 
134  IF (mpi_rank_world == 0) THEN
135  call oasis_namcouple_init()
136  endif
137  call oasis_mpi_barrier(mpi_comm_world)
138  IF (mpi_rank_world /= 0) THEN
139  call oasis_namcouple_init()
140  endif
141  oasis_debug = namlogprt
142  timer_debug = namtlogprt
143 
144  ! If TIMER_debug < 0 activate LUCIA load balancing analysis
145  lucia_debug = abs(min(namtlogprt,0))
146 
147  !------------------------
148  !> * Check if NFIELDS=0, there is no coupling.
149  ! No information must be written in the debug files as
150  ! the different structures are not allocated
151  !------------------------
152 
153  IF ( nnamcpl == 0 ) THEN
154  IF (mpi_rank_world == 0) THEN
155  WRITE (unit = nulprt1,fmt = *) subname,wstr, &
156  'The models are not exchanging any field ($NFIELDS = 0) '
157  WRITE (unit = nulprt1,fmt = *) &
158  'so we force OASIS_debug = 0 for all processors '
159  oasis_debug = 0
160  CALL oasis_flush(nulprt1)
161  ENDIF
162  ENDIF
163 
164  !------------------------
165  !> * Determine the total number of coupling fields from namcouple.
166  !> Set maxvar parameter and allocate prism_var.
167  ! to avoid a parameter in oasis_def_var and mod_oasis_coupler
168  !------------------------
169 
170  size_namfld=0
171  DO n = 1,nnamcpl
172  size_namfld = size_namfld + oasis_string_listgetnum(namsrcfld(n))
173  ENDDO
174  maxvar = size_namfld * 2 ! multiply by 2 to allow sending to self
175  IF (mpi_rank_world == 0) THEN
176  WRITE (unit = nulprt1,fmt = *) 'Total number of coupling fields :',maxvar
177  CALL oasis_flush(nulprt1)
178  ENDIF
179 
180  ALLOCATE(prism_var(maxvar))
181 
182  !------------------------
183  !> * Store all the names of the fields exchanged in the namcouple
184  ! which can be different of namsrcfld(:) and namdstfld(:) if multiple
185  ! fields are exchanged together
186  !------------------------
187 
188  ALLOCATE(total_namsrcfld(size_namfld))
189  ALLOCATE(total_namdstfld(size_namfld))
190  total_namsrcfld = ''
191  total_namdstfld = ''
192 
193  m=0
194  DO nns = 1,nnamcpl
195  n = namsort2nn(nns)
196  k1=oasis_string_listgetnum(namsrcfld(n))
197  k2=oasis_string_listgetnum(namdstfld(n))
198  if (k1 /= k2) then
199  WRITE(nulprt,*) subname,estr,'namcouple field numbers do not agree '
200  WRITE(nulprt,*) subname,estr,'namsrcfld = ',trim(namsrcfld(n))
201  WRITE(nulprt,*) subname,estr,'namdstfld = ',trim(namdstfld(n))
202  call oasis_abort()
203  endif
204  DO i=1,k1
205  m=m+1
206  CALL oasis_string_listgetname(namsrcfld(n),i,i_name)
207  total_namsrcfld(m)=trim(i_name)
208  CALL oasis_string_listgetname(namdstfld(n),i,i_name)
209  total_namdstfld(m)=trim(i_name)
210  ENDDO
211  ENDDO
212  nvar = m
213 
214  IF (oasis_debug >= 15 .and. mpi_rank_world == 0) THEN
215  DO m=1,nvar
216  WRITE (unit = nulprt1,fmt = *) subname,'Coupling fields namsrcfld:',&
217  trim(total_namsrcfld(m))
218  WRITE (unit = nulprt1,fmt = *) subname,'Coupling fields namdstfld:',&
219  trim(total_namdstfld(m))
220  CALL oasis_flush(nulprt1)
221  ENDDO
222  ENDIF
223 
224  !------------------------
225  ! check (not needed anymore)
226  !------------------------
227 
228  if (len_trim(cdnam) > ic_lvar) then
229  WRITE(nulprt1,*) subname,estr,'model name too long = ',trim(cdnam)
230  write(nulprt1,*) subname,estr,'max model name length = ',ic_lvar
231  call oasis_abort()
232  endif
233 
234  !------------------------
235  !> * Gather model names from all tasks to generate active model list on all tasks.
236  !--- Check that the coupled flag from all tasks is consistent for a given model or abort
237  !--- Size of compnm is ic_lvar
238  !------------------------
239 
240  compnm = trim(cdnam)
241  allocate(compnmlist(mpi_size_world))
242  allocate(coupledlist(mpi_size_world))
243  call mpi_gather(compnm, ic_lvar, mpi_character, compnmlist, ic_lvar, mpi_character, 0, mpi_comm_world, ierr)
244  call mpi_gather(oasis_coupled, 1, mpi_logical, coupledlist, 1, mpi_logical, 0, mpi_comm_world, ierr)
245 
246  prism_nmodels = 0
247  prism_modnam(:) = ' '
248  prism_modcpl(:) = .false.
249  if (mpi_rank_world == 0) then
250  if (oasis_debug >= 15) then
251  do n = 1,mpi_size_world
252  write(nulprt1,*) subname,' compnm gather ',n,trim(compnmlist(n)),coupledlist(n)
253  call oasis_flush(nulprt1)
254  enddo
255  endif
256 
257  !--- generate unique list of models and coupling status
258  !--- check for coupled flag consistency
259  do n = 1,mpi_size_world
260  found = .false.
261  m = 0
262  do while (.not.found .and. m < prism_nmodels)
263  m = m + 1
264  if (compnmlist(n) == prism_modnam(m)) then
265  found = .true.
266  if (coupledlist(n) .neqv. prism_modcpl(m)) then
267  WRITE(nulprt1,*) subname,estr,'inconsistent coupled flag in oasis_init_comp.'
268  WRITE(nulprt1,*) subname,estr,'the optional argument, coupled, in oasis_init_comp '
269  WRITE(nulprt1,*) subname,estr,'must be identical on all tasks of a component.'
270  call oasis_abort()
271  endif
272  endif
273  enddo
274  if (.not.found) then
275  prism_nmodels = prism_nmodels + 1
276  if (prism_nmodels > prism_mmodels) then
277  WRITE(nulprt1,*) subname,estr,'prism_nmodels too large, increase prism_mmodels in mod_oasis_data'
278  call oasis_abort()
279  endif
280  prism_modnam(prism_nmodels) = trim(compnmlist(n))
281  prism_modcpl(prism_nmodels) = coupledlist(n)
282  endif
283  enddo
284 
285  !--- sort so coupled are first, uncoupled are last
286  !--- makes using only active models via "prism_amodels" easier
287  prism_amodels = prism_nmodels
288  do n = prism_nmodels,1,-1
289  if (.not.prism_modcpl(n)) then
290  tmp_modnam = prism_modnam(n)
291  tmp_modcpl = prism_modcpl(n)
292  do m = n,prism_nmodels-1
293  prism_modnam(m) = prism_modnam(m+1)
294  prism_modcpl(m) = prism_modcpl(m+1)
295  enddo
296  prism_modnam(prism_nmodels) = tmp_modnam
297  prism_modcpl(prism_nmodels) = tmp_modcpl
298  prism_amodels = prism_amodels - 1
299  endif
300  enddo
301 
302  !--- document and check list
303  do n = 1,prism_amodels
304  write(nulprt1,*) subname,' COUPLED models ',n,trim(prism_modnam(n)),prism_modcpl(n)
305  if (.not.prism_modcpl(n)) then
306  WRITE(nulprt1,*) subname,estr,'model expected to be coupled but is not = ',trim(prism_modnam(n))
307  CALL oasis_abort()
308  endif
309  call oasis_flush(nulprt1)
310  enddo
311  do n = prism_amodels+1,prism_nmodels
312  write(nulprt1,*) subname,' UNCOUPLED models ',n,trim(prism_modnam(n)),prism_modcpl(n)
313  if (prism_modcpl(n)) then
314  WRITE(nulprt1,*) subname,estr,'model expected to be uncoupled but is not = ',trim(prism_modnam(n))
315  CALL oasis_abort()
316  endif
317  call oasis_flush(nulprt1)
318  enddo
319  endif
320 
321  deallocate(compnmlist)
322  deallocate(coupledlist)
323 
324  !------------------------
325  !> * Broadcast the model list to all MPI tasks
326  !------------------------
327  call oasis_mpi_bcast(prism_nmodels,mpi_comm_world,subname//' prism_nmodels')
328  call oasis_mpi_bcast(prism_amodels,mpi_comm_world,subname//' prism_amodels')
329  call oasis_mpi_bcast(prism_modnam ,mpi_comm_world,subname//' prism_modnam')
330  call oasis_mpi_bcast(prism_modcpl ,mpi_comm_world,subname//' prism_modcpl')
331 
332  !------------------------
333  !> * Compute compid
334  !------------------------
335 
336  compid = -1
337  do n = 1,prism_nmodels
338  if (trim(cdnam) == trim(prism_modnam(n))) compid = n
339  enddo
340  mynummod = compid
341  IF (mpi_rank_world == 0) THEN
342  WRITE(nulprt1,*) subname, 'cdnam :',trim(cdnam),' mynummod :',mynummod
343  CALL oasis_flush(nulprt1)
344  ENDIF
345 
346 ! tcraig, this should never happen based on logic above
347  if (compid < 0) then
348  WRITE(nulprt1,*) subname,estr,'prism_modnam internal inconsistency = ',trim(cdnam)
349  CALL oasis_abort()
350  endif
351 
352  !------------------------
353  !> * Re-Set MPI info based on active model tasks
354  ! (need compid for MPI1 COMM_SPLIT)
355  !------------------------
356 
357  mpi_rank_global = -1
358 #ifdef use_comm_MPI1
359 
360  !------------------------
361  !> * Set mpi_comm_local based on compid
362  !------------------------
363 
364  ikey = 0
365  icolor = compid
366  call mpi_comm_split(mpi_comm_world,icolor,ikey,mpi_comm_local,ierr)
367 
368  !------------------------
369  !> * Set mpi_comm_global based on oasis_coupled flag
370  !------------------------
371 
372  ikey = 0
373  icolor = 1
374  if (.not.oasis_coupled) icolor = 0
375  call mpi_comm_split(mpi_comm_world,icolor,ikey,mpi_comm_global,ierr)
376 !tcx if (.not.oasis_coupled) mpi_comm_global = MPI_COMM_NULL
377 
378 #elif defined use_comm_MPI2
379 
380  mpi_comm_global = ??
381  mpi_comm_local = mpi_comm_world
382 
383 #endif
384 
385  !------------------------
386  !> * Reset debug levels
387  ! verbose level disabled if load balance analysis
388  !------------------------
389 
390  IF ( lucia_debug > 0 .AND. oasis_debug > 0 ) THEN
391  WRITE (unit = nulprt1,fmt = *) subname,wstr, &
392  ' With LUCIA load balance analysis '
393  WRITE (unit = nulprt1,fmt = *) &
394  ' we set OASIS_debug = 0 '
395  oasis_debug = 0
396  CALL oasis_flush(nulprt1)
397  ENDIF
398 
399  IF (mpi_rank_world == 0) CLOSE(nulprt1)
400 
401  if (.not.oasis_coupled) then
402  return
403  endif
404 
405  CALL mpi_comm_size(mpi_comm_global,mpi_size_global,ierr)
406  CALL mpi_comm_rank(mpi_comm_global,mpi_rank_global,ierr)
407 
408  CALL mpi_comm_size(mpi_comm_local,mpi_size_local,ierr)
409  CALL mpi_comm_rank(mpi_comm_local,mpi_rank_local,ierr)
410  mpi_root_local = 0
411 
412  !------------------------
413  !> * Open log files
414  !------------------------
415 
416  iu=-1
417  CALL oasis_unitget(iu)
418 
419  IF (oasis_debug <= 1) THEN
420  CALL oasis_mpi_bcast(iu,mpi_comm_local,trim(subname)//':unit of master',0)
421  IF (mpi_rank_local == 0) THEN
422  nulprt=iu
423  WRITE(filename,'(a,i2.2)') 'debug.root.',compid
424  OPEN(nulprt,file=filename)
425  WRITE(nulprt,*) subname,' OPEN debug file for root pe, unit :',nulprt
426  call oasis_flush(nulprt)
427  ELSE
428  nulprt=iu+mpi_size_global
429  WRITE(filename2,'(a,i2.2)') 'debug.notroot.',compid
430  OPEN(nulprt,file=filename2,position='append')
431 ! WRITE(nulprt,*) subname,' OPEN debug file for not root pe, unit :',nulprt
432 ! CALL oasis_flush(nulprt)
433  ENDIF
434  ELSE
435  nulprt=iu
436  WRITE(filename,'(a,i2.2,a,i6.6)') 'debug.',compid,'.',mpi_rank_local
437  OPEN(nulprt,file=filename)
438  WRITE(nulprt,*) subname,' OPEN debug file, unit :',nulprt
439  CALL oasis_flush(nulprt)
440  ENDIF
441 
442  IF ( (oasis_debug == 1) .AND. (mpi_rank_local == 0)) oasis_debug=10
443 
444  IF (oasis_debug >= 2) THEN
445  WRITE(nulprt,*) subname,' model compid ',trim(cdnam),compid
446  CALL oasis_flush(nulprt)
447  ENDIF
448 
449  iu=-1
450  CALL oasis_unitget(iu)
451 
452  ! If load balance analysis, new log files opened (lucia.*)
453  IF ( lucia_debug > 0 ) THEN
454  IF (mpi_size_local < 20 ) THEN
455  nullucia=iu
456  ! Open LUCIA log file on a subset of process only
457  ELSE IF (mpi_size_local < 100 .AND. mod(mpi_rank_local,mpi_size_local/5) == 0 ) THEN
458  nullucia=iu
459  ELSE IF (mpi_size_local >= 100 .AND. mod(mpi_rank_local,mpi_size_local/20) == 0 ) THEN
460  nullucia=iu
461  ELSE
462  nullucia = 0
463  ENDIF
464  ! Define log file name and open it
465  IF (nullucia /= 0) THEN
466  WRITE(filename,'(a,i2.2,a,i6.6)') 'lucia.',compid,'.',mpi_rank_local
467  OPEN(nullucia,file=filename)
468 ! WRITE(nullucia,*) subname,' OPEN LUCIA load balancing analysis file, unit :',nullucia
469 ! CALL oasis_flush(nullucia)
470  ENDIF
471  ENDIF
472 
473  call oasis_debug_enter(subname)
474 
475  !------------------------
476  !> * Set mpi_root_global
477  ! (after nulprt set)
478  !------------------------
479 
481 
482  !------------------------
483  !--- PIO
484  !------------------------
485 #if (PIO_DEFINED)
486 ! tcraig, not working as of Oct 2011
487  pio_type = 'netcdf'
488  pio_stride = -99
489  pio_root = -99
490  pio_numtasks = -99
491  call oasis_ioshr_init(mpi_comm_local,pio_type,pio_stride,pio_root,pio_numtasks)
492 #endif
493 
494  !------------------------
495  !> * Memory Initialization
496  !------------------------
497 
498  call oasis_mem_init(nulprt)
499  call oasis_mem_print(nulprt,subname)
500 
501  !------------------------
502  !> * Timer Initialization
503  !------------------------
504 
505  ! Allocate timer memory based on maxvar
506  nt = 7*maxvar+30
507  call oasis_timer_init(trim(cdnam), trim(cdnam)//'.timers',nt)
508  call oasis_timer_start('total')
509  call oasis_timer_start('init_thru_enddef')
510 
511  !------------------------
512  !> * Diagnostics
513  !------------------------
514 
515  if (oasis_debug >= 15) then
516  write(nulprt,*) subname,' compid = ',compid
517  write(nulprt,*) subname,' compnm = ',trim(compnm)
518  write(nulprt,*) subname,' mpi_comm_world = ',mpi_comm_world
519  write(nulprt,*) subname,' mpi_comm_global= ',mpi_comm_global
520  write(nulprt,*) subname,' size_global= ',mpi_size_global
521  write(nulprt,*) subname,' rank_global= ',mpi_rank_global
522  write(nulprt,*) subname,' mpi_comm_local = ',mpi_comm_local
523  write(nulprt,*) subname,' size_local = ',mpi_size_local
524  write(nulprt,*) subname,' rank_local = ',mpi_rank_local
525  write(nulprt,*) subname,' root_local = ',mpi_root_local
526  write(nulprt,*) subname,' OASIS_debug = ',oasis_debug
527  do n = 1,prism_amodels
528  write(nulprt,*) subname,' n,prism_model,root = ',&
529  n,trim(prism_modnam(n)),mpi_root_global(n)
530  enddo
531  call oasis_flush(nulprt)
532  endif
533 
534  IF ( lucia_debug > 0 ) THEN
535  ! We stop all process to read clock time (almost) synchroneously
536  call oasis_mpi_barrier(mpi_comm_global)
537  IF ( nullucia /= 0 ) THEN
538  WRITE(nullucia, fmt='(A,F16.5)') 'Balance: IT ', mpi_wtime()
539  WRITE(nullucia, fmt='(A12,A)' ) 'Balance: MD ', trim(compnm)
540  call oasis_flush(nullucia)
541  ELSE
542  ! Since now, non printing process do not participate to load balance analysis
543  lucia_debug = 0
544  ENDIF
545  ENDIF
546 
547  call oasis_debug_exit(subname)
548 
549  END SUBROUTINE oasis_init_comp
550 
551 !----------------------------------------------------------------------
552 
553 !> OASIS user finalize method
554 
555  SUBROUTINE oasis_terminate(kinfo)
556 
557  IMPLICIT NONE
558 
559  INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo !< return code
560 ! ---------------------------------------------------------
561  integer(kind=ip_intwp_p) :: ierr
562  character(len=*),parameter :: subname = '(oasis_terminate)'
563 ! ---------------------------------------------------------
564 
565  call oasis_debug_enter(subname)
566  if (.not. oasis_coupled) then
567  call oasis_debug_exit(subname)
568  return
569  endif
570 
571  if (present(kinfo)) then
572  kinfo = oasis_ok
573  endif
574 
575  !------------------------
576  !> * Print timer information
577  !------------------------
578 
579  call oasis_timer_stop('total')
580  call oasis_timer_print()
581 
582  !------------------------
583  !> * Call MPI finalize
584  !------------------------
585 
586  IF ( .NOT. lg_mpiflag ) THEN
587  IF (oasis_debug >= 2) THEN
588  WRITE (nulprt,fmt='(A)') subname//': Calling MPI_Finalize'
589  CALL oasis_flush(nulprt)
590  ENDIF
591  CALL mpi_finalize( ierr )
592  else
593  IF (oasis_debug >= 2) THEN
594  WRITE (nulprt,fmt='(A)') subname//': Not Calling MPI_Finalize'
595  CALL oasis_flush(nulprt)
596  ENDIF
597  ENDIF
598 
599  !------------------------
600  !> * Write SUCCESSFUL RUN
601  !------------------------
602 
603  call oasis_mem_print(nulprt,subname)
604 
605  IF (mpi_rank_local == 0) THEN
606  WRITE(nulprt,*) subname,' SUCCESSFUL RUN'
607  CALL oasis_flush(nulprt)
608  ENDIF
609 
610  call oasis_debug_exit(subname)
611 
612  END SUBROUTINE oasis_terminate
613 
614 !----------------------------------------------------------------------
615 
616 !> OASIS user interface specifying the OASIS definition phase is complete
617 
618  SUBROUTINE oasis_enddef(kinfo)
619 
620  IMPLICIT NONE
621 
622  INTEGER (kind=ip_intwp_p),intent(inout),optional :: kinfo !< return code
623 ! ---------------------------------------------------------
624  integer (kind=ip_intwp_p) :: n
625  integer (kind=ip_intwp_p) :: lkinfo
626  integer (kind=ip_intwp_p) :: icpl, ierr
627  integer (kind=ip_intwp_p) :: newcomm
628  character(len=*),parameter :: subname = '(oasis_enddef)'
629 ! ---------------------------------------------------------
630 
631  call oasis_debug_enter(subname)
632 
633  !------------------------
634  !> * Check enddef called only once per task
635  !------------------------
636 
637  if (enddef_called) then
638  write(nulprt,*) subname,estr,'enddef called already'
639  CALL oasis_abort()
640  endif
641  enddef_called = .true.
642 
643  if (.not. oasis_coupled) then
644  call oasis_debug_exit(subname)
645  return
646  endif
647 
648  lkinfo = oasis_ok
649 
650  call oasis_mem_print(nulprt,subname//':start')
651 
652  !------------------------
653  !> * Reset mpi_comm_global because active tasks might have been excluded
654  !--- for changes to mpi_comm_local since init
655  !------------------------
656 
657  icpl = mpi_undefined
658  if (mpi_comm_local /= mpi_comm_null) icpl = 1
659  CALL mpi_comm_split(mpi_comm_global,icpl,1,newcomm,ierr)
660  mpi_comm_global = newcomm
661 
662  !------------------------
663  !> * For active tasks only
664  !------------------------
665 
666  if (mpi_comm_global /= mpi_comm_null) then
667 
668  !------------------------
669  !> * Update mpi_comm_global
670  !------------------------
671 
672  CALL mpi_comm_size(mpi_comm_global,mpi_size_global,ierr)
673  CALL mpi_comm_rank(mpi_comm_global,mpi_rank_global,ierr)
674 
675  !------------------------
676  !> * Update mpi_root_global
677  !------------------------
678 
680 
681  !------------------------
682  !> * Document
683  !------------------------
684 
685  if (oasis_debug >= 2) then
686  write(nulprt,*) subname,' compid = ',compid
687  write(nulprt,*) subname,' compnm = ',trim(compnm)
688  write(nulprt,*) subname,' mpi_comm_world = ',mpi_comm_world
689  write(nulprt,*) subname,' mpi_comm_global= ',mpi_comm_global
690  write(nulprt,*) subname,' size_global= ',mpi_size_global
691  write(nulprt,*) subname,' rank_global= ',mpi_rank_global
692  write(nulprt,*) subname,' mpi_comm_local = ',mpi_comm_local
693  write(nulprt,*) subname,' size_local = ',mpi_size_local
694  write(nulprt,*) subname,' rank_local = ',mpi_rank_local
695  write(nulprt,*) subname,' root_local = ',mpi_root_local
696  write(nulprt,*) subname,' OASIS_debug = ',oasis_debug
697  do n = 1,prism_amodels
698  write(nulprt,*) subname,' n,prism_model,root = ',&
699  n,trim(prism_modnam(n)),mpi_root_global(n)
700  enddo
701  CALL oasis_flush(nulprt)
702  endif
703 
704  !------------------------
705  !> * Reconcile partitions, call part_setup
706  !--- generate gsmaps from partitions
707  !------------------------
708 
709  call oasis_part_setup()
710  call oasis_mem_print(nulprt,subname//':part_setup')
711 
712  !------------------------
713  !> * Reconcile variables, call var_setup
714  !------------------------
715 
716  call oasis_var_setup()
717  call oasis_mem_print(nulprt,subname//':var_setup')
718 
719  !------------------------
720  !> * Write grid info to files one model at a time
721  !------------------------
722 
723  call oasis_mpi_barrier(mpi_comm_global)
724  do n = 1,prism_amodels
725  if (compid == n) then
726  call oasis_write2files()
727  endif
728  call oasis_mpi_barrier(mpi_comm_global)
729  enddo
730  call oasis_mem_print(nulprt,subname//':write2files')
731 
732  !------------------------
733  !> * MCT Initialization
734  !------------------------
735 
736  call mct_world_init(prism_amodels,mpi_comm_global,mpi_comm_local,compid)
737  IF (oasis_debug >= 2) THEN
738  WRITE(nulprt,*) subname, ' done mct_world_init '
739  CALL oasis_flush(nulprt)
740  ENDIF
741 
742  !------------------------
743  !> * Initialize coupling via call to coupler_setup
744  !------------------------
745 
746  call oasis_coupler_setup()
747  IF (oasis_debug >= 2) THEN
748  WRITE(nulprt,*) subname, ' done prism_coupler_setup '
749  CALL oasis_flush(nulprt)
750  ENDIF
751  call oasis_mem_print(nulprt,subname//':coupler_setup')
752 
753  !------------------------
754  !> * Call advance_init to initialize coupling fields from restarts
755  !------------------------
756 
757  call oasis_advance_init(lkinfo)
758  IF (oasis_debug >= 2) THEN
759  WRITE(nulprt,*) subname, ' done prism_advance_init '
760  CALL oasis_flush(nulprt)
761  ENDIF
762  call oasis_mem_print(nulprt,subname//':advance_init')
763 
764  endif ! (mpi_comm_local /= MPI_COMM_NULL)
765 
766  !--- Force OASIS_OK here rather than anything else ---
767 
768  if (present(kinfo)) then
769  kinfo = oasis_ok
770  endif
771 
772  call oasis_timer_stop('init_thru_enddef')
773 
774  call oasis_mem_print(nulprt,subname//':end')
775 
776  call oasis_debug_exit(subname)
777 
778  END SUBROUTINE oasis_enddef
779 !----------------------------------------------------------------------
780 
781 !> Local method to compute each models' global task ids, exists for reuse in enddef
782 
784 
785  INTEGER(kind=ip_intwp_p) :: n, ierr
786  INTEGER(kind=ip_intwp_p),ALLOCATABLE :: tmparr(:)
787  character(len=*),parameter :: subname = '(oasis_setrootglobal)'
788 
789  !------------------------
790  !--- set mpi_root_global
791  !------------------------
792 
793  if (allocated(mpi_root_global)) then
794  deallocate(mpi_root_global)
795  endif
796  allocate(mpi_root_global(prism_amodels))
797  allocate(tmparr(prism_amodels))
798  tmparr = -1
799  do n = 1,prism_amodels
800  if (compid == n .and. mpi_rank_local == mpi_root_local) then
801  tmparr(n) = mpi_rank_global
802  endif
803  enddo
804  call oasis_mpi_max(tmparr,mpi_root_global,mpi_comm_global, &
805  string=subname//':mpi_root_global',all=.true.)
806  deallocate(tmparr)
807 
808  do n = 1,prism_amodels
809  IF (mpi_root_global(n) < 0) THEN
810  WRITE(nulprt,*) subname,estr,'global root invalid, check couplcomm for active tasks'
811  CALL oasis_abort()
812  ENDIF
813  enddo
814 
815 END SUBROUTINE mod_oasis_setrootglobal
816 !----------------------------------------------------------------------
817 
818 END MODULE mod_oasis_method
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
OASIS partition data and methods.
System type methods.
Generic overloaded interface into MPI max reduction.
Reads the namcouple file for use in OASIS.
subroutine mod_oasis_setrootglobal()
Local method to compute each models' global task ids, exists for reuse in enddef. ...
Provides methods for querying memory use.
Provides a generic and simpler interface into MPI calls for OASIS.
Generic overloaded interface into MPI broadcast.
Advances the OASIS coupling.
subroutine, public oasis_unitsetmin(uio)
Set the minimum unit number allowed.
subroutine, public oasis_coupler_setup()
Main routine to setup couplers.
subroutine, public oasis_mem_print(iunit, string)
Print memory use.
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
Provides a common location for several OASIS variables.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
Defines kinds for OASIS.
subroutine, public oasis_flush(nu)
Flushes output to file.
Initialize the OASIS coupler infrastructure.
Character string manipulation methods.
subroutine, public oasis_enddef(kinfo)
OASIS user interface specifying the OASIS definition phase is complete.
subroutine oasis_data_zero()
subroutine, public oasis_part_setup()
Synchronize partitions across all tasks, called at oasis enddef.
subroutine, public oasis_var_setup()
Synchronize variables across all tasks, called at oasis enddef.
subroutine, public oasis_write2files()
Interface that actually writes fields to grid files.
Performance timer methods.
IO interfaces based on pio (not supported yet)
subroutine, public oasis_unitget(uio)
Get a free unit number.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine, public oasis_namcouple_init()
Reads the namcouple.
subroutine, public oasis_string_listgetname(list, k, name, rc)
Get name of k-th field in list.
High level OASIS user interfaces.
subroutine, public oasis_mpi_barrier(comm, string)
Call MPI_BARRIER for a particular communicator.
OASIS grid data and methods.
subroutine, public oasis_init_comp(mynummod, cdnam, kinfo, coupled)
OASIS user init method.
subroutine, public oasis_timer_init(app, file, nt)
Initializes the timer methods, called once in an application.
subroutine, public oasis_advance_init(kinfo)
Initializes the OASIS fields.
integer function, public oasis_string_listgetnum(str)
return number of fields in string list
subroutine, public oasis_mem_init(iunit)
Initialize memory conversion to MB.
OASIS variable data and methods.
Defines parameters for OASIS.
subroutine, public oasis_timer_print(timer_label)
Print timers.
subroutine, public oasis_terminate(kinfo)
OASIS user finalize method.