Oasis3-MCT
mod_oasis_advance.F90
Go to the documentation of this file.
1 
2 !> Advances the OASIS coupling
3 
4 MODULE mod_oasis_advance
5 
6  USE mod_oasis_kinds
7  USE mod_oasis_data
8  USE mod_oasis_parameters
9  USE mod_oasis_coupler
10  USE mod_oasis_map
11  USE mod_oasis_part
12  USE mod_oasis_timer
13  USE mod_oasis_var
14  USE mod_oasis_sys
15  USE mod_oasis_io
16  USE mod_oasis_mpi
17  USE mod_oasis_reprosum
18  USE mct_mod
19 
20  IMPLICIT NONE
21 
22  private
23 
24  public oasis_advance_init
25  public oasis_advance_run
26 
27  ! local private
28 
29  logical, parameter :: map_barrier = .false.
30  logical, parameter :: detailed_map_timing = .false.
31 
32 contains
33 
34 !---------------------------------------------------------------------
35 
36 !> Initializes the OASIS fields
37 
38  SUBROUTINE oasis_advance_init(kinfo)
39 
40 ! ----------------------------------------------------------------
41 ! This routine handles initial restart and communication
42 ! of data for fields with positive lags
43 ! ----------------------------------------------------------------
44 
45  IMPLICIT none
46 ! ----------------------------------------------------------------
47  INTEGER(kind=ip_i4_p), intent(inout) :: kinfo !< status, not used
48 ! ----------------------------------------------------------------
49  integer(kind=ip_i4_p) :: cplid,partid,varid,mapid
50  INTEGER(kind=ip_i4_p) :: nf,lsize,nflds,npc
51  integer(kind=ip_i4_p) :: dt,ltime,lag,getput
52  integer(kind=ip_i4_p) :: msec
53  real (kind=ip_r8_p), allocatable :: array(:) ! data
54  real (kind=ip_r8_p), allocatable :: array2(:) ! data
55  real (kind=ip_r8_p), allocatable :: array3(:) ! data
56  real (kind=ip_r8_p), allocatable :: array4(:) ! data
57  real (kind=ip_r8_p), allocatable :: array5(:) ! data
58  logical :: a2on,a3on,a4on,a5on ! data 2-5 logicals
59  integer(kind=ip_i4_p) :: mseclag ! model time + lag
60  character(len=ic_xl) :: rstfile ! restart filename
61  character(len=ic_xxl) :: lstring ! long temporary string
62  integer(kind=ip_i4_p) :: llstring ! len of lstring
63  character(len=ic_med) :: vstring ! temporary string
64  integer(kind=ip_i4_p) :: lvarnum ! local variable bundle number
65  type(mct_string) :: mstring ! mct char type
66  character(len=64) :: vname ! string converted to char
67  type(prism_coupler_type),pointer :: pcpointer
68  character(len=*),parameter :: subname = '(oasis_advance_init)'
69  logical, parameter :: local_timers_on = .false.
70 
71  call oasis_debug_enter(subname)
72 
73  !----------------------------------------------------------------
74  !> oasis_advance_init does the following
75  !> * Aborts if it's called from non-active tasks
76  !----------------------------------------------------------------
77 
78  if (mpi_comm_local == mpi_comm_null) then
79  write(nulprt,*) subname,estr,'called on non coupling task'
80  call oasis_abort(file=__file__,line=__line__)
81  endif
82 
83  kinfo = oasis_ok
84 
85  IF (local_timers_on) call oasis_timer_start ('advance_init')
86 
87  if (oasis_debug >= 2) then
88  write(nulprt,*) ' subname at time time+lag act: field '
89  write(nulprt,*) ' diags : fldname min max sum '
90  endif
91 
92  !----------------------------------------------------------------
93  !> * Loop over all coupler connections,
94  !> Loop over get and put connections,
95  !> For valid connections
96  !----------------------------------------------------------------
97 
98  call oasis_debug_note(subname//' loop over cplid')
99  DO cplid = 1,prism_mcoupler
100  DO npc = 1,2
101  if (npc == 1) pcpointer => prism_coupler_put(cplid)
102  if (npc == 2) pcpointer => prism_coupler_get(cplid)
103  if (pcpointer%valid) then
104  dt = pcpointer%dt
105  lag = pcpointer%lag
106  ltime = pcpointer%ltime
107  getput= pcpointer%getput
108  rstfile=trim(pcpointer%rstfile)
109  partid= pcpointer%partID
110  mapid = pcpointer%mapperid
111  msec = 0 ! reasonable default to start with
112  mseclag = msec
113 
114  IF (oasis_debug >= 2) THEN
115  WRITE(nulprt,*) '----------------------------------------------------------------'
116  WRITE(nulprt,*) subname,' Field cplid :',cplid
117  WRITE(nulprt,*) subname,' read restart:',npc,trim(pcpointer%fldlist)
118  WRITE(nulprt,*) subname,' lag prism_mcoupler :',lag,prism_mcoupler
119  WRITE(nulprt,*) subname,' getput , mapid :',getput, mapid
120  WRITE(nulprt,*) '----------------------------------------------------------------'
121  CALL oasis_flush(nulprt)
122  ENDIF
123 
124  !------------------------------------------------
125  !> * Checks that lag is reasonable
126  !------------------------------------------------
127 
128  IF (lag > dt .OR. lag <= -dt) THEN
129  WRITE(nulprt,*) subname,estr,'lag out of dt range cplid/dt/lag=',cplid,dt,lag
130  call oasis_abort(file=__file__,line=__line__)
131  ENDIF
132 
133  !------------------------------------------------
134  !> * For put fields that need to read a restart file because of a lag,
135  !> call oasis_advance_run and read in the restart file.
136  !> Set readrest to true in oasis_advance_run to indicate it's called from init.
137  ! right now, do not know whether any hot map terms are there
138  ! assume they are if something is read, otherwise not
139  !------------------------------------------------
140  IF ( (getput == oasis3_put .AND. lag > 0) ) THEN
141  msec=0-lag
142  lsize = mct_avect_lsize(pcpointer%aVect1)
143  nflds = mct_avect_nrattr(pcpointer%aVect1)
144 
145  ALLOCATE(array(lsize))
146  ALLOCATE(array2(lsize))
147  ALLOCATE(array3(lsize))
148  ALLOCATE(array4(lsize))
149  ALLOCATE(array5(lsize))
150 
151  a2on=.false.
152  a3on=.false.
153  a4on=.false.
154  a5on=.false.
155 
156  if (mapid > 0) then
157  if (prism_mapper(mapid)%nwgts >= 2) a2on=.true.
158  if (prism_mapper(mapid)%nwgts >= 3) a3on=.true.
159  if (prism_mapper(mapid)%nwgts >= 4) a4on=.true.
160  if (prism_mapper(mapid)%nwgts >= 5) a5on=.true.
161  endif
162 
163  DO nf = 1,nflds
164  varid = pcpointer%varid(nf)
165  call mct_avect_getrlist(mstring,nf,pcpointer%aVect1)
166  vname = mct_string_tochar(mstring)
167  call mct_string_clean(mstring)
168  call oasis_coupler_unbldvarname(varid,vname,lvarnum)
169  CALL oasis_advance_run(oasis_out,varid,msec,kinfo,nff=nf, &
170  namid=cplid,array1din=array,&
171  readrest=.true., a2on=a2on,array2=array2, &
172  a3on=a3on,array3=array3, &
173  a4on=a4on,array4=array4,a5on=a5on,array5=array5, &
174  varnum=lvarnum)
175  ENDDO
176  IF (oasis_debug >= 2) THEN
177  write(nulprt,*) subname,' advance_run ',cplid,trim(pcpointer%fldlist)
178  endif
179 
180  DEALLOCATE(array)
181  DEALLOCATE(array2)
182  DEALLOCATE(array3)
183  DEALLOCATE(array4)
184  DEALLOCATE(array5)
185  ENDIF ! put
186  ENDIF ! valid
187  enddo ! npc
188  ENDDO ! cplid
189 
190  !----------------------------------------------------------------
191  !> * Loop over all coupler connections,
192  !> Loop over get and put connections,
193  !> For valid connections
194  !----------------------------------------------------------------
195 
196  DO cplid=1, prism_mcoupler
197  DO npc = 1,2
198  if (npc == 1) pcpointer => prism_coupler_put(cplid)
199  if (npc == 2) pcpointer => prism_coupler_get(cplid)
200  IF (pcpointer%valid) then
201  dt = pcpointer%dt
202  lag = pcpointer%lag
203  ltime = pcpointer%ltime
204  getput= pcpointer%getput
205  rstfile=trim(pcpointer%rstfile)
206  partid= pcpointer%partID
207  msec = 0 ! reasonable default to start with
208  mseclag = msec
209 
210  IF (oasis_debug >= 2) THEN
211  WRITE(nulprt,*) '----------------------------------------------------------------'
212  WRITE(nulprt,*) subname,' Field cplid :',cplid
213  WRITE(nulprt,*) subname,' loctrans:',npc,trim(pcpointer%fldlist)
214  WRITE(nulprt,*) '----------------------------------------------------------------'
215  CALL oasis_flush(nulprt)
216  ENDIF
217 
218  !------------------------------------------------
219  !> * Read restart for LOCTRANS fields.
220  !> Do after restart and advance above because prism_advance_run
221  !> fills in the avect with the array info
222  !------------------------------------------------
223 
224  call oasis_debug_note(subname//' check for loctrans restart')
225  IF (getput == oasis3_put .AND. pcpointer%trans /= ip_instant) THEN
226  if (len_trim(rstfile) < 1) then
227  write(nulprt,*) subname,estr,'restart undefined'
228  call oasis_abort(file=__file__,line=__line__)
229  endif
230  if (oasis_debug >= 2) then
231  lstring = pcpointer%fldlist
232  llstring = len_trim(lstring)
233  if (llstring <= 20) then
234  write(nulprt,*) subname,' at ',msec,mseclag,' RTRN: ', &
235  trim(lstring),' ',trim(rstfile)
236  else
237  write(nulprt,*) subname,' at ',msec,mseclag,' RTRN: ',lstring(1:20), &
238  lstring(21:llstring),' ',trim(rstfile)
239  endif
240  endif
241  lsize = mct_avect_lsize(pcpointer%aVect1)
242 
243  write(vstring,'(a,i6.6,a)') 'loc',pcpointer%namID,'_cnt'
244  call oasis_io_read_array(rstfile,prism_part(partid)%mpicom,iarray=pcpointer%avcnt,&
245  ivarname=trim(vstring),abort=.false.)
246 
247  write(vstring,'(a,i6.6,a)') 'loc',pcpointer%namID,'_'
248  call oasis_io_read_avfile(rstfile,pcpointer%avect1,&
249  prism_part(partid)%pgsmap,prism_part(partid)%mpicom, &
250  abort=.false.,nampre=trim(vstring))
251 
252  call mct_avect_init(pcpointer%aVect2,pcpointer%aVect1,lsize)
253  call mct_avect_zero(pcpointer%aVect2)
254  write(vstring,'(a,i6.6,a)') 'av2loc',pcpointer%namID,'_'
255  call oasis_io_read_avfile(rstfile,pcpointer%avect2,&
256  prism_part(partid)%pgsmap,prism_part(partid)%mpicom, &
257  abort=.false.,nampre=trim(vstring),&
258  didread=pcpointer%aVon(2))
259  if (.not. pcpointer%aVon(2)) then
260  call mct_avect_clean(pcpointer%avect2)
261  endif
262 
263  call mct_avect_init(pcpointer%aVect3,pcpointer%aVect1,lsize)
264  call mct_avect_zero(pcpointer%aVect3)
265  write(vstring,'(a,i6.6,a)') 'av3loc',pcpointer%namID,'_'
266  call oasis_io_read_avfile(rstfile,pcpointer%avect3,&
267  prism_part(partid)%pgsmap,prism_part(partid)%mpicom, &
268  abort=.false.,nampre=trim(vstring),&
269  didread=pcpointer%aVon(3))
270  if (.not. pcpointer%aVon(3)) then
271  call mct_avect_clean(pcpointer%avect3)
272  endif
273 
274  call mct_avect_init(pcpointer%aVect4,pcpointer%aVect1,lsize)
275  call mct_avect_zero(pcpointer%aVect4)
276  write(vstring,'(a,i6.6,a)') 'av4loc',pcpointer%namID,'_'
277  call oasis_io_read_avfile(rstfile,pcpointer%avect4,&
278  prism_part(partid)%pgsmap,prism_part(partid)%mpicom, &
279  abort=.false.,nampre=trim(vstring),&
280  didread=pcpointer%aVon(4))
281  if (.not. pcpointer%aVon(4)) then
282  call mct_avect_clean(pcpointer%avect4)
283  endif
284 
285  call mct_avect_init(pcpointer%aVect5,pcpointer%aVect1,lsize)
286  call mct_avect_zero(pcpointer%aVect5)
287  write(vstring,'(a,i6.6,a)') 'av5loc',pcpointer%namID,'_'
288  call oasis_io_read_avfile(rstfile,pcpointer%avect5,&
289  prism_part(partid)%pgsmap,prism_part(partid)%mpicom, &
290  abort=.false.,nampre=trim(vstring),&
291  didread=pcpointer%aVon(5))
292  if (.not. pcpointer%aVon(5)) then
293  call mct_avect_clean(pcpointer%avect5)
294  endif
295 
296  if (oasis_debug >= 20) then
297  write(nulprt,*) subname,' DEBUG read loctrans restart',&
298  cplid,pcpointer%avcnt
299  write(nulprt,*) subname,' DEBUG read loctrans restart',cplid,&
300  minval(pcpointer%avect1%rAttr),&
301  maxval(pcpointer%avect1%rAttr)
302  endif
303  endif
304  ENDIF ! valid
305  enddo ! npc
306  ENDDO ! cplid
307  IF (local_timers_on) call oasis_timer_stop ('advance_init')
308 
309  call oasis_debug_exit(subname)
310 
311  end SUBROUTINE oasis_advance_init
312 !---------------------------------------------------------------------
313 
314 !> Advances the OASIS coupling
315 
316 !> Only one from array1din, array1dout, or array2dout can be passed in.
317 !> readrest is set to true when called by the oasis_advance_init method.
318 !> Arrays 2 to 5 are for the higher order terms (hot)
319 
320  SUBROUTINE oasis_advance_run(mop,varid,msec,kinfo,nff,namid,&
321  array1din,array1dout,array2dout,readrest,&
322  a2on,array2,a3on,array3,a4on,array4,a5on,array5, &
323  writrest,varnum)
324 
325  IMPLICIT none
326 ! ----------------------------------------------------------------
327  integer(kind=ip_i4_p), intent(in) :: mop !< OASIS_Out or OASIS_In
328  INTEGER(kind=ip_i4_p), intent(in) :: varid !< prism_var id
329  INTEGER(kind=ip_i4_p), intent(in) :: msec !< model time
330  INTEGER(kind=ip_i4_p), intent(inout) :: kinfo !< status
331 
332  INTEGER(kind=ip_i4_p), optional :: nff !< specify particular field for restart
333  INTEGER(kind=ip_i4_p), optional :: namid !< only do this namcouple
334  !< method for restart
335  REAL (kind=ip_r8_p), optional :: array1din(:) !< 1D put data
336  REAL (kind=ip_r8_p), optional :: array1dout(:) !< 1D get data
337  REAL (kind=ip_r8_p), optional :: array2dout(:,:) !< 2D get data
338  logical , optional :: readrest !< special flag to indicate this
339  !< is called from the advance_init
340  logical , optional :: a2on !< logical for array2
341  REAL (kind=ip_r8_p), optional :: array2(:) !< hot put data
342  logical , optional :: a3on !< logical for array3
343  REAL (kind=ip_r8_p), optional :: array3(:) !< hot put data
344  logical , optional :: a4on !< logical for array4
345  REAL (kind=ip_r8_p), optional :: array4(:) !< hot put data
346  logical , optional :: a5on !< logical for array5
347  REAL (kind=ip_r8_p), optional :: array5(:) !< hot put data
348  logical , optional :: writrest !< flag to write restart now
349  INTEGER(kind=ip_i4_p), optional :: varnum !< variable bundle number
350 ! ----------------------------------------------------------------
351  character(len=ic_lvar):: vname
352  INTEGER(kind=ip_i4_p) :: cplid,rouid,mapid,partid
353  INTEGER(kind=ip_i4_p) :: nfav,nsav,nsa,n,nc,nf,npc
354  INTEGER(kind=ip_i4_p) :: lsize,nflds,ierr
355  integer(kind=ip_i4_p) :: tag,dt,ltime,lag,getput,maxtime,conserv
356  character(len=ic_med) :: consopt
357  logical :: sndrcv,output,input,unpack
358  logical :: snddiag,rcvdiag
359  logical :: arrayon(prism_coupler_avsmax)
360  LOGICAL :: didread, readabort
361  real(kind=ip_double_p):: sndmult,sndadd,rcvmult,rcvadd
362  character(len=ic_xl) :: rstfile ! restart filename
363  character(len=ic_xl) :: rstfile2 ! restart filename
364  character(len=ic_xl) :: inpfile ! input filename
365  integer(kind=ip_i4_p) :: nx,ny
366  integer(kind=ip_i4_p) :: mseclag ! model time + lag
367  integer(kind=ip_i4_p) :: lvarnum ! local variable bundle number
368  real(kind=ip_r8_p) :: rcnt ! 1./cnt
369  character(len=ic_med) :: tstring ! timer label string
370  character(len=ic_med) :: fstring ! output file string
371  character(len=ic_med) :: cstring ! temporary string
372  character(len=ic_med) :: vstring ! temporary string
373  character(len=ic_xxl) :: lstring ! long temporary string
374  integer(kind=ip_i4_p) :: llstring ! len of lstring
375  logical :: comm_now ! time to communicate
376  logical :: time_now ! coupling time
377  logical :: lreadrest ! local readrest
378  logical :: runit ! advance the variable
379  TYPE(mct_avect) :: avtest ! temporary
380  type(mct_avect) :: avtmp ! data read from restart
381  type(mct_avect) :: avtmp2 ! data read from restart
382  type(mct_avect) :: avtmp3 ! data read from restart
383  type(mct_avect) :: avtmp4 ! data read from restart
384  type(mct_avect) :: avtmp5 ! data read from restart
385  type(mct_avect) :: avtmpW ! for writing restart
386  type(prism_coupler_type),pointer :: pcpointer
387  type(prism_coupler_type),pointer :: pcpointmp
388  logical, parameter :: local_timers_on = .false.
389  character(len=*),parameter :: subname = '(oasis_advance_run)'
390  character(len=*),parameter :: F01 = '(a,i3.3)'
391 ! ----------------------------------------------------------------
392 
393  call oasis_debug_enter(subname)
394 
395  !----------------------------------------------------------------
396  !> oasis_advance_run does the following
397  !> * Aborts if it's called from non-active tasks
398  !----------------------------------------------------------------
399 
400  if (mpi_comm_local == mpi_comm_null) then
401  write(nulprt,*) subname,estr,'called on non coupling task'
402  call oasis_abort(file=__file__,line=__line__)
403  endif
404 
405  kinfo = oasis_ok
406  if (varid < 1 .or. varid > prism_nvar) then
407  write(nulprt,*) subname,estr,'invalid varid',varid,trim(prism_var(varid)%name),prism_nvar
408  call oasis_abort(file=__file__,line=__line__)
409  endif
410 
411  if (present(varnum)) then
412  lvarnum = varnum
413  else
414  lvarnum = 1
415  endif
416 
417  call oasis_coupler_bldvarname(varid,lvarnum,vname)
418  if (oasis_debug >= 20) then
419  write(nulprt,*) subname,' DEBUG vname ',varid,lvarnum,' ',trim(vname)
420  endif
421 
422  lreadrest = .false.
423  if (present(readrest)) then
424  lreadrest = readrest
425  endif
426  if (lreadrest) kinfo = oasis_fromrest
427 
428  !------------------------------------------------
429  !> * Verify field (var) is either In or Out
430  !------------------------------------------------
431 
432  if (mop /= oasis_out .and. mop /= oasis_in) then
433  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
434  write(nulprt,*) subname,estr,'mop invalid expecting OASIS_Out or OASIS_In = ',mop
435  call oasis_abort(file=__file__,line=__line__)
436  endif
437 
438  call oasis_debug_note(subname//' loop over var ncpl')
439 
440  !------------------------------------------------
441  ! Check namid
442  !------------------------------------------------
443 
444  if (present(namid)) then
445  IF (oasis_debug >= 20) THEN
446  write(nulprt,*) subname,'namid',namid,prism_var(varid)%cpl(1:prism_var(varid)%ncpl)
447  endif
448  ! verify namid is associated with the variable or abort
449  runit = .false.
450  do nc = 1,prism_var(varid)%ncpl
451  cplid = prism_var(varid)%cpl(nc)
452  if (cplid == namid) runit = .true.
453  enddo
454  if (.not.runit) then
455  WRITE(nulprt,*) subname,estr,'namid not found for var = ',trim(vname)
456  WRITE(nulprt,*) subname,estr,'namid = ',namid
457  call oasis_abort(file=__file__,line=__line__)
458  endif
459  endif
460 
461  !------------------------------------------------
462  ! Set arrayon
463  !------------------------------------------------
464 
465  arrayon = .false.
466  arrayon(1) = .true.
467  if (present(a2on)) arrayon(2) = a2on
468  if (present(a3on)) arrayon(3) = a3on
469  if (present(a4on)) arrayon(4) = a4on
470  if (present(a5on)) arrayon(5) = a5on
471 
472  if (oasis_debug >= 10) then
473  write(nulprt,*) subname,' lreadrest :',lreadrest,' arrayon = ',arrayon
474  endif
475 
476  !------------------------------------------------
477  !> * Loop over all the couplers associated with this var
478  ! or if nam is present, just for nc == nam
479  !------------------------------------------------
480 
481  DO nc = 1,prism_var(varid)%ncpl
482  cplid = prism_var(varid)%cpl(nc)
483  runit = .true.
484  if (present(namid)) then
485  runit = .false.
486  if (cplid == namid) runit = .true.
487  endif
488  if (runit) then
489  cplid = prism_var(varid)%cpl(nc)
490  if (mop == oasis_out) pcpointer => prism_coupler_put(cplid)
491  if (mop == oasis_in ) pcpointer => prism_coupler_get(cplid)
492 
493  !------------------------------------------------
494  !> * check this prism_coupler is valid
495  !------------------------------------------------
496  if (.not.pcpointer%valid) then
497  WRITE(nulprt,*) subname,estr,'invalid prism_coupler for var = ',trim(vname)
498  call oasis_abort(file=__file__,line=__line__)
499  endif
500 
501  !------------------------------------------------
502  !> * check again that model op matches coupler op
503  !------------------------------------------------
504  getput = pcpointer%getput
505  if ((mop == oasis_out .and. getput == oasis3_put) .or. &
506  (mop == oasis_in .and. getput == oasis3_get)) then
507  !-continue
508  else
509  write(nulprt,*) subname,estr,'model def_var in-out does not match model get-put call for var = ',trim(vname)
510  call oasis_abort(file=__file__,line=__line__)
511  endif
512 
513  !------------------------------------------------
514  !> * set a bunch of local variables
515  !------------------------------------------------
516  rouid = pcpointer%routerid
517  mapid = pcpointer%mapperid
518  tag = pcpointer%tag
519  dt = pcpointer%dt
520  lag = pcpointer%lag
521  ltime = pcpointer%ltime
522  sndrcv = pcpointer%sndrcv
523  rstfile = trim(pcpointer%rstfile)
524  inpfile = trim(pcpointer%inpfile)
525  maxtime = pcpointer%maxtime
526  output = pcpointer%output
527  input = pcpointer%input
528  partid = pcpointer%partID
529  conserv = pcpointer%conserv
530  consopt = pcpointer%consopt
531  snddiag = pcpointer%snddiag
532  rcvdiag = pcpointer%rcvdiag
533  sndadd = pcpointer%sndadd
534  sndmult = pcpointer%sndmult
535  rcvadd = pcpointer%rcvadd
536  rcvmult = pcpointer%rcvmult
537 
538  ! update writrest only if true
539  ! never want to switch to false here
540  if (present(writrest)) then
541  if (writrest .and. mop /= oasis_out) then
542  write(nulprt,*) subname,estr,'mop must be OASIS_Out if writrest is true, mop=',mop
543  call oasis_abort(file=__file__,line=__line__)
544  endif
545  if (writrest) pcpointer%writrest = writrest
546  endif
547 
548  unpack = (sndrcv .OR. input)
549 
550  CALL oasis_debug_note(subname//' set nx and ny')
551  IF (prism_part(partid)%nx >= 1) THEN
552  nx = prism_part(partid)%nx
553  ny = prism_part(partid)%ny
554  ELSE
555  nx = prism_part(partid)%gsize
556  ny = 1
557  ENDIF
558 
559  IF (oasis_debug >= 20) THEN
560  WRITE(nulprt,*) subname,' DEBUG nx, ny = ',nx,ny
561  CALL oasis_flush(nulprt)
562  ENDIF
563 
564  !------------------------------------------------
565  !> * check that lag is reasonable
566  !------------------------------------------------
567 
568  IF (abs(lag) > dt) THEN
569  WRITE(nulprt,*) subname,estr,'lag setting greater than dt for var = ',trim(vname)
570  call oasis_abort(file=__file__,line=__line__)
571  ENDIF
572 
573  !------------------------------------------------
574  !> * read restart for call from init phase
575  ! right now, do not know whether any hot map terms are there
576  ! assume they are if something is read, otherwise not
577  !------------------------------------------------
578 
579  call oasis_debug_note(subname//' check for lag restart')
580  IF (getput == oasis3_put .AND. lag > 0 .AND. lreadrest) THEN
581  ! effective model time of restart : msec
582  mseclag = msec + lag
583 
584  IF (.not.present(nff)) THEN
585  WRITE(nulprt,*) subname,estr,'nff optional argument not passed but expected for var = ',trim(vname)
586  call oasis_abort(file=__file__,line=__line__)
587  ENDIF
588  IF (len_trim(rstfile) < 1) THEN
589  WRITE(nulprt,*) subname,estr,'restart file undefined for var = ',trim(vname)
590  call oasis_abort(file=__file__,line=__line__)
591  ENDIF
592  lsize = mct_avect_lsize(pcpointer%aVect1)
593  IF (oasis_debug >= 2) THEN
594  lstring = pcpointer%fldlist
595  llstring = len_trim(lstring)
596  if (llstring <= 20) then
597  WRITE(nulprt,*) subname,' at ',msec,mseclag,' RRST: ', &
598  trim(lstring),' ',trim(rstfile)
599  else
600  WRITE(nulprt,*) subname,' at ',msec,mseclag,' RRST: ',lstring(1:20),&
601  lstring(21:llstring),' ',trim(rstfile)
602  endif
603  ENDIF
604 
605  CALL mct_avect_init(avtmp,rlist=pcpointer%fldlist,lsize=lsize)
606  readabort = .true.
607  if (allow_no_restart) readabort = .false.
608 
609  do n = 1,5
610  if (n == 1) then
611  vstring = ""
612  else
613  write(vstring,'(a2,i1.1,a1)') 'av',n,'_'
614  endif
615 
616  ! NOTES: array* only valid if arrayon(n) is true
617  ! if readabort = T and didread = T then will copy values into array*
618  ! if readabort = T and didread = F then will abort in io_read_avfile
619  ! if readabort = F and didread = T then will copy values into array*
620  ! if readabort = F and didread = F then will 0s into array*
621 
622  if (arrayon(n)) then
623  avtmp%rAttr(nff,1:lsize) = 0.0
624  CALL oasis_io_read_avfile(trim(rstfile),avtmp,prism_part(partid)%pgsmap,prism_part(partid)%mpicom, &
625  abort=readabort,nampre=vstring,didread=didread)
626  if (n == 1) array1din(1:lsize) = avtmp%rAttr(nff,1:lsize)
627  if (n == 2) array2(1:lsize) = avtmp%rAttr(nff,1:lsize)
628  if (n == 3) array3(1:lsize) = avtmp%rAttr(nff,1:lsize)
629  if (n == 4) array4(1:lsize) = avtmp%rAttr(nff,1:lsize)
630  if (n == 5) array5(1:lsize) = avtmp%rAttr(nff,1:lsize)
631 
632  if (.not.readabort .and. .not.didread) then
633  WRITE(nulprt,*) subname,wstr,'restart field missing with readabort = ',readabort
634  WRITE(nulprt,*) subname,wstr,'restart field missing for file = ',trim(rstfile)
635  WRITE(nulprt,*) subname,wstr,'restart field missing for hot = ',n
636  WRITE(nulprt,*) subname,wstr,'restart field missing setting values to zero'
637  endif
638  endif
639  enddo
640  CALL mct_avect_clean(avtmp)
641  ENDIF
642 
643  !------------------------------------------------
644  !> * compute lag time, only on put side
645  !> * set time_now, is it a coupling period?
646  !------------------------------------------------
647 
648  call oasis_debug_note(subname//' set mseclag')
649  if (getput == oasis3_put) then
650  mseclag = msec + lag
651  elseif (getput == oasis3_get) then
652  mseclag = msec
653  endif
654 
655  if (oasis_debug >= 20) then
656  write(nulprt,*) subname,' DEBUG msec,mseclag = ',msec,mseclag
657  CALL oasis_flush(nulprt)
658  endif
659 
660  time_now = .false.
661  if (mod(mseclag,dt) == 0) time_now = .true.
662 
663  !------------------------------------------------
664  !> * check that model hasn't gone past maxtime
665  !------------------------------------------------
666 
667  if (msec >= maxtime) then
668  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
669  write(nulprt,*) subname,estr,'model time beyond namcouple maxtime = ',msec,maxtime
670  call oasis_abort(file=__file__,line=__line__)
671  endif
672 
673  !------------------------------------------------
674  !> * check that model isn't going backwards
675  ! msec >= 0 does the check only in run mode, not in initialization
676  !------------------------------------------------
677 
678  if (pcpointer%ctime /= ispval .and. msec >= 0 .and. msec < pcpointer%ctime) then
679  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
680  write(nulprt,*) subname,estr,'model seems to be running backwards = ',pcpointer%ctime
681  call oasis_abort(file=__file__,line=__line__)
682  endif
683 
684  !------------------------------------------------
685  !> * check that variable didn't miss a coupling period
686  ! check only for send recv operations where deadlock
687  ! is possible. Allow 1*dt for synchronous operations,
688  ! 2*dt for asynchronous operations
689  !------------------------------------------------
690 
691  do n = 1,prism_mcoupler
692  do npc = 1,2
693  if (npc == 1) pcpointmp => prism_coupler_put(n)
694  if (npc == 2) pcpointmp => prism_coupler_get(n)
695  if (pcpointmp%valid) then
696  if (prism_part(pcpointmp%partID)%lsize > 0) then
697 
698  if (oasis_debug >= 20) then
699  write(nulprt,'(2a,4i6,2l3,i8)') subname,'deadlock_chkA ',varid,nc,n,npc,sndrcv,pcpointmp%sndrcv,msec
700  write(nulprt,'(2a,1x,a,2i8,1x,a,2i8)') subname,'deadlock_chkB ',trim(pcpointer%fldlist),pcpointer%ltime,pcpointer%dt,trim(pcpointmp%fldlist),pcpointmp%ltime,pcpointmp%dt
701  endif
702 
703  if ((sndrcv .and. pcpointmp%sndrcv .and. time_now) .and. &
704  ((pcpointmp%ltime /= ispval .and. msec > pcpointmp%ltime + pcpointmp%dt) .or. &
705  (pcpointmp%ltime == ispval .and. pcpointer%ltime /= ispval .and. msec >= pcpointmp%dt ))) then
706  write(nulprt,'(3a)') subname,estr,'coupling skipped at earlier time, potential deadlock '
707  write(nulprt,'(3a,i8,2a)') subname,estr,'my coupler = ',cplid,' variable = ',&
708  trim(pcpointer%fldlist)
709  write(nulprt,'(3a,i12,a,i12)') subname,estr,'current time = ',msec,' mseclag = ',mseclag
710  write(nulprt,'(3a,2i12)') subname,estr,'my coupler last time and dt = ',pcpointer%ltime,pcpointer%dt
711  write(nulprt,'(3a,i8,2a)') subname,estr,'skipped coupler = ',n,' variable = ',&
712  trim(pcpointmp%fldlist)
713  write(nulprt,'(3a,2i12)') subname,estr,'skipped coupler last time and dt = ',&
714  pcpointmp%ltime,pcpointmp%dt
715  call oasis_abort(file=__file__,line=__line__)
716  endif
717  endif ! part lsize
718  endif ! valid
719  enddo ! npc
720  enddo ! prism_mcoupler
721 
722  !------------------------------------------------
723  !> * check that prior sequences weren't missed at this
724  !> step for get (recv) operation.
725  ! attempts to trap deadlocks before they happen
726  !------------------------------------------------
727 
728  if (sndrcv .and. getput == oasis3_get) then
729  if (lastseqtime /= ispval .and. msec == lastseqtime .and. pcpointer%seq < lastseq) then
730  write(nulprt,*) subname,estr,'coupling sequence out of order, potential deadlock '
731  write(nulprt,*) subname,estr,'my coupler = ',cplid,' variable = ',&
732  trim(pcpointer%fldlist)
733  write(nulprt,*) subname,' ERRRO: sequence number = ',pcpointer%seq
734  write(nulprt,*) subname,estr,'current time = ',msec,' mseclag = ',mseclag
735  write(nulprt,*) subname,estr,'last sequence and time = ',lastseq,lastseqtime
736  WRITE(nulprt,*) subname,estr,'model sequence does not match coupling sequence'
737  call oasis_abort(file=__file__,line=__line__)
738  else
739  lastseq = pcpointer%seq
740  lastseqtime = msec
741  endif
742  if (oasis_debug >= 20) then
743  write(nulprt,*) subname,' DEBUG sequence ',trim(vname),msec,lastseqtime,lastseq,pcpointer%seq
744  endif
745  endif
746 
747  !------------------------------------------------
748  !> * compute field index and check sizes
749  !------------------------------------------------
750 
751  call oasis_debug_note(subname//' compute field index and sizes')
752  nfav = mct_avect_indexra(pcpointer%avect1,trim(vname))
753  nsav = mct_avect_lsize(pcpointer%avect1)
754  if (lag > 0 .and. lreadrest) nsa=size(array1din)
755  if (present(array1din )) nsa = size(array1din )
756  if (present(array1dout)) nsa = size(array1dout)
757  if (present(array2dout)) nsa = size(array2dout)
758 
759  if (oasis_debug >= 20) then
760  write(nulprt,*) subname,' DEBUG nfav,nsav,nsa = ',nfav,nsav,nsa
761  endif
762 
763  if (nsav /= nsa) then
764  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
765  write(nulprt,*) subname,estr,'in field size passed into get/put compare to expected size ',nsav,nsa
766  call oasis_abort(file=__file__,line=__line__)
767  endif
768 
769  if (nfav < 1 .or. nfav > mct_avect_nrattr(pcpointer%avect1)) then
770  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
771  write(nulprt,*) subname,estr,'ivalid variable name nfav = ',nfav
772  call oasis_abort(file=__file__,line=__line__)
773  endif
774 
775  !------------------------------------------------
776  !> * check for higher order coupling fields
777  !> and get everything ready
778  ! arrayon is what's passed this time
779  ! optional args only on put side
780  !------------------------------------------------
781 
782  if ((getput == oasis3_get) .or. &
783  (getput == oasis3_put .and. trim(pcpointer%maploc) == "dst" )) then
784  if (arrayon(2) .or. arrayon(3) .or. &
785  arrayon(4) .or. arrayon(5)) then
786  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
787  write(nulprt,*) subname,estr,'higher order mapping not allowed on get side'
788  write(nulprt,*) subname,estr,'consider changing map location from dst to src'
789  call oasis_abort(file=__file__,line=__line__)
790  endif
791  endif
792 
793  if ((arrayon(2) .and. .not.present(array2)) .or. &
794  (arrayon(3) .and. .not.present(array3)) .or. &
795  (arrayon(4) .and. .not.present(array4)) .or. &
796  (arrayon(5) .and. .not.present(array5))) then
797  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
798  write(nulprt,*) subname,estr,'arrayon true but array not sent'
799  call oasis_abort(file=__file__,line=__line__)
800  ! With the current way of using oasis_advance_run, the above test is useless but we keep the test
801  ! as someone might be later adding an interface call that would violate the consistency
802  endif
803 
804  ! initialize aVect2-5 here if not already allocated
805 
806  if (arrayon(2) .and. .not. pcpointer%aVon(2)) then
807  call mct_avect_init(pcpointer%aVect2,pcpointer%aVect1,nsav)
808  call mct_avect_zero(pcpointer%aVect2)
809  pcpointer%aVon(2) = .true.
810  if (oasis_debug >= 2) then
811  write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
812  trim(vname),' ','aVect2'
813  endif
814  endif
815 
816  if (arrayon(3) .and. .not. pcpointer%aVon(3)) then
817  call mct_avect_init(pcpointer%aVect3,pcpointer%aVect1,nsav)
818  call mct_avect_zero(pcpointer%aVect3)
819  pcpointer%aVon(3) = .true.
820  if (oasis_debug >= 2) then
821  write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
822  trim(vname),' ','aVect3'
823  endif
824  endif
825 
826  if (arrayon(4) .and. .not. pcpointer%aVon(4)) then
827  call mct_avect_init(pcpointer%aVect4,pcpointer%aVect1,nsav)
828  call mct_avect_zero(pcpointer%aVect4)
829  pcpointer%aVon(4) = .true.
830  if (oasis_debug >= 2) then
831  write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
832  trim(vname),' ','aVect4'
833  endif
834  endif
835 
836  if (arrayon(5) .and. .not. pcpointer%aVon(5)) then
837  call mct_avect_init(pcpointer%aVect5,pcpointer%aVect1,nsav)
838  call mct_avect_zero(pcpointer%aVect5)
839  pcpointer%aVon(5) = .true.
840  if (oasis_debug >= 2) then
841  write(nulprt,*) subname,' at ',msec,mseclag,' ALLO: ',&
842  trim(vname),' ','aVect5'
843  endif
844  endif
845 
846  !------------------------------------------------
847  !> * update avect1-5 on put side and apply appropriate transform
848  !> * if its coupling time, set status of this var to ready
849  !> * write restart if requested by interface
850  ! on restart, treat as instant value
851  !------------------------------------------------
852 
853  if (getput == oasis3_put) then
854 
855  call oasis_debug_note(subname//' loctrans operation')
856  write(tstring,f01) 'pcpy_',cplid
857 
858  if (local_timers_on) call oasis_timer_start(tstring)
859 
860  cstring = 'none'
861  if (lreadrest .or. pcpointer%trans == ip_instant) then
862  if (time_now) then
863  cstring = 'instant'
864  do n = 1,nsav
865  pcpointer%avect1%rAttr(nfav,n) = array1din(n)
866  if (pcpointer%aVon(2)) then
867  if (present(array2)) then
868  pcpointer%avect2%rAttr(nfav,n) = array2(n)
869  else
870  pcpointer%avect2%rAttr(nfav,n) = 0.0
871  endif
872  endif
873  if (pcpointer%aVon(3)) then
874  if (present(array3)) then
875  pcpointer%avect3%rAttr(nfav,n) = array3(n)
876  else
877  pcpointer%avect3%rAttr(nfav,n) = 0.0
878  endif
879  endif
880  if (pcpointer%aVon(4)) then
881  if (present(array4)) then
882  pcpointer%avect4%rAttr(nfav,n) = array4(n)
883  else
884  pcpointer%avect4%rAttr(nfav,n) = 0.0
885  endif
886  endif
887  if (pcpointer%aVon(5)) then
888  if (present(array5)) then
889  pcpointer%avect5%rAttr(nfav,n) = array5(n)
890  else
891  pcpointer%avect5%rAttr(nfav,n) = 0.0
892  endif
893  endif
894  enddo
895  pcpointer%avcnt(nfav) = 1
896  endif
897 
898  elseif (pcpointer%trans == ip_average) then
899  cstring = 'average'
900  if (kinfo == oasis_ok) kinfo = oasis_loctrans
901  do n = 1,nsav
902  pcpointer%avect1%rAttr(nfav,n) = &
903  pcpointer%avect1%rAttr(nfav,n) + array1din(n)
904  if (pcpointer%aVon(2)) then
905  if (present(array2)) then
906  pcpointer%avect2%rAttr(nfav,n) = &
907  pcpointer%avect2%rAttr(nfav,n) + array2(n)
908  endif
909  endif
910  if (pcpointer%aVon(3)) then
911  if (present(array3)) then
912  pcpointer%avect3%rAttr(nfav,n) = &
913  pcpointer%avect3%rAttr(nfav,n) + array3(n)
914  endif
915  endif
916  if (pcpointer%aVon(4)) then
917  if (present(array4)) then
918  pcpointer%avect4%rAttr(nfav,n) = &
919  pcpointer%avect4%rAttr(nfav,n) + array4(n)
920  endif
921  endif
922  if (pcpointer%aVon(5)) then
923  if (present(array5)) then
924  pcpointer%avect5%rAttr(nfav,n) = &
925  pcpointer%avect5%rAttr(nfav,n) + array5(n)
926  endif
927  endif
928  enddo
929  pcpointer%avcnt(nfav) = pcpointer%avcnt(nfav) + 1
930 
931  elseif (pcpointer%trans == ip_accumul) then
932  cstring = 'accumul'
933  if (kinfo == oasis_ok) kinfo = oasis_loctrans
934  do n = 1,nsav
935  pcpointer%avect1%rAttr(nfav,n) = &
936  pcpointer%avect1%rAttr(nfav,n) + array1din(n)
937  if (pcpointer%aVon(2)) then
938  if (present(array2)) then
939  pcpointer%avect2%rAttr(nfav,n) = &
940  pcpointer%avect2%rAttr(nfav,n) + array2(n)
941  endif
942  endif
943  if (pcpointer%aVon(3)) then
944  if (present(array3)) then
945  pcpointer%avect3%rAttr(nfav,n) = &
946  pcpointer%avect3%rAttr(nfav,n) + array3(n)
947  endif
948  endif
949  if (pcpointer%aVon(4)) then
950  if (present(array4)) then
951  pcpointer%avect4%rAttr(nfav,n) = &
952  pcpointer%avect4%rAttr(nfav,n) + array4(n)
953  endif
954  endif
955  if (pcpointer%aVon(5)) then
956  if (present(array5)) then
957  pcpointer%avect5%rAttr(nfav,n) = &
958  pcpointer%avect5%rAttr(nfav,n) + array5(n)
959  endif
960  endif
961  enddo
962  pcpointer%avcnt(nfav) = 1
963 
964  elseif (pcpointer%trans == ip_max) then
965  cstring = 'max'
966  if (kinfo == oasis_ok) kinfo = oasis_loctrans
967  if (pcpointer%aVon(2) .or. pcpointer%aVon(3) .or. &
968  pcpointer%aVon(4) .or. pcpointer%aVon(5)) then
969  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
970  write(nulprt,*) subname,estr,'higher order mapping with MAX transform not supported'
971  call oasis_abort(file=__file__,line=__line__)
972  endif
973  do n = 1,nsav
974  if (pcpointer%avcnt(nfav) == 0) then
975  pcpointer%avect1%rAttr(nfav,n) = array1din(n)
976  else
977  pcpointer%avect1%rAttr(nfav,n) = &
978  max(pcpointer%avect1%rAttr(nfav,n),array1din(n))
979  endif
980  enddo
981  pcpointer%avcnt(nfav) = 1
982 
983  elseif (pcpointer%trans == ip_min) then
984  cstring = 'min'
985  if (kinfo == oasis_ok) kinfo = oasis_loctrans
986  if (pcpointer%aVon(2) .or. pcpointer%aVon(3) .or. &
987  pcpointer%aVon(4) .or. pcpointer%aVon(5)) then
988  write(nulprt,*) subname,estr,'at ',msec,mseclag,' for var = ',trim(vname)
989  write(nulprt,*) subname,estr,'higher order mapping with MIN transform not supported'
990  call oasis_abort(file=__file__,line=__line__)
991  endif
992  do n = 1,nsav
993  if (pcpointer%avcnt(nfav) == 0) then
994  pcpointer%avect1%rAttr(nfav,n) = array1din(n)
995  else
996  pcpointer%avect1%rAttr(nfav,n) = &
997  min(pcpointer%avect1%rAttr(nfav,n),array1din(n))
998  endif
999  enddo
1000  pcpointer%avcnt(nfav) = 1
1001 
1002  else
1003  write(nulprt,*) subname,estr,'transform not known for var = ',trim(vname),pcpointer%trans
1004  call oasis_abort(file=__file__,line=__line__)
1005  endif
1006  if (local_timers_on) call oasis_timer_stop(tstring)
1007 
1008  if (oasis_debug >= 2 .and. trim(cstring) /= 'none') then
1009  write(nulprt,*) subname,' at ',msec,mseclag,' PACK: ',&
1010  trim(vname),' ',trim(cstring)
1011  endif
1012 
1013  if (oasis_debug >= 20) then
1014  write(nulprt,*) subname,' DEBUG loctrans update ',cplid,' ',&
1015  trim(cstring),pcpointer%avcnt(nfav)
1016  endif
1017 
1018  if (time_now) then
1019  pcpointer%status(nfav) = oasis_comm_ready
1020  endif
1021  endif
1022 
1023  !------------------------------------------------
1024  !> * decide if it's time to communicate based on time
1025  ! also, on the put side, status of all vars
1026  ! must be ready which means all vars have called put.
1027  ! on get side, all ready means all vars have unpacked
1028  ! from last get.
1029  !------------------------------------------------
1030 
1031  call oasis_debug_note(subname//' comm_now compute')
1032  comm_now = .false.
1033  if (time_now) then
1034  comm_now = .true.
1035  do nf = 1,pcpointer%nflds
1036  if (pcpointer%status(nf) /= oasis_comm_ready) then
1037  comm_now = .false.
1038  if (oasis_debug >= 15) then
1039  write(nulprt,*) subname,' at ',msec,mseclag,' STAT: ',nf,' NOT READY'
1040  endif
1041  kinfo=oasis_waitgroup
1042  else
1043  if (oasis_debug >= 15) then
1044  write(nulprt,*) subname,' at ',msec,mseclag,' STAT: ',nf,' READY'
1045  endif
1046  endif
1047  enddo
1048  endif
1049 
1050  !------------------------------------------------
1051  !> * If it's time to communicate
1052  !------------------------------------------------
1053 
1054  if (comm_now) then
1055 
1056  call oasis_debug_note(subname//' comm_now')
1057 
1058  !------------------------------------------------
1059  !> * check again that time is correct
1060  ! this is the time critical bit, we need to make sure the
1061  ! model is truly advancing in time when comms are called.
1062  ! must ignore the initial call, ltime = 0
1063  !------------------------------------------------
1064 
1065  if (pcpointer%ltime /= ispval .and. msec <= pcpointer%ltime) then
1066  write(nulprt,*) subname,estr,'model did not advance in time correctly for var = ',trim(vname)
1067  write(nulprt,*) subname,estr,'msec, ltime = ',msec,pcpointer%ltime
1068  call oasis_abort(file=__file__,line=__line__)
1069  endif
1070 
1071  !------------------------------------------------
1072  !> * average as needed for some transforms
1073  ! (not cache friendly yet)
1074  !------------------------------------------------
1075 
1076  if (getput == oasis3_put) then
1077  call oasis_debug_note(subname//' loctrans calc')
1078  write(tstring,f01) 'pavg_',cplid
1079  if (local_timers_on) call oasis_timer_start(tstring)
1080  do nf = 1,pcpointer%nflds
1081  if (pcpointer%avcnt(nf) > 1) then
1082  rcnt = 1.0/pcpointer%avcnt(nf)
1083  do n = 1,nsav
1084  pcpointer%avect1%rAttr(nf,n) = &
1085  pcpointer%avect1%rAttr(nf,n) * rcnt
1086  if (pcpointer%aVon(2)) then
1087  pcpointer%avect2%rAttr(nf,n) = &
1088  pcpointer%avect2%rAttr(nf,n) * rcnt
1089  endif
1090  if (pcpointer%aVon(3)) then
1091  pcpointer%avect3%rAttr(nf,n) = &
1092  pcpointer%avect3%rAttr(nf,n) * rcnt
1093  endif
1094  if (pcpointer%aVon(4)) then
1095  pcpointer%avect4%rAttr(nf,n) = &
1096  pcpointer%avect4%rAttr(nf,n) * rcnt
1097  endif
1098  if (pcpointer%aVon(5)) then
1099  pcpointer%avect5%rAttr(nf,n) = &
1100  pcpointer%avect5%rAttr(nf,n) * rcnt
1101  endif
1102  enddo
1103  endif
1104  if (oasis_debug >= 20) then
1105  write(nulprt,*) subname,' DEBUG loctrans calc0 = ',cplid,nf,&
1106  pcpointer%avcnt(nf)
1107  write(nulprt,*) subname,' DEBUG loctrans calc1 = ',cplid,nf,&
1108  minval(pcpointer%avect1%rAttr(nf,:)),&
1109  maxval(pcpointer%avect1%rAttr(nf,:))
1110  call oasis_flush(nulprt)
1111  if (pcpointer%aVon(2)) &
1112  write(nulprt,*) subname,' DEBUG loctrans calc2 = ',cplid,nf,&
1113  minval(pcpointer%avect2%rAttr(nf,:)),&
1114  maxval(pcpointer%avect2%rAttr(nf,:))
1115  if (pcpointer%aVon(3)) &
1116  write(nulprt,*) subname,' DEBUG loctrans calc3 = ',cplid,nf,&
1117  minval(pcpointer%avect3%rAttr(nf,:)),&
1118  maxval(pcpointer%avect3%rAttr(nf,:))
1119  if (pcpointer%aVon(4)) &
1120  write(nulprt,*) subname,' DEBUG loctrans calc4 = ',cplid,nf,&
1121  minval(pcpointer%avect4%rAttr(nf,:)),&
1122  maxval(pcpointer%avect4%rAttr(nf,:))
1123  if (pcpointer%aVon(5)) &
1124  write(nulprt,*) subname,' DEBUG loctrans calc5 = ',cplid,nf,&
1125  minval(pcpointer%avect5%rAttr(nf,:)),&
1126  maxval(pcpointer%avect5%rAttr(nf,:))
1127  endif
1128  enddo
1129  if (local_timers_on) call oasis_timer_stop(tstring)
1130  endif
1131 
1132  !------------------------------------------------
1133  !> * write to restart file if put and at the end of the run,
1134  !> turn off communication
1135  ! past namcouple runtime (maxtime) no communication
1136  ! do restart if time+lag = maxtime, this assumes coupling
1137  ! period and lag and maxtime are all nicely consistent
1138  !------------------------------------------------
1139 
1140  if (mseclag >= maxtime) then
1141  sndrcv = .false. ! turn off communication
1142  unpack = .false. ! nothing to unpack
1143  endif
1144 
1145  if (len_trim(rstfile) > 0) then
1146  if ((getput == oasis3_put .and. lag > 0 .and. mseclag == maxtime) .or. &
1147  (getput == oasis3_put .and. pcpointer%writrest)) then
1148  call oasis_debug_note(subname//' lag restart write')
1149 
1150  if (lag > 0 .and. mseclag == maxtime) then
1151  kinfo = oasis_torest
1152  rstfile2 = rstfile
1153  else ! writrest
1154  pcpointer%writrest = .false.
1155  write(rstfile2,'(a,i9.9,a,a)') 'TC',msec,'_',trim(rstfile)
1156  endif
1157 
1158  write(tstring,f01) 'wrst_',cplid
1159  if (local_timers_on) call oasis_timer_start(tstring)
1160  call oasis_io_write_avfile(rstfile2,pcpointer%avect1, &
1161  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny)
1162  if (pcpointer%aVon(2)) &
1163  call oasis_io_write_avfile(rstfile2,pcpointer%avect2, &
1164  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre='av2_')
1165  if (pcpointer%aVon(3)) &
1166  call oasis_io_write_avfile(rstfile2,pcpointer%avect3, &
1167  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre='av3_')
1168  if (pcpointer%aVon(4)) &
1169  call oasis_io_write_avfile(rstfile2,pcpointer%avect4, &
1170  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre='av4_')
1171  if (pcpointer%aVon(5)) &
1172  call oasis_io_write_avfile(rstfile2,pcpointer%avect5, &
1173  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre='av5_')
1174  if (local_timers_on) call oasis_timer_stop(tstring)
1175  if (oasis_debug >= 2) then
1176  lstring = mct_avect_exportrlist2c(pcpointer%avect1)
1177  llstring = len_trim(lstring)
1178  if (llstring <= 20) then
1179  write(nulprt,*) subname,' at ',msec,mseclag,' WRST: ', &
1180  trim(lstring),' ',trim(rstfile2)
1181  else
1182  write(nulprt,*) subname,' at ',msec,mseclag,' WRST: ', lstring(1:20), &
1183  lstring(21:llstring),' ',trim(rstfile2)
1184  endif
1185  call oasis_flush(nulprt)
1186  endif
1187  endif
1188  endif ! len_trim(rstfile)
1189 
1190  !------------------------------------------------
1191  !> * map and communicate operations
1192  !------------------------------------------------
1193 
1194  if (sndrcv) then
1195  if (getput == oasis3_put) then
1196  kinfo = oasis_sent
1197  call oasis_debug_note(subname//' put section')
1198  if (oasis_debug >= 2) then
1199  lstring = mct_avect_exportrlist2c(pcpointer%avect1)
1200  llstring = len_trim(lstring)
1201  if (llstring <= 20) then
1202  write(nulprt,*) subname,' at ',msec,mseclag,' SEND: ', &
1203  trim(lstring)
1204  else
1205  write(nulprt,*) subname,' at ',msec,mseclag,' SEND: ',lstring(1:20), &
1206  lstring(21:llstring)
1207  endif
1208  call oasis_flush(nulprt)
1209  endif
1210  if (sndadd /= 0.0_ip_double_p .or. sndmult /= 1.0_ip_double_p) then
1211  call oasis_debug_note(subname//' apply sndmult sndadd')
1212  if (oasis_debug >= 20) then
1213  write(nulprt,*) subname,' DEBUG sndmult,add = ',sndmult,sndadd
1214  write(nulprt,*) subname,' DEBUG put b4 sndmult,add = ',cplid,&
1215  minval(pcpointer%avect1%rAttr),&
1216  maxval(pcpointer%avect1%rAttr)
1217  endif
1218  pcpointer%avect1%rAttr(:,:) = pcpointer%avect1%rAttr(:,:)*sndmult &
1219  + sndadd
1220  endif
1221  if (snddiag) call oasis_advance_avdiag(pcpointer%avect1,prism_part(partid)%mpicom)
1222  if (mapid > 0) then
1223  write(tstring,f01) 'pmap_',cplid
1224  call oasis_debug_note(subname//' put map')
1225  if (oasis_debug >= 20) then
1226  write(nulprt,*) subname,' DEBUG put av11 b4 map = ',cplid,&
1227  minval(pcpointer%avect1%rAttr),&
1228  maxval(pcpointer%avect1%rAttr)
1229  if (pcpointer%aVon(2)) &
1230  write(nulprt,*) subname,' DEBUG put av2 b4 map = ',cplid,&
1231  minval(pcpointer%avect2%rAttr),&
1232  maxval(pcpointer%avect2%rAttr)
1233  if (pcpointer%aVon(3)) &
1234  write(nulprt,*) subname,' DEBUG put av3 b4 map = ',cplid,&
1235  minval(pcpointer%avect3%rAttr),&
1236  maxval(pcpointer%avect3%rAttr)
1237  if (pcpointer%aVon(4)) &
1238  write(nulprt,*) subname,' DEBUG put av4 b4 map = ',cplid,&
1239  minval(pcpointer%avect4%rAttr),&
1240  maxval(pcpointer%avect4%rAttr)
1241  if (pcpointer%aVon(5)) &
1242  write(nulprt,*) subname,' DEBUG put av5 b4 map = ',cplid,&
1243  minval(pcpointer%avect5%rAttr),&
1244  maxval(pcpointer%avect5%rAttr)
1245  endif
1246  if (map_barrier .and. prism_part(partid)%mpicom /= mpi_comm_null) then
1247  if (local_timers_on) call oasis_timer_start(trim(tstring)//'_prebarrier')
1248  call oasis_mpi_barrier(prism_part(partid)%mpicom, trim(tstring))
1249  if (local_timers_on) call oasis_timer_stop(trim(tstring)//'_prebarrier')
1250  endif
1251  if (local_timers_on) call oasis_timer_start(tstring)
1252  if (lucia_debug > 0) &
1253  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1254  'Balance: ',pcpointer%namID,' Before interpo ', mpi_wtime()
1255  call mct_avect_zero(pcpointer%avect1m)
1256  if (detailed_map_timing) then
1257  call oasis_advance_map(pcpointer%avect1, &
1258  pcpointer%avect1m,prism_mapper(mapid),conserv,consopt, &
1259  pcpointer%aVon ,pcpointer%avect2, &
1260  pcpointer%avect3,pcpointer%avect4, &
1261  pcpointer%avect5,tstrinp=tstring)
1262  else
1263  call oasis_advance_map(pcpointer%avect1, &
1264  pcpointer%avect1m,prism_mapper(mapid),conserv,consopt, &
1265  pcpointer%aVon ,pcpointer%avect2, &
1266  pcpointer%avect3,pcpointer%avect4, &
1267  pcpointer%avect5)
1268  endif
1269  if (lucia_debug > 0) &
1270  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1271  'Balance: ',pcpointer%namID,' After interpo ', mpi_wtime()
1272  if (local_timers_on) call oasis_timer_stop(tstring)
1273  write(tstring,f01) 'psnd_',cplid
1274  call oasis_debug_note(subname//' put send')
1275  if (oasis_debug >= 20) then
1276  write(nulprt,*) subname,' DEBUG put av1m b4 send = ',cplid,&
1277  minval(pcpointer%avect1m%rAttr),&
1278  maxval(pcpointer%avect1m%rAttr)
1279  endif
1280  if (local_timers_on) call oasis_timer_start(tstring)
1281  if (lucia_debug > 0) &
1282  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1283  'Balance: ',pcpointer%namID,' Before MPI put ', mpi_wtime()
1284  call mct_waitsend(prism_router(rouid)%router)
1285  call mct_isend(pcpointer%avect1m,prism_router(rouid)%router,tag)
1286  if (lucia_debug > 0) &
1287  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1288  'Balance: ',pcpointer%namID,' After MPI put ', mpi_wtime()
1289  if (local_timers_on) call oasis_timer_stop(tstring)
1290  ELSE
1291  write(tstring,f01) 'psnd_',cplid
1292  call oasis_debug_note(subname//' put send')
1293  if (oasis_debug >= 20) then
1294  write(nulprt,*) subname,' DEBUG put av1 b4 send = ',cplid,&
1295  minval(pcpointer%avect1%rAttr),&
1296  maxval(pcpointer%avect1%rAttr)
1297  endif
1298  if (local_timers_on) call oasis_timer_start(tstring)
1299  if (lucia_debug > 0) &
1300  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1301  'Balance: ',pcpointer%namID,' Before MPI put ', mpi_wtime()
1302  call mct_waitsend(prism_router(rouid)%router)
1303  call mct_isend(pcpointer%avect1,prism_router(rouid)%router,tag)
1304  if (lucia_debug > 0) &
1305  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1306  'Balance: ',pcpointer%namID,' After MPI put ', mpi_wtime()
1307  if (local_timers_on) call oasis_timer_stop(tstring)
1308  ENDIF
1309  elseif (getput == oasis3_get) then
1310  call oasis_debug_note(subname//' get section')
1311  if (oasis_debug >= 2 ) then
1312  lstring = mct_avect_exportrlist2c(pcpointer%avect1)
1313  llstring = len_trim(lstring)
1314  if (llstring <= 20) then
1315  write(nulprt,*) subname,' at ',msec,mseclag,' RECV: ', &
1316  trim(lstring)
1317  else
1318  write(nulprt,*) subname,' at ',msec,mseclag,' RECV: ',lstring(1:20), &
1319  lstring(21:llstring)
1320  endif
1321  call oasis_flush(nulprt)
1322  endif
1323  if (mapid > 0) then
1324  call oasis_debug_note(subname//' get recv')
1325  write(tstring,f01) 'grcv_',cplid
1326  if (local_timers_on) call oasis_timer_start(tstring)
1327  call mct_avect_zero(pcpointer%avect1m)
1328  if (lucia_debug > 0) &
1329  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1330  'Balance: ',pcpointer%namID,' Before MPI get ', mpi_wtime()
1331  call mct_recv(pcpointer%avect1m,prism_router(rouid)%router,tag)
1332  if (lucia_debug > 0) &
1333  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1334  'Balance: ',pcpointer%namID,' After MPI get ', mpi_wtime()
1335  if (local_timers_on) call oasis_timer_stop(tstring)
1336  if (oasis_debug >= 20) then
1337  write(nulprt,*) subname,' DEBUG get af recv = ',cplid,&
1338  minval(pcpointer%avect1m%rAttr),&
1339  maxval(pcpointer%avect1m%rAttr)
1340  endif
1341  call oasis_debug_note(subname//' get map')
1342  write(tstring,f01) 'gmap_',cplid
1343  if (map_barrier .and. prism_part(partid)%mpicom /= mpi_comm_null) then
1344  if (local_timers_on) call oasis_timer_start(trim(tstring)//'_prebarrier')
1345  call oasis_mpi_barrier(prism_part(partid)%mpicom, trim(tstring))
1346  if (local_timers_on) call oasis_timer_stop(trim(tstring)//'_prebarrier')
1347  endif
1348  if (local_timers_on) call oasis_timer_start(tstring)
1349  if (lucia_debug > 0) &
1350  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1351  'Balance: ',pcpointer%namID,' Before interpo ', mpi_wtime()
1352  call mct_avect_zero(pcpointer%avect1)
1353  if (detailed_map_timing) then
1354  call oasis_advance_map(pcpointer%avect1m, &
1355  pcpointer%avect1,prism_mapper(mapid),conserv,consopt,tstrinp=tstring)
1356  else
1357  call oasis_advance_map(pcpointer%avect1m, &
1358  pcpointer%avect1,prism_mapper(mapid),conserv,consopt)
1359  endif
1360  if (lucia_debug > 0) &
1361  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1362  'Balance: ',pcpointer%namID,' After interpo ', mpi_wtime()
1363  if (local_timers_on) call oasis_timer_stop(tstring)
1364  if (oasis_debug >= 20) then
1365  write(nulprt,*) subname,' DEBUG get af map = ',cplid,&
1366  minval(pcpointer%avect1%rAttr),&
1367  maxval(pcpointer%avect1%rAttr)
1368  endif
1369  else
1370  write(tstring,f01) 'grcv_',cplid
1371  call oasis_debug_note(subname//' get recv')
1372  call mct_avect_zero(pcpointer%avect1)
1373  if (local_timers_on) call oasis_timer_start(tstring)
1374  if (lucia_debug > 0) &
1375  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1376  'Balance: ',pcpointer%namID,' Before MPI get ', mpi_wtime()
1377  call mct_recv(pcpointer%avect1,prism_router(rouid)%router,tag)
1378  if (lucia_debug > 0) &
1379  WRITE(nullucia, fmt='(A,I3.3,A,F16.5)') &
1380  'Balance: ',pcpointer%namID,' After MPI get ', mpi_wtime()
1381  if (local_timers_on) call oasis_timer_stop(tstring)
1382  if (oasis_debug >= 20) then
1383  write(nulprt,*) subname,' DEBUG get af recv = ',cplid,&
1384  minval(pcpointer%avect1%rAttr),&
1385  maxval(pcpointer%avect1%rAttr)
1386  endif
1387  endif
1388  call oasis_debug_note(subname//' apply rcvmult rcvadd')
1389  if (rcvadd /= 0.0_ip_double_p .or. rcvmult /= 1.0_ip_double_p) then
1390  pcpointer%avect1%rAttr(:,:) = pcpointer%avect1%rAttr(:,:)*rcvmult &
1391  + rcvadd
1392  if (oasis_debug >= 20) then
1393  write(nulprt,*) subname,' DEBUG rcvmult,add = ',rcvmult,rcvadd
1394  write(nulprt,*) subname,' DEBUG get af rcvmult,add = ',cplid,&
1395  minval(pcpointer%avect1%rAttr),&
1396  maxval(pcpointer%avect1%rAttr)
1397  endif
1398  endif
1399  if (rcvdiag) call oasis_advance_avdiag(pcpointer%avect1,prism_part(partid)%mpicom)
1400  endif ! getput
1401  endif ! sndrcv
1402 
1403  !------------------------------------------------
1404  !> * write to output files if output is turned on
1405  !------------------------------------------------
1406 
1407  if (output) then
1408  if (kinfo == oasis_sent) then
1409  kinfo = oasis_sentout
1410  elseif (kinfo == oasis_torest) then
1411  kinfo = oasis_torestout
1412  else
1413  kinfo = oasis_output
1414  endif
1415  call oasis_debug_note(subname//' output')
1416  write(tstring,f01) 'wout_',cplid
1417  if (local_timers_on) call oasis_timer_start(tstring)
1418  if (oasis_debug >= 2) then
1419  lstring = mct_avect_exportrlist2c(pcpointer%avect1)
1420  llstring = len_trim(lstring)
1421  if (llstring <= 20) then
1422  write(nulprt,*) subname,' at ',msec,mseclag,' WRIT: ', &
1423  trim(lstring)
1424  else
1425  write(nulprt,*) subname,' at ',msec,mseclag,' WRIT: ',lstring(1:20), &
1426  lstring(21:llstring)
1427  endif
1428  call oasis_flush(nulprt)
1429  endif
1430  write(fstring,'(A,I2.2)') '_'//trim(compnm)//'_',cplid
1431  call oasis_io_write_avfbf(pcpointer%avect1,prism_part(partid)%pgsmap,prism_part(partid)%mpicom, &
1432  nx,ny,msec,fstring)
1433  if (local_timers_on) call oasis_timer_stop(tstring)
1434 
1435  if (oasis_debug >= 30) then
1436  call mct_avect_init(avtest,pcpointer%avect1,&
1437  mct_avect_lsize(pcpointer%avect1))
1438  write(tstring,f01) 'rinp_',cplid
1439  if (local_timers_on) call oasis_timer_start(tstring)
1440  call oasis_io_read_avfbf(avtest,prism_part(partid)%pgsmap,prism_part(partid)%mpicom,msec,fstring)
1441  write(nulprt,*) subname,' DEBUG write/read test avfbf should be zero ',&
1442  sum(pcpointer%avect1%rAttr-avtest%rAttr)
1443  call mct_avect_clean(avtest)
1444  if (local_timers_on) call oasis_timer_stop(tstring)
1445  endif
1446 
1447  endif
1448 
1449  !------------------------------------------------
1450  !> * set avcnt, avect1, ltime, and status
1451  !------------------------------------------------
1452 
1453  call oasis_debug_note(subname//' reset status')
1454  if (getput == oasis3_put) then
1455  if (.not.lreadrest) pcpointer%ltime = msec
1456  pcpointer%status(:) = oasis_comm_wait
1457  pcpointer%avcnt(:) = 0
1458  call mct_avect_zero(pcpointer%avect1)
1459  if (pcpointer%aVon(2)) &
1460  call mct_avect_zero(pcpointer%avect2)
1461  if (pcpointer%aVon(3)) &
1462  call mct_avect_zero(pcpointer%avect3)
1463  if (pcpointer%aVon(4)) &
1464  call mct_avect_zero(pcpointer%avect4)
1465  if (pcpointer%aVon(5)) &
1466  call mct_avect_zero(pcpointer%avect5)
1467  if (oasis_debug >= 20) then
1468  write(nulprt,*) subname,' DEBUG put reset status = '
1469  endif
1470  elseif (getput == oasis3_get) then
1471  if (.not.lreadrest) pcpointer%ltime = msec
1472  pcpointer%status(:) = oasis_comm_wait
1473  if (oasis_debug >= 20) then
1474  write(nulprt,*) subname,' DEBUG get reset status = '
1475  endif
1476  endif
1477 
1478  else
1479 
1480  !------------------------------------------------
1481  ! no action, document
1482  !------------------------------------------------
1483 
1484  if (oasis_debug >= 15) then
1485  lstring = mct_avect_exportrlist2c(pcpointer%avect1)
1486  llstring = len_trim(lstring)
1487  if (llstring <= 20) then
1488  write(nulprt,*) subname,' at ',msec,mseclag,' SKIP: ', &
1489  trim(lstring)
1490  else
1491  write(nulprt,*) subname,' at ',msec,mseclag,' SKIP: ',lstring(1:20), &
1492  lstring(21:llstring)
1493  endif
1494  call oasis_flush(nulprt)
1495  endif
1496 
1497  endif ! comm_now
1498 
1499  pcpointer%ctime = msec
1500 
1501  !------------------------------------------------
1502  !> * at the end of the run only, save fields associated
1503  !> with non-instant loctrans operations to restart files
1504  !------------------------------------------------
1505 
1506  IF ((mseclag + dt >= maxtime .AND. &
1507  getput == oasis3_put .and. pcpointer%trans /= ip_instant .and. &
1508  len_trim(rstfile) > 0) .or. &
1509  (getput == oasis3_put .and. pcpointer%writrest .and. len_trim(rstfile) > 0)) then
1510 
1511  if (mseclag + dt >= maxtime) then
1512  rstfile2 = rstfile
1513  else ! writrest
1514  pcpointer%writrest = .false.
1515  write(rstfile2,'(a,i9.9,a,a)') 'TA',msec,'_',trim(rstfile)
1516  endif
1517 
1518  call oasis_debug_note(subname//' loctrans restart write')
1519  write(tstring,f01) 'wtrn_',cplid
1520  if (local_timers_on) call oasis_timer_start(tstring)
1521  WRITE(vstring,'(a,i6.6,a)') 'loc',pcpointer%namID,'_cnt'
1522  CALL oasis_io_write_array(rstfile2,prism_part(partid)%mpicom,iarray=pcpointer%avcnt,&
1523  ivarname=trim(vstring))
1524  write(vstring,'(a,i6.6,a)') 'loc',pcpointer%namID,'_'
1525  CALL oasis_io_write_avfile(rstfile2,pcpointer%avect1, &
1526  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre=trim(vstring))
1527  if (pcpointer%aVon(2)) then
1528  write(vstring,'(a,i6.6,a)') 'av2loc',pcpointer%namID,'_'
1529  CALL oasis_io_write_avfile(rstfile2,pcpointer%avect2, &
1530  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre=trim(vstring))
1531  endif
1532  if (pcpointer%aVon(3)) then
1533  write(vstring,'(a,i6.6,a)') 'av3loc',pcpointer%namID,'_'
1534  CALL oasis_io_write_avfile(rstfile2,pcpointer%avect3, &
1535  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre=trim(vstring))
1536  endif
1537  if (pcpointer%aVon(4)) then
1538  write(vstring,'(a,i6.6,a)') 'av4loc',pcpointer%namID,'_'
1539  CALL oasis_io_write_avfile(rstfile2,pcpointer%avect4, &
1540  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre=trim(vstring))
1541  endif
1542  if (pcpointer%aVon(5)) then
1543  write(vstring,'(a,i6.6,a)') 'av5loc',pcpointer%namID,'_'
1544  CALL oasis_io_write_avfile(rstfile2,pcpointer%avect5, &
1545  prism_part(partid)%pgsmap,prism_part(partid)%mpicom,nx,ny,nampre=trim(vstring))
1546  endif
1547  if (local_timers_on) call oasis_timer_stop(tstring)
1548  if (oasis_debug >= 2) then
1549  lstring = mct_avect_exportrlist2c(pcpointer%avect1)
1550  llstring = len_trim(lstring)
1551  if (llstring <= 20) then
1552  write(nulprt,*) subname,' at ',msec,mseclag,' WTRN: ', &
1553  trim(lstring),' ',trim(rstfile2)
1554  else
1555  write(nulprt,*) subname,' at ',msec,mseclag,' WTRN: ',lstring(1:20), &
1556  lstring(21:llstring),' ',trim(rstfile2)
1557  endif
1558  call oasis_flush(nulprt)
1559  endif
1560  if (oasis_debug >= 20) then
1561  write(nulprt,*) subname,' DEBUG write loctrans restart',cplid,&
1562  pcpointer%avcnt
1563  write(nulprt,*) subname,' DEBUG write loctrans restart',cplid,&
1564  minval(pcpointer%avect1%rAttr),&
1565  maxval(pcpointer%avect1%rAttr)
1566  endif
1567  ENDIF
1568 
1569  !------------------------------------------------
1570  !> * GET only, unpack avect1 if it's newly received
1571  !------------------------------------------------
1572 
1573  if (getput == oasis3_get) then
1574  IF (time_now .AND. unpack) THEN
1575  if (kinfo == oasis_output) then
1576  kinfo = oasis_recvout
1577  elseif (kinfo == oasis_fromrest) then
1578  kinfo = oasis_fromrestout
1579  else
1580  kinfo = oasis_recvd
1581  endif
1582  if (input) then
1583  kinfo = oasis_input
1584  call oasis_debug_note(subname//' input')
1585  if (oasis_debug >= 2) then
1586  lstring = mct_avect_exportrlist2c(pcpointer%avect1)
1587  llstring = len_trim(lstring)
1588  if (llstring <= 20) then
1589  write(nulprt,*) subname,' at ',msec,mseclag,' READ: ', &
1590  trim(lstring)
1591  else
1592  write(nulprt,*) subname,' at ',msec,mseclag,' READ: ',lstring(1:20), &
1593  lstring(21:llstring)
1594  endif
1595  call oasis_flush(nulprt)
1596  endif
1597  write(tstring,f01) 'grin_',cplid
1598  if (local_timers_on) call oasis_timer_start(tstring)
1599  if (trim(inpfile) /= trim(cspval)) then
1600  call oasis_io_read_avfbf(pcpointer%avect1,prism_part(partid)%pgsmap,prism_part(partid)%mpicom,&
1601  msec,filename=trim(inpfile))
1602  else
1603  fstring = '_'//trim(compnm)
1604  call oasis_io_read_avfbf(pcpointer%avect1,prism_part(partid)%pgsmap,prism_part(partid)%mpicom,&
1605  msec,f_string=fstring)
1606  endif
1607  if (local_timers_on) call oasis_timer_stop(tstring)
1608  endif
1609  if (oasis_debug >= 2) then
1610  write(nulprt,*) subname,' at ',msec,mseclag,' UPCK: ',trim(vname)
1611  endif
1612  write(tstring,f01) 'gcpy_',cplid
1613  call oasis_debug_note(subname//' get copy to array')
1614  if (local_timers_on) call oasis_timer_start(tstring)
1615  if (present(array1dout)) array1dout(:) = &
1616  pcpointer%avect1%rAttr(nfav,:)
1617  if (present(array2dout)) array2dout(:,:) = &
1618  reshape(pcpointer%avect1%rAttr(nfav,:),shape(array2dout))
1619  if (local_timers_on) call oasis_timer_stop(tstring)
1620  if (oasis_debug >= 20) then
1621  if (present(array1dout)) write(nulprt,*) subname,' DEBUG array copy = ',&
1622  cplid,minval(array1dout),maxval(array1dout)
1623  if (present(array2dout)) write(nulprt,*) subname,' DEBUG array copy = ',&
1624  cplid,minval(array2dout),maxval(array2dout)
1625  endif
1626  ENDIF
1627  if (time_now) pcpointer%status(nfav) = oasis_comm_ready
1628  endif
1629 
1630  if (oasis_debug >= 2) then
1631  write(nulprt,*) subname,' at ',msec,mseclag,' KINF: ',trim(vname),kinfo
1632  endif
1633 
1634  endif ! runit
1635  enddo ! nc = 1,var%ncpl
1636 
1637  call oasis_debug_exit(subname)
1638 
1639  END SUBROUTINE oasis_advance_run
1640 
1641 
1642 !-------------------------------------------------------------------
1643 
1644 !> Provides interpolation functionality
1645 
1646 !> Maps (regrids, interpolates) data from av1 to avd.
1647 !> av2-av5 are for higher order mapping (hot).
1648 
1649  SUBROUTINE oasis_advance_map(av1,avd,mapper,conserv,consopt,&
1650  avon,av2,av3,av4,av5,tstrinp)
1651 
1652  ! NOTE: mask = 0 is active point according to oasis3 conserv.f
1653 
1654  implicit none
1655  type(mct_avect) ,intent(in) :: av1 !< source av
1656  type(mct_avect) ,intent(inout) :: avd !< dst av
1657  type(prism_mapper_type),intent(inout) :: mapper !< prism_mapper
1658  integer(kind=ip_i4_p) ,intent(in),optional :: conserv !< conserv flag
1659  character(len=ic_med) ,intent(in),optional :: consopt !< conserv algorithm option
1660  logical ,intent(in),optional :: avon(:) !< which source hot are on
1661  type(mct_avect) ,intent(in),optional :: av2 !< source av2 hot
1662  type(mct_avect) ,intent(in),optional :: av3 !< source av3 hot
1663  type(mct_avect) ,intent(in),optional :: av4 !< source av4 hot
1664  type(mct_avect) ,intent(in),optional :: av5 !< source av5 hot
1665  character(len=*) ,intent(in),optional :: tstrinp !< timer label string
1666 
1667  integer(kind=ip_i4_p) :: fsize,lsizes,lsized,nf,ni,n,m,ierr
1668  real(kind=ip_r8_p) :: sumtmp, wts_sums, wts_sumd, zradi, zlagr
1669  real(kind=ip_r8_p) :: wts_sums1(1), wts_sumd1(1)
1670  integer(kind=ip_i4_p),allocatable :: imasks(:),imaskd(:)
1671  real(kind=ip_r8_p),allocatable :: areas(:),aread(:)
1672  real(kind=ip_r8_p),allocatable :: av_sums(:),av_sumd(:) ! local sums
1673  type(mct_avect) :: avdtmp ! for summing multiple mapping weights
1674  type(mct_avect) :: av2g ! for bfb sums
1675  type(mct_avect) :: avone ! for conserve
1676  character(len=ic_med) :: lconsopt ! conserve algorithm option
1677  character(len=ic_med) :: tstring ! timer string
1678  integer(kind=ip_i4_p),parameter :: avsmax = prism_coupler_avsmax
1679  logical :: locavon(avsmax) ! local avon
1680  integer(kind=ip_i4_p) :: avonsize
1681  integer(kind=ip_i4_p) :: higher_order_check
1682  character(len=*),parameter :: subname = '(oasis_advance_map)'
1683 
1684  call oasis_debug_enter(subname)
1685  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_start')
1686 
1687  !> oasis_advance_map does the following
1688  !> * check for conservation flags
1689 
1690  lconsopt = 'bfb'
1691  if (present(consopt)) then
1692  lconsopt = consopt
1693  endif
1694 
1695  !> * check for higher order terms
1696  !--- assume avon and av2-5 are not passed but av1 always is ---
1697  avonsize = 1
1698  locavon = .false.
1699  locavon(1) = .true.
1700 
1701  !--- but if avon is passed, use avon flags ---
1702  if (present(avon)) then
1703  avonsize = size(avon)
1704  if (avonsize > avsmax) then
1705  WRITE(nulprt,*) subname,estr,'avon size',avonsize,' passed in is too large',avsmax
1706  call oasis_abort(file=__file__,line=__line__)
1707  endif
1708  locavon(1:avonsize) = avon(1:avonsize)
1709  else
1710  !--- if avon is not passed, av2-5 should not be ---
1711  if (present(av2) .or. present(av3) .or. present(av4) .or. present(av5)) then
1712  WRITE(nulprt,*) subname,estr,'av2-5 passed but avon not passed'
1713  call oasis_abort(file=__file__,line=__line__)
1714  endif
1715  endif
1716 
1717  !> * check consistency between weights and coupling terms
1718 
1719  ! tcraig, redmine #709, add this to increase checking consistency, Aug 2016.
1720  higher_order_check = 1
1721 
1722  ! tcraig, redmine #709, comment this out to increase checking consistency, Aug 2016.
1723  ! this section only enforces consistency when bicubic is used
1724  ! nwgts=4 assumes bicubic which requires 4 higher order fields
1725 ! higher_order_check = 0
1726 ! if (mapper%nwgts == 4) higher_order_check = 1
1727 
1728  if (higher_order_check == 0) then
1729  ! must have weights for each higher order field passed but can have extra weights
1730  do n = 1,avsmax
1731  if (locavon(n) .and. n > mapper%nwgts) then
1732  WRITE(nulprt,*) subname,estr,'higher_order_check = ',higher_order_check
1733  WRITE(nulprt,*) subname,estr,'missing weights for higher order field'
1734  WRITE(nulprt,*) subname,estr,'missing weights output ',n,avsmax,mapper%nwgts,locavon(n)
1735  call oasis_abort(file=__file__,line=__line__)
1736  endif
1737  enddo
1738  else
1739  ! number of higher order fields passed must exactly match the number of higher order weights
1740  do n = 1,avsmax
1741  if ((locavon(n) .and. n > mapper%nwgts) .or. &
1742  (.not. locavon(n) .and. n <= mapper%nwgts)) then
1743  WRITE(nulprt,*) subname,estr,'higher_order_check = ',higher_order_check
1744  WRITE(nulprt,*) subname,estr,'mismatch of higher order fields passed and weights'
1745  WRITE(nulprt,*) subname,estr,'mismatch weights output ',n,avsmax,mapper%nwgts,locavon(n)
1746  call oasis_abort(file=__file__,line=__line__)
1747  endif
1748  enddo
1749  endif
1750 
1751  !> * run mct sparse matrix mapper on data and separately on hot as needed
1752 
1753  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_start')
1754 
1755  if (locavon(1)) then
1756  if (mct_avect_nrattr(av1) /= mct_avect_nrattr(avd)) then
1757  WRITE(nulprt,*) subname,estr,'in av1 num of flds'
1758  call oasis_abort(file=__file__,line=__line__)
1759  endif
1760  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_avMult1')
1761  call mct_smat_avmult(av1, mapper%sMatP(1), avd)
1762  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_avMult1')
1763  endif
1764 
1765  if (locavon(2).or.locavon(3).or.locavon(4).or.locavon(5)) then
1766  lsized = mct_avect_lsize(avd)
1767  call mct_avect_init(avdtmp,avd,lsized)
1768 
1769  if (locavon(2)) then
1770  if (mct_avect_nrattr(av2) /= mct_avect_nrattr(avd)) then
1771  WRITE(nulprt,*) subname,estr,'in av2 num of flds'
1772  call oasis_abort(file=__file__,line=__line__)
1773  endif
1774  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_avMult2')
1775  call mct_smat_avmult(av2, mapper%sMatP(2), avdtmp)
1776  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_avMult2')
1777  avd%rAttr = avd%rAttr + avdtmp%rAttr
1778  endif
1779 
1780  if (locavon(3)) then
1781  if (mct_avect_nrattr(av3) /= mct_avect_nrattr(avd)) then
1782  WRITE(nulprt,*) subname,estr,'in av3 num of flds'
1783  call oasis_abort(file=__file__,line=__line__)
1784  endif
1785  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_avMult3')
1786  call mct_smat_avmult(av3, mapper%sMatP(3), avdtmp)
1787  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_avMult3')
1788  avd%rAttr = avd%rAttr + avdtmp%rAttr
1789  endif
1790 
1791  if (locavon(4)) then
1792  if (mct_avect_nrattr(av4) /= mct_avect_nrattr(avd)) then
1793  WRITE(nulprt,*) subname,estr,'in av4 num of flds'
1794  call oasis_abort(file=__file__,line=__line__)
1795  endif
1796  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_avMult4')
1797  call mct_smat_avmult(av4, mapper%sMatP(4), avdtmp)
1798  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_avMult4')
1799  avd%rAttr = avd%rAttr + avdtmp%rAttr
1800  endif
1801 
1802  if (locavon(5)) then
1803  if (mct_avect_nrattr(av5) /= mct_avect_nrattr(avd)) then
1804  WRITE(nulprt,*) subname,estr,'in av5 num of flds'
1805  call oasis_abort(file=__file__,line=__line__)
1806  endif
1807  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_avMult5')
1808  call mct_smat_avmult(av5, mapper%sMatP(5), avdtmp)
1809  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_avMult5')
1810  avd%rAttr = avd%rAttr + avdtmp%rAttr
1811  endif
1812 
1813  call mct_avect_clean(avdtmp)
1814  endif
1815 
1816  call oasis_debug_note(subname//' map')
1817 
1818  !> * enforce conservation
1819 
1820  IF (PRESENT(conserv)) THEN
1821  call oasis_debug_note(subname//' conserv')
1822  IF (conserv /= ip_cnone) THEN
1823 
1824  !-------------------
1825  ! check that conservation can be computed for two partitions on overlapping pes only
1826  ! this should be true all the time as the spart and dpart depend on each other and are
1827  ! on the same pes in the initialization. add this check in case that changes.
1828  ! then run the conserve on only the active pes
1829  !-------------------
1830  if ((prism_part(mapper%spart)%mpicom /= mpi_comm_null .and. prism_part(mapper%dpart)%mpicom == mpi_comm_null) .or. &
1831  (prism_part(mapper%spart)%mpicom == mpi_comm_null .and. prism_part(mapper%dpart)%mpicom /= mpi_comm_null)) then
1832  WRITE(nulprt,*) subname,estr,'illegal conserve on non overlapping pes '
1833  call oasis_abort(file=__file__,line=__line__)
1834  endif
1835 
1836  IF (prism_part(mapper%spart)%mpicom /= mpi_comm_null) then
1837 
1838  fsize = mct_avect_nrattr(av1)
1839  allocate(av_sums(fsize),av_sumd(fsize))
1840 
1841  zradi = 1./(eradius*eradius)
1842 
1843  !-------------------
1844  ! extract mask and area and compute sum of masked area for source
1845  !-------------------
1846  lsizes = mct_avect_lsize(mapper%av_ms)
1847  allocate(imasks(lsizes),areas(lsizes))
1848  nf = mct_avect_indexia(mapper%av_ms,'mask')
1849  imasks(:) = mapper%av_ms%iAttr(nf,:)
1850  nf = mct_avect_indexra(mapper%av_ms,'area')
1851  areas(:) = mapper%av_ms%rAttr(nf,:)*zradi
1852 
1853  if (map_barrier .and. present(tstrinp)) then
1854  call oasis_timer_start(trim(tstrinp)//'_cons_prebarrier')
1855  call oasis_mpi_barrier(prism_part(mapper%spart)%mpicom, trim(tstrinp))
1856  call oasis_timer_stop(trim(tstrinp)//'_cons_prebarrier')
1857  endif
1858 
1859  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_cons1')
1860  call mct_avect_init(avone,rlist='one',lsize=lsizes)
1861  avone%rAttr = 1.0_ip_r8_p
1862  call oasis_advance_avsum(avone,wts_sums1,prism_part(mapper%spart)%pgsmap,prism_part(mapper%spart)%mpicom, &
1863  mask=imasks,wts=areas,consopt=lconsopt)
1864  wts_sums = wts_sums1(1)
1865  call mct_avect_clean(avone)
1866  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_cons1')
1867 
1868  !-------------------
1869  ! extract mask and area and compute sum of masked area for destination
1870  !-------------------
1871  lsized = mct_avect_lsize(mapper%av_md)
1872  allocate(imaskd(lsized),aread(lsized))
1873  nf = mct_avect_indexia(mapper%av_md,'mask')
1874  imaskd(:) = mapper%av_md%iAttr(nf,:)
1875  nf = mct_avect_indexra(mapper%av_md,'area')
1876  aread(:) = mapper%av_md%rAttr(nf,:)*zradi
1877 
1878  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_cons2')
1879  call mct_avect_init(avone,rlist='one',lsize=lsized)
1880  avone%rAttr = 1.0_ip_r8_p
1881  call oasis_advance_avsum(avone,wts_sumd1,prism_part(mapper%dpart)%pgsmap,prism_part(mapper%dpart)%mpicom, &
1882  mask=imaskd,wts=aread,consopt=lconsopt)
1883  wts_sumd = wts_sumd1(1)
1884  call mct_avect_clean(avone)
1885  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_cons2')
1886 
1887  if (oasis_debug >= 30) then
1888  write(nulprt,*) subname,' DEBUG conserve src mask ',minval(imasks),&
1889  maxval(imasks),sum(imasks)
1890  write(nulprt,*) subname,' DEBUG conserve dst mask ',minval(imaskd),&
1891  maxval(imaskd),sum(imaskd)
1892  write(nulprt,*) subname,' DEBUG conserve src area ',minval(areas),&
1893  maxval(areas),sum(areas)
1894  write(nulprt,*) subname,' DEBUG conserve dst area ',minval(aread),&
1895  maxval(aread),sum(aread)
1896  write(nulprt,*) subname,' DEBUG conserve wts_sum ',wts_sums,wts_sumd
1897  endif
1898 
1899  !-------------------
1900  ! compute global sums of av1
1901  ! assume av1 is the thing to be conserved
1902  !-------------------
1903  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_avsum')
1904  call oasis_advance_avsum(av1,av_sums,prism_part(mapper%spart)%pgsmap,prism_part(mapper%spart)%mpicom, &
1905  mask=imasks,wts=areas,consopt=lconsopt)
1906  call oasis_advance_avsum(avd,av_sumd,prism_part(mapper%dpart)%pgsmap,prism_part(mapper%dpart)%mpicom, &
1907  mask=imaskd,wts=aread,consopt=lconsopt)
1908  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_avsum')
1909 
1910  if (oasis_debug >= 20) then
1911  if (prism_part(mapper%spart)%mpicom /= mpi_comm_null) write(nulprt,*) subname,' DEBUG src sum b4 conserve ',av_sums
1912  if (prism_part(mapper%dpart)%mpicom /= mpi_comm_null) write(nulprt,*) subname,' DEBUG dst sum b4 conserve ',av_sumd
1913  endif
1914 
1915  if (conserv == ip_cglobal) then
1916  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_cglobal')
1917  if (wts_sumd == 0.0_ip_r8_p) then
1918  WRITE(nulprt,*) subname,estr,'global conserve sums to zero '
1919  call oasis_abort(file=__file__,line=__line__)
1920  endif
1921  do m = 1,fsize
1922  zlagr = (av_sumd(m) - av_sums(m)) / wts_sumd
1923  do n = 1,lsized
1924  if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) - zlagr
1925  enddo
1926  enddo
1927  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_cglobal')
1928  elseif (conserv == ip_cglbpos) then
1929  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_cglbpos')
1930  do m = 1,fsize
1931  if (av_sumd(m) == 0.0_ip_r8_p .and. av_sums(m) /= 0.0_ip_r8_p) then
1932  WRITE(nulprt,*) subname,estr,'cglpos conserve one of the sums is zero'
1933  call oasis_abort(file=__file__,line=__line__)
1934  elseif (av_sumd(m) /= 0.0_ip_r8_p) then
1935  zlagr = av_sums(m) / av_sumd(m)
1936  do n = 1,lsized
1937  if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) * zlagr
1938  enddo
1939  endif
1940  enddo
1941  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_cglbpos')
1942  elseif (conserv == ip_cbasbal) then
1943  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_cbasbal')
1944  if (wts_sumd == 0.0_ip_r8_p .or. wts_sums == 0.0_ip_r8_p) then
1945  WRITE(nulprt,*) subname,estr,'cbasbal conserve both sums are zero'
1946  call oasis_abort(file=__file__,line=__line__)
1947  endif
1948  do m = 1,fsize
1949  zlagr = (av_sumd(m) - (av_sums(m)*(wts_sumd/wts_sums))) / wts_sumd
1950  do n = 1,lsized
1951  if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) - zlagr
1952  enddo
1953  enddo
1954  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_cbasbal')
1955  elseif (conserv == ip_cbaspos) then
1956  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_cbaspos')
1957  do m = 1,fsize
1958  if (av_sumd(m) == 0.0_ip_r8_p .and. av_sums(m) /= 0.0_ip_r8_p) then
1959  WRITE(nulprt,*) subname,estr,'cbaspos conserve one of the sums is zero'
1960  call oasis_abort(file=__file__,line=__line__)
1961  elseif (av_sumd(m) /= 0.0_ip_r8_p) then
1962  zlagr = (av_sums(m)/av_sumd(m)) * (wts_sumd/wts_sums)
1963  do n = 1,lsized
1964  if (imaskd(n) == 0) avd%rAttr(m,n) = avd%rAttr(m,n) * zlagr
1965  enddo
1966  endif
1967  enddo
1968  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_cbaspos')
1969  else
1970  WRITE(nulprt,*) subname,estr,'conserv option unknown = ',conserv
1971  call oasis_abort(file=__file__,line=__line__)
1972  endif
1973 
1974  if (oasis_debug >= 20) then
1975  if (present(tstrinp)) call oasis_timer_start(trim(tstrinp)//'_avsumdiag')
1976  call oasis_advance_avsum(av1,av_sums,prism_part(mapper%spart)%pgsmap,prism_part(mapper%spart)%mpicom, &
1977  mask=imasks,wts=areas,consopt=lconsopt)
1978  call oasis_advance_avsum(avd,av_sumd,prism_part(mapper%dpart)%pgsmap,prism_part(mapper%dpart)%mpicom, &
1979  mask=imaskd,wts=aread,consopt=lconsopt)
1980  if (prism_part(mapper%spart)%mpicom /= mpi_comm_null) write(nulprt,*) subname,' DEBUG src sum af conserve ',av_sums
1981  if (prism_part(mapper%dpart)%mpicom /= mpi_comm_null) write(nulprt,*) subname,' DEBUG dst sum af conserve ',av_sumd
1982  CALL oasis_flush(nulprt)
1983  if (present(tstrinp)) call oasis_timer_stop(trim(tstrinp)//'_avsumdiag')
1984  endif
1985 
1986  deallocate(imasks,imaskd,areas,aread)
1987  deallocate(av_sums,av_sumd)
1988 
1989  ENDIF ! part%mpicom /= MPI_COMM_NULL
1990  ENDIF ! .not. ip_cnone
1991  ENDIF ! present conserve
1992 
1993  call oasis_debug_exit(subname)
1994 
1995  END SUBROUTINE oasis_advance_map
1996 
1997 !-------------------------------------------------------------------
1998 
1999 !> A generic method for summing fields in an attribute vector
2000 
2001  SUBROUTINE oasis_advance_avsum(av,sum,gsmap,mpicom,mask,wts,consopt)
2002 
2003  implicit none
2004  type(mct_avect) ,intent(in) :: av ! input av
2005  real(kind=ip_r8_p) ,intent(inout) :: sum(:) ! sum of av fields
2006  type(mct_gsmap) ,intent(in) :: gsmap ! gsmap associate with av
2007  integer(kind=ip_i4_p),intent(in) :: mpicom ! mpicom
2008  integer(kind=ip_i4_p),intent(in),optional :: mask(:) ! mask to apply to av
2009  real(kind=ip_r8_p) ,intent(in),optional :: wts(:) ! wts to apply to av
2010  character(len=ic_med),intent(in),optional :: consopt ! conserve algorithm option
2011 
2012  integer(kind=ip_i4_p) :: n,m,ierr,mytask
2013  integer(kind=ip_i4_p) :: lsize,fsize ! local size of av, number of flds in av
2014  real(kind=ip_r8_p),allocatable :: lsum(:) ! local sums
2015  real(kind=ip_r8_p),allocatable :: lwts(:) ! local wts taking into account mask and wts
2016  real(kind=ip_r16_p),allocatable :: lsum16(:)! local sums
2017  real(kind=ip_r16_p),allocatable :: sum16(:) ! global sums
2018  real(kind=ip_r8_p),allocatable :: reproarr(:,:) ! array of data and flds for reprosum
2019  type(mct_avect) :: av1, av1g ! use av1,av1g for gather and bfb sum
2020  character(len=ic_med) :: lconsopt ! local conserve algorithm option
2021  character(len=*),parameter :: subname = '(oasis_advance_avsum)'
2022 
2023  call oasis_debug_enter(subname)
2024 
2025  if (mpicom == mpi_comm_null) then
2026  call oasis_debug_exit(subname)
2027  return
2028  endif
2029 
2030  lconsopt = 'bfb'
2031  if (present(consopt)) then
2032  lconsopt = consopt
2033  endif
2034 
2035  fsize = mct_avect_nrattr(av)
2036  lsize = mct_avect_lsize(av)
2037 
2038  allocate(lsum(fsize))
2039  lsum = 0.0_ip_r8_p
2040  allocate(lwts(lsize))
2041  lwts = 1.0_ip_r8_p
2042 
2043  if (size(sum) /= fsize) then
2044  WRITE(nulprt,*) subname,estr,'size sum ne size av'
2045  call oasis_abort(file=__file__,line=__line__)
2046  endif
2047 
2048  if (present(mask)) then
2049  if (size(mask) /= lsize) then
2050  WRITE(nulprt,*) subname,estr,'size mask ne size av'
2051  call oasis_abort(file=__file__,line=__line__)
2052  endif
2053  do n = 1,lsize
2054  if (mask(n) /= 0) lwts(n) = 0.0_ip_r8_p
2055  enddo
2056  endif
2057 
2058  if (present(wts)) then
2059  if (size(wts) /= lsize) then
2060  WRITE(nulprt,*) subname,estr,'size wts ne size av'
2061  call oasis_abort(file=__file__,line=__line__)
2062  endif
2063  do n = 1,lsize
2064  lwts(n) = lwts(n) * wts(n)
2065  enddo
2066  endif
2067 
2068  if (lconsopt == 'gather') then
2069  call mct_avect_init(av1,av,lsize)
2070  do n = 1,lsize
2071  do m = 1,fsize
2072  av1%rAttr(m,n) = av%rAttr(m,n)*lwts(n)
2073  enddo
2074  enddo
2075  call mct_avect_gather(av1,av1g,gsmap,0,mpicom)
2076  call mpi_comm_rank(mpicom,mytask,ierr)
2077  sum = 0.0_ip_r8_p
2078  if (mytask == 0) then
2079  do n = 1,mct_avect_lsize(av1g)
2080  do m = 1,fsize
2081  sum(m) = sum(m) + av1g%rAttr(m,n)
2082  enddo
2083  enddo
2084  endif
2085  call oasis_mpi_bcast(sum,mpicom,subname//" bcast sum")
2086  call mct_avect_clean(av1)
2087  if (mytask == 0) then
2088  call mct_avect_clean(av1g)
2089  endif
2090 
2091  elseif (lconsopt == 'lsum8' .or. lconsopt == 'opt') then
2092  lsum = 0.0_ip_r8_p
2093  do n = 1,lsize
2094  do m = 1,fsize
2095  lsum(m) = lsum(m) + av%rAttr(m,n)*lwts(n)
2096  enddo
2097  enddo
2098  call oasis_mpi_sum(lsum,sum,mpicom,string=trim(subname)//':sum',all=.true.)
2099 
2100  elseif (lconsopt == 'lsum16') then
2101 #ifdef __NO_16BYTE_REALS
2102  WRITE(nulprt,*) subname,estr,'consopt lsum16 not support with __NO_16BYTE_REALS cpp'
2103  call oasis_abort(file=__file__,line=__line__)
2104 #endif
2105  allocate(lsum16(fsize))
2106  allocate(sum16(fsize))
2107  lsum16 = 0.0_ip_r16_p
2108  do n = 1,lsize
2109  do m = 1,fsize
2110  lsum16(m) = lsum16(m) + real(av%rAttr(m,n),ip_r16_p)*real(lwts(n),ip_r16_p)
2111  enddo
2112  enddo
2113  call oasis_mpi_sum(lsum16,sum16,mpicom,string=trim(subname)//':sum',all=.true.)
2114  sum = real(sum16,ip_r8_p)
2115  deallocate(lsum16)
2116  deallocate(sum16)
2117 
2118  elseif (lconsopt == 'reprosum' .or. lconsopt == 'ddpdd' .or. lconsopt == 'bfb') then
2119  allocate(reproarr(lsize,fsize))
2120  do n = 1,lsize
2121  do m = 1,fsize
2122  reproarr(n,m) = av%rAttr(m,n)*lwts(n)
2123  enddo
2124  enddo
2125  if (lconsopt == 'reprosum' .or. lconsopt == 'bfb') then
2126  call oasis_reprosum_calc(reproarr,sum,lsize,lsize,fsize,ddpdd_sum=.false.,commid=mpicom)
2127  else
2128  call oasis_reprosum_calc(reproarr,sum,lsize,lsize,fsize,ddpdd_sum=.true. ,commid=mpicom)
2129  endif
2130  deallocate(reproarr)
2131 
2132  else
2133  WRITE(nulprt,*) subname,estr,'consopt unknown: '//trim(lconsopt)
2134  call oasis_abort(file=__file__,line=__line__)
2135 
2136  endif
2137 
2138  deallocate(lsum)
2139  deallocate(lwts)
2140 
2141  call oasis_debug_exit(subname)
2142 
2143  END SUBROUTINE oasis_advance_avsum
2144 
2145 !-------------------------------------------------------------------
2146 
2147 !> A generic method for writing the global sums of fields in an attribute vector
2148 
2149  SUBROUTINE oasis_advance_avdiag(av,mpicom,mask,wts)
2150 
2151  implicit none
2152  type(mct_avect) ,intent(in) :: av ! input av
2153  integer(kind=ip_i4_p),intent(in) :: mpicom ! mpi communicator
2154  integer(kind=ip_i4_p),intent(in),optional :: mask(:) ! mask to apply to av
2155  real(kind=ip_r8_p) ,intent(in),optional :: wts(:) ! wts to apply to av
2156 
2157  integer(kind=ip_i4_p) :: n,m,ierr,mype
2158  integer(kind=ip_i4_p) :: lsize,fsize ! local size of av, number of flds in av
2159  logical :: first_call
2160  real(kind=ip_r8_p) :: lval ! local temporary
2161  real(kind=ip_r8_p),allocatable :: lsum(:) ! local sum
2162  real(kind=ip_r8_p),allocatable :: lmin(:) ! local min
2163  real(kind=ip_r8_p),allocatable :: lmax(:) ! local max
2164  real(kind=ip_r8_p),allocatable :: gsum(:) ! global sum
2165  real(kind=ip_r8_p),allocatable :: gmin(:) ! global min
2166  real(kind=ip_r8_p),allocatable :: gmax(:) ! global max
2167  real(kind=ip_r8_p),allocatable :: lwts(:) ! local wts taking into account mask and wts
2168  type(mct_string) :: mstring ! mct char type
2169  character(len=64):: itemc ! string converted to char
2170  character(len=*),parameter :: subname = '(oasis_advance_avdiag)'
2171 
2172  call oasis_debug_enter(subname)
2173 
2174  if (mpicom == mpi_comm_null) then
2175  call oasis_debug_exit(subname)
2176  return
2177  endif
2178 
2179  fsize = mct_avect_nrattr(av)
2180  lsize = mct_avect_lsize(av)
2181 
2182  allocate(lsum(fsize))
2183  allocate(lmin(fsize))
2184  allocate(lmax(fsize))
2185  allocate(gsum(fsize))
2186  allocate(gmin(fsize))
2187  allocate(gmax(fsize))
2188 
2189  allocate(lwts(lsize))
2190  lwts = 1.0_ip_r8_p
2191 !!$ lmin=HUGE(lwts)
2192 !!$ lmax=-lmin
2193  if (present(mask)) then
2194  if (size(mask) /= lsize) then
2195  WRITE(nulprt,*) subname,estr,'size mask ne size av'
2196  call oasis_abort(file=__file__,line=__line__)
2197  endif
2198  do n = 1,lsize
2199  if (mask(n) /= 0) lwts(n) = 0.0_ip_r8_p
2200  enddo
2201  endif
2202 
2203  if (present(wts)) then
2204  if (size(wts) /= lsize) then
2205  WRITE(nulprt,*) subname,estr,'size wts ne size av'
2206  call oasis_abort(file=__file__,line=__line__)
2207  endif
2208  do n = 1,lsize
2209  lwts(n) = lwts(n) * wts(n)
2210  enddo
2211  endif
2212 
2213  lsum = 0.0_ip_r8_p
2214  lmin = 9.99e36 ! in case lsize is zero
2215  lmax = -9.99e36 ! in case lsize is zero
2216  do m = 1,fsize
2217  first_call = .true.
2218  do n = 1,lsize
2219  lval = av%rAttr(m,n)*lwts(n)
2220  lsum(m) = lsum(m) + lval
2221  if (lwts(n) /= 0.0_ip_r8_p) then
2222  if (first_call) then
2223  lmin(m) = lval
2224  lmax(m) = lval
2225  first_call = .false.
2226  else
2227  lmin(m) = min(lmin(m),lval)
2228  lmax(m) = max(lmax(m),lval)
2229  endif
2230  endif
2231  enddo
2232  enddo
2233 
2234  mype = -1
2235  call mpi_comm_rank(mpicom,mype,ierr)
2236  call oasis_mpi_sum(lsum,gsum,mpicom,string=trim(subname)//':sum',all=.false.)
2237  call oasis_mpi_min(lmin,gmin,mpicom,string=trim(subname)//':min',all=.false.)
2238  call oasis_mpi_max(lmax,gmax,mpicom,string=trim(subname)//':max',all=.false.)
2239 
2240  if (mype == 0) then
2241  do m = 1,fsize
2242  call mct_avect_getrlist(mstring,m,av)
2243  itemc = mct_string_tochar(mstring)
2244  call mct_string_clean(mstring)
2245  write(nulprt,'(a,a16,3g21.12)') ' diags: ',trim(itemc),gmin(m),gmax(m),gsum(m)
2246  enddo
2247  endif
2248 
2249  deallocate(lsum,lmin,lmax)
2250  deallocate(gsum,gmin,gmax)
2251  deallocate(lwts)
2252 
2253  call oasis_debug_exit(subname)
2254 
2255  END SUBROUTINE oasis_advance_avdiag
2256 
2257 !-------------------------------------------------------------------
2258 END MODULE mod_oasis_advance
2259 
mod_oasis_coupler::lastseqtime
integer(kind=ip_i4_p), public lastseqtime
last coupler sequence time
Definition: mod_oasis_coupler.F90:105
mod_oasis_parameters::oasis_recvout
integer(kind=ip_intwp_p), parameter oasis_recvout
Definition: mod_oasis_parameters.F90:53
mod_oasis_parameters::ip_cglbpos
integer(kind=ip_intwp_p), parameter ip_cglbpos
Definition: mod_oasis_parameters.F90:94
mod_oasis_mpi::oasis_mpi_sum
Generic overloaded interface into MPI sum reduction.
Definition: mod_oasis_mpi.F90:88
mod_oasis_sys
System type methods.
Definition: mod_oasis_sys.F90:4
mod_oasis_io::oasis_io_read_array
subroutine, public oasis_io_read_array(rstfile, mpicom, iarray, ivarname, rarray, rvarname, abort)
Reads an integer or real field from a file into an array.
Definition: mod_oasis_io.F90:565
mod_oasis_parameters::oasis_sentout
integer(kind=ip_intwp_p), parameter oasis_sentout
Definition: mod_oasis_parameters.F90:45
mod_oasis_sys::oasis_debug_note
subroutine, public oasis_debug_note(string)
Used to write information from a subroutine, write info to log file at some debug level...
Definition: mod_oasis_sys.F90:263
mod_oasis_data
Provides a common location for several OASIS variables.
Definition: mod_oasis_data.F90:4
mod_oasis_reprosum::oasis_reprosum_calc
subroutine, public oasis_reprosum_calc(arr, arr_gsum, nsummands, dsummands, nflds, ddpdd_sum, arr_gbl_max, arr_gbl_max_out, arr_max_levels, arr_max_levels_out, gbl_max_nsummands, gbl_max_nsummands_out, gbl_count, repro_sum_validate, repro_sum_stats, rel_diff, commid)
Compute the global sum of each field in "arr" using the indicated communicator with a reproducible ye...
Definition: mod_oasis_reprosum.F90:267
mod_oasis_io
Provides reusable IO routines for OASIS.
Definition: mod_oasis_io.F90:4
mod_oasis_parameters::oasis_ok
integer(kind=ip_intwp_p), parameter oasis_ok
Definition: mod_oasis_parameters.F90:21
mod_oasis_io::oasis_io_write_avfile
subroutine, public oasis_io_write_avfile(rstfile, av, gsmap, mpicom, nx, ny, nampre)
Writes all fields from an attribute vector to a file.
Definition: mod_oasis_io.F90:230
mod_oasis_data::lucia_debug
integer(kind=ip_i4_p) lucia_debug
Definition: mod_oasis_data.F90:23
mod_oasis_mpi::oasis_mpi_max
Generic overloaded interface into MPI max reduction.
Definition: mod_oasis_mpi.F90:114
mod_oasis_parameters::oasis_in
integer(kind=ip_intwp_p), parameter oasis_in
Definition: mod_oasis_parameters.F90:31
mod_oasis_part::prism_part
type(prism_part_type), dimension(mpart), public prism_part
list of defined partitions
Definition: mod_oasis_part.F90:47
mod_oasis_data::nulprt
integer(kind=ip_intwp_p) nulprt
Definition: mod_oasis_data.F90:20
mod_oasis_mpi::oasis_mpi_bcast
Generic overloaded interface into MPI broadcast.
Definition: mod_oasis_mpi.F90:58
mod_oasis_parameters::oasis_fromrestout
integer(kind=ip_intwp_p), parameter oasis_fromrestout
Definition: mod_oasis_parameters.F90:55
mod_oasis_data::eradius
real(ip_double_p), parameter eradius
Definition: mod_oasis_data.F90:71
mod_oasis_coupler::prism_coupler_get
type(prism_coupler_type), dimension(:), pointer, public prism_coupler_get
prism_coupler get array
Definition: mod_oasis_coupler.F90:102
mod_oasis_parameters::ip_instant
integer(kind=ip_intwp_p), parameter ip_instant
Definition: mod_oasis_parameters.F90:84
mod_oasis_sys::oasis_abort
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
Definition: mod_oasis_sys.F90:44
mod_oasis_coupler::prism_coupler_put
type(prism_coupler_type), dimension(:), pointer, public prism_coupler_put
prism_coupler put array
Definition: mod_oasis_coupler.F90:101
mod_oasis_parameters::oasis_fromrest
integer(kind=ip_intwp_p), parameter oasis_fromrest
Definition: mod_oasis_parameters.F90:49
mod_oasis_parameters::oasis_sent
integer(kind=ip_intwp_p), parameter oasis_sent
Definition: mod_oasis_parameters.F90:37
mod_oasis_kinds::ip_r8_p
integer, parameter ip_r8_p
Definition: mod_oasis_kinds.F90:43
mod_oasis_parameters::oasis_torestout
integer(kind=ip_intwp_p), parameter oasis_torestout
Definition: mod_oasis_parameters.F90:47
mod_oasis_advance::oasis_advance_run
subroutine, public oasis_advance_run(mop, varid, msec, kinfo, nff, namid, array1din, array1dout, array2dout, readrest, a2on, array2, a3on, array3, a4on, array4, a5on, array5, writrest, varnum)
Advances the OASIS coupling.
Definition: mod_oasis_advance.F90:324
mod_oasis_data::cspval
character(len= *), parameter cspval
Definition: mod_oasis_data.F90:66
mod_oasis_parameters::ip_min
integer(kind=ip_intwp_p), parameter ip_min
Definition: mod_oasis_parameters.F90:87
mod_oasis_parameters::oasis_torest
integer(kind=ip_intwp_p), parameter oasis_torest
Definition: mod_oasis_parameters.F90:41
mod_oasis_coupler
Initialize the OASIS coupler infrastructure.
Definition: mod_oasis_coupler.F90:4
mod_oasis_parameters::ip_accumul
integer(kind=ip_intwp_p), parameter ip_accumul
Definition: mod_oasis_parameters.F90:86
mod_oasis_kinds
Defines kinds for OASIS.
Definition: mod_oasis_kinds.F90:7
mod_oasis_data::nullucia
integer(kind=ip_intwp_p) nullucia
Definition: mod_oasis_data.F90:20
mod_oasis_mpi
Provides a generic and simpler interface into MPI calls for OASIS.
Definition: mod_oasis_mpi.F90:3
mod_oasis_parameters::ip_cbasbal
integer(kind=ip_intwp_p), parameter ip_cbasbal
Definition: mod_oasis_parameters.F90:95
mod_oasis_parameters::oasis3_get
integer(kind=ip_intwp_p), parameter oasis3_get
Definition: mod_oasis_parameters.F90:70
mod_oasis_coupler::prism_coupler_type
Coupler data for managing all aspects of coupling in OASIS.
Definition: mod_oasis_coupler.F90:47
mod_oasis_sys::oasis_debug_enter
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
Definition: mod_oasis_sys.F90:209
mod_oasis_mpi::oasis_mpi_min
Generic overloaded interface into MPI min reduction.
Definition: mod_oasis_mpi.F90:106
mod_oasis_advance::oasis_advance_avdiag
subroutine oasis_advance_avdiag(av, mpicom, mask, wts)
A generic method for writing the global sums of fields in an attribute vector.
Definition: mod_oasis_advance.F90:2150
mod_oasis_part
OASIS partition data and methods.
Definition: mod_oasis_part.F90:4
mod_oasis_coupler::prism_coupler_avsmax
integer(kind=ip_i4_p), parameter, public prism_coupler_avsmax
maximum number of higher order terms in mapping
Definition: mod_oasis_coupler.F90:44
mod_oasis_parameters::oasis_recvd
integer(kind=ip_intwp_p), parameter oasis_recvd
Definition: mod_oasis_parameters.F90:35
mod_oasis_parameters::oasis3_put
integer(kind=ip_intwp_p), parameter oasis3_put
Definition: mod_oasis_parameters.F90:68
mod_oasis_parameters::oasis_output
integer(kind=ip_intwp_p), parameter oasis_output
Definition: mod_oasis_parameters.F90:43
mod_oasis_advance::oasis_advance_map
subroutine oasis_advance_map(av1, avd, mapper, conserv, consopt, avon, av2, av3, av4, av5, tstrinp)
Provides interpolation functionality.
Definition: mod_oasis_advance.F90:1651
mod_oasis_advance::oasis_advance_init
subroutine, public oasis_advance_init(kinfo)
Initializes the OASIS fields.
Definition: mod_oasis_advance.F90:39
mod_oasis_advance::map_barrier
logical, parameter map_barrier
Definition: mod_oasis_advance.F90:29
mod_oasis_parameters::oasis_waitgroup
integer(kind=ip_intwp_p), parameter oasis_waitgroup
Definition: mod_oasis_parameters.F90:57
mod_oasis_coupler::oasis_coupler_bldvarname
subroutine, public oasis_coupler_bldvarname(varid, varnum, vname)
Build a consistent variable name based on bundles.
Definition: mod_oasis_coupler.F90:2012
mod_oasis_parameters::ip_max
integer(kind=ip_intwp_p), parameter ip_max
Definition: mod_oasis_parameters.F90:88
mod_oasis_parameters::oasis_comm_ready
integer(kind=ip_intwp_p), parameter oasis_comm_ready
Definition: mod_oasis_parameters.F90:64
mod_oasis_parameters
Defines parameters for OASIS.
Definition: mod_oasis_parameters.F90:4
mod_oasis_parameters::oasis_loctrans
integer(kind=ip_intwp_p), parameter oasis_loctrans
Definition: mod_oasis_parameters.F90:39
mod_oasis_var
OASIS variable data and methods.
Definition: mod_oasis_var.F90:4
mod_oasis_data::compnm
character(len=ic_lvar) compnm
Definition: mod_oasis_data.F90:40
mod_oasis_timer::oasis_timer_start
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
Definition: mod_oasis_timer.F90:134
mod_oasis_io::oasis_io_write_avfbf
subroutine, public oasis_io_write_avfbf(av, gsmap, mpicom, nx, ny, msec, f_string, filename)
Write each field in an attribute vector to an individual files.
Definition: mod_oasis_io.F90:877
mod_oasis_data::oasis_debug
integer(kind=ip_i4_p) oasis_debug
Definition: mod_oasis_data.F90:21
mod_oasis_parameters::oasis_out
integer(kind=ip_intwp_p), parameter oasis_out
Definition: mod_oasis_parameters.F90:29
mod_oasis_coupler::prism_router
type(prism_router_type), dimension(:), pointer, public prism_router
prism_router array
Definition: mod_oasis_coupler.F90:98
mod_oasis_timer::oasis_timer_stop
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
Definition: mod_oasis_timer.F90:178
mod_oasis_sys::estr
character(len= *), parameter, public estr
Definition: mod_oasis_sys.F90:12
mod_oasis_data::mpi_comm_local
integer(kind=ip_i4_p) mpi_comm_local
Definition: mod_oasis_data.F90:50
mod_oasis_mpi::oasis_mpi_barrier
subroutine, public oasis_mpi_barrier(comm, string)
Call MPI_BARRIER for a particular communicator.
Definition: mod_oasis_mpi.F90:2697
mod_oasis_parameters::ip_cglobal
integer(kind=ip_intwp_p), parameter ip_cglobal
Definition: mod_oasis_parameters.F90:93
mod_oasis_parameters::ip_average
integer(kind=ip_intwp_p), parameter ip_average
Definition: mod_oasis_parameters.F90:85
mod_oasis_map::prism_mapper
type(prism_mapper_type), dimension(:), pointer, public prism_mapper
list of defined mappers
Definition: mod_oasis_map.F90:55
mod_oasis_parameters::oasis_input
integer(kind=ip_intwp_p), parameter oasis_input
Definition: mod_oasis_parameters.F90:51
mod_oasis_io::oasis_io_read_avfbf
subroutine, public oasis_io_read_avfbf(av, gsmap, mpicom, msec, f_string, filename)
Read each field in an attribute vector from individual files.
Definition: mod_oasis_io.F90:1091
mod_oasis_coupler::allow_no_restart
logical, public allow_no_restart
flag to allow no restart files at startup
Definition: mod_oasis_coupler.F90:106
mod_oasis_advance
Advances the OASIS coupling.
Definition: mod_oasis_advance.F90:4
mod_oasis_sys::oasis_flush
subroutine, public oasis_flush(nu)
Flushes output to file.
Definition: mod_oasis_sys.F90:94
mod_oasis_advance::oasis_advance_avsum
subroutine oasis_advance_avsum(av, sum, gsmap, mpicom, mask, wts, consopt)
A generic method for summing fields in an attribute vector.
Definition: mod_oasis_advance.F90:2002
mod_oasis_coupler::oasis_coupler_unbldvarname
subroutine, public oasis_coupler_unbldvarname(varid, vname, varnum)
Deconstruct the varname based on oasis_coupler_bldvarname.
Definition: mod_oasis_coupler.F90:2055
mod_oasis_io::oasis_io_write_array
subroutine, public oasis_io_write_array(rstfile, mpicom, iarray, ivarname, rarray, rvarname)
Writes a real or integer array to a file.
Definition: mod_oasis_io.F90:730
mod_oasis_var::prism_nvar
integer(kind=ip_intwp_p), public prism_nvar
number of variables defined
Definition: mod_oasis_var.F90:40
mod_oasis_timer
Performance timer methods.
Definition: mod_oasis_timer.F90:39
mod_oasis_coupler::prism_mcoupler
integer(kind=ip_i4_p), public prism_mcoupler
max couplers
Definition: mod_oasis_coupler.F90:100
mod_oasis_var::prism_var
type(prism_var_type), dimension(:), pointer, public prism_var
list of defined variables
Definition: mod_oasis_var.F90:41
mod_oasis_reprosum
OASIS reproducible sum method from P. Worley.
Definition: mod_oasis_reprosum.F90:4
mod_oasis_data::ispval
integer(ip_i4_p), parameter ispval
Definition: mod_oasis_data.F90:68
mod_oasis_map::prism_mapper_type
Mapper data for interpolating data between grids.
Definition: mod_oasis_map.F90:35
mod_oasis_parameters::oasis_comm_wait
integer(kind=ip_intwp_p), parameter oasis_comm_wait
Definition: mod_oasis_parameters.F90:66
mod_oasis_advance::detailed_map_timing
logical, parameter detailed_map_timing
Definition: mod_oasis_advance.F90:30
mod_oasis_parameters::ip_cbaspos
integer(kind=ip_intwp_p), parameter ip_cbaspos
Definition: mod_oasis_parameters.F90:96
mod_oasis_parameters::ip_cnone
integer(kind=ip_intwp_p), parameter ip_cnone
Definition: mod_oasis_parameters.F90:92
mod_oasis_coupler::lastseq
integer(kind=ip_i4_p), public lastseq
last coupler sequence
Definition: mod_oasis_coupler.F90:104
mod_oasis_sys::oasis_debug_exit
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
Definition: mod_oasis_sys.F90:236
mod_oasis_map
OASIS map (interpolation) data and methods.
Definition: mod_oasis_map.F90:5
mod_oasis_sys::wstr
character(len= *), parameter, public wstr
Definition: mod_oasis_sys.F90:13
mod_oasis_io::oasis_io_read_avfile
subroutine, public oasis_io_read_avfile(rstfile, av, gsmap, mpicom, abort, nampre, didread)
Reads all fields for an attribute vector from a file.
Definition: mod_oasis_io.F90:406
Generated on Fri Jun 29 2018 20:52:28 for Oasis3-MCT by   doxygen 1.8.13