Oasis3-MCT
 All Classes Files Functions Variables Macros Pages
mod_oasis_var.F90
Go to the documentation of this file.
1 
2 !> OASIS variable data and methods
3 
4  MODULE mod_oasis_var
5 
9  USE mod_oasis_sys
10  USE mod_oasis_mpi
11  USE mod_oasis_timer
12  USE mod_oasis_part
13 
14  IMPLICIT none
15 
16  private
17 
18  !--- interfaces ---
19  public oasis_def_var
20  public oasis_var_setup
21 
22  !--- datatypes ---
23 
24  integer(ip_intwp_p),public :: maxvar !< number of potential variables, derived from namcouple input
25  integer(kind=ip_i4_p),parameter,public :: mvarcpl = 10 !< max namcouples per variable
26 
27  !> Model variable data for model coupling
29  character(len=ic_lvar):: name !< variable name
30  integer(kind=ip_i4_p) :: part !< variable partition
31  integer(kind=ip_i4_p) :: ndim !< rank of variable
32  integer(kind=ip_i4_p) :: num !< size of variable
33  integer(kind=ip_i4_p) :: ops !< input or output
34  integer(kind=ip_i4_p) :: type !< type kind of variable
35  integer(kind=ip_i4_p) :: size !< total size of field
36  integer(kind=ip_i4_p) :: ncpl !< number of namcouple couplers
37  integer(kind=ip_i4_p) :: cpl(mvarcpl) !< list of namcouple couplers
38  end type prism_var_type
39 
40  integer(kind=ip_intwp_p),public :: prism_nvar = 0 !< number of variables defined
41  TYPE(prism_var_type),POINTER,public :: prism_var(:) !< list of defined variables
42 
43  CONTAINS
44 
45 !---------------------------------------------------------------
46 
47 !> The OASIS user interface to define variables
48 
49  SUBROUTINE oasis_def_var(id_nports, cdport, id_part, &
50  id_var_nodims, kinout, id_var_shape, ktype, kinfo)
51  !---------------------------------------------------------------
52  INTEGER(kind=ip_i4_p),intent(out) :: id_nports !< coupling field ID
53  CHARACTER(len=*) ,intent(in) :: cdport !< field name as in namcouple
54  INTEGER(kind=ip_i4_p),intent(in) :: id_part !< partition ID
55  INTEGER(kind=ip_i4_p),intent(in) :: id_var_nodims(2) !< rank and number of bundles
56  INTEGER(kind=ip_i4_p),intent(in) :: kinout !< input or output flag
57  INTEGER(kind=ip_i4_p),intent(in) :: id_var_shape(2*id_var_nodims(1)) !< size of field
58  INTEGER(kind=ip_i4_p),intent(in) :: ktype !< type of coupling field
59  INTEGER(kind=ip_i4_p),intent(out),optional :: kinfo !< return code
60  !---------------------------------------------------------------
61  INTEGER(kind=ip_i4_p) :: n
62  CHARACTER(len=ic_lvar) :: trimmed_cdport ! Trimmed version of cdport
63  character(len=*),parameter :: subname = '(oasis_def_var)'
64  LOGICAL :: l_field_in_namcouple
65  !---------------------------------------------------------------
66 
67  call oasis_debug_enter(subname)
68  if (.not. oasis_coupled) then
69  call oasis_debug_exit(subname)
70  return
71  endif
72 
73  !-------------------------------------------------
74  !> * Check len of incoming variable name
75  ! Trim incoming name once to avoid multiple trim operations
76  ! in subsequent loops
77  !-------------------------------------------------
78 
79  if (len_trim(cdport) > ic_lvar) then
80  WRITE(nulprt,*) subname,estr,'variable too long = ',trim(cdport)
81  WRITE(nulprt,*) subname,estr,'max variable length (ic_lvar) = ',ic_lvar
82  call oasis_abort()
83  endif
84  trimmed_cdport = trim(cdport)
85 
86  kinfo = oasis_ok
87 
88  l_field_in_namcouple = .false.
89  n = 0
90 
91  !-------------------------------------------------
92  !> * Search for field in namcouple field lists
93  !-------------------------------------------------
94 
95  ! If either condition ceases to be true then bail out of the loop
96  DO WHILE (n < size_namfld .AND. (.NOT.l_field_in_namcouple))
97  n = n+1
98  IF ( (trimmed_cdport == total_namsrcfld(n)).OR. &
99  (trimmed_cdport == total_namdstfld(n)) ) THEN
100  l_field_in_namcouple = .true.
101  ENDIF
102  enddo
103 
104  !-------------------------------------------------
105  !> * Return if field not found in namcouple
106  !-------------------------------------------------
107 
108  if (.not. l_field_in_namcouple) then
109  id_nports = oasis_var_uncpl
110  if (oasis_debug >= 2) then
111  write(nulprt,*) subname,' variable not in namcouple return ',trimmed_cdport
112  call oasis_flush(nulprt)
113  endif
114  call oasis_debug_exit(subname)
115  return
116  endif
117 
118  !-------------------------------------------------
119  !> * Abort if field already defined
120  !-------------------------------------------------
121 
122  do n = 1,prism_nvar
123  if (trimmed_cdport == prism_var(n)%name) then
124  write(nulprt,*) subname,estr,'variable already defined with def_var = ',trimmed_cdport
125  write(nulprt,*) subname,estr,'check oasis_def_var calls in your model'
126  call oasis_abort()
127  endif
128  enddo
129 
130  !-------------------------------------------------
131  !> * Increment the variable and store the values
132  !-------------------------------------------------
133 
134  prism_nvar = prism_nvar + 1
135  id_nports = prism_nvar
136 
137  if (prism_nvar > maxvar) then
138  write(nulprt,*) subname,estr,'prism_nvar too large = ',prism_nvar,maxvar
139  write(nulprt,*) subname,estr,'check maxvar set in oasis_init_comp'
140  call oasis_abort()
141  endif
142 
143  call oasis_var_zero(prism_var(prism_nvar))
144  prism_var(prism_nvar)%name = trimmed_cdport
145  prism_var(prism_nvar)%part = id_part
146  prism_var(prism_nvar)%ndim = id_var_nodims(1)
147  prism_var(prism_nvar)%num = id_var_nodims(2)
148  prism_var(prism_nvar)%ops = kinout
149  prism_var(prism_nvar)%type = ktype
150  prism_var(prism_nvar)%size = 1
151  do n = 1,prism_var(prism_nvar)%ndim
152  prism_var(prism_nvar)%size = prism_var(prism_nvar)%size*(id_var_shape(2*n)-&
153  id_var_shape(2*n-1)+1)
154  enddo
155  prism_var(prism_nvar)%ncpl = 0
156  prism_var(prism_nvar)%cpl = 0
157 
158  !----------------------------------
159  !> * Write some diagnostics
160  !----------------------------------
161 
162  if (oasis_debug >= 2) then
163  write(nulprt,*) ' '
164  write(nulprt,*) subname,' prism_nvar = ',prism_nvar
165  write(nulprt,*) subname,' varname = ',prism_nvar,trim(prism_var(prism_nvar)%name)
166  write(nulprt,*) subname,' varpart = ',prism_nvar,prism_var(prism_nvar)%part
167  write(nulprt,*) subname,' varndim = ',prism_nvar,prism_var(prism_nvar)%ndim
168  write(nulprt,*) subname,' varnum = ',prism_nvar,prism_var(prism_nvar)%num
169  write(nulprt,*) subname,' varops = ',prism_nvar,prism_var(prism_nvar)%ops
170  write(nulprt,*) subname,' vartype = ',prism_nvar,prism_var(prism_nvar)%type
171  write(nulprt,*) subname,' varsize = ',prism_nvar,prism_var(prism_nvar)%size
172  write(nulprt,*) ' '
173  CALL oasis_flush(nulprt)
174  endif
175 
176  call oasis_debug_exit(subname)
177 
178  END SUBROUTINE oasis_def_var
179 
180 !---------------------------------------------------------------
181 
182 !> Synchronize variables across all tasks, called at oasis enddef.
183 
184  SUBROUTINE oasis_var_setup()
185  IMPLICIT NONE
186 
187  !--------------------------------------------------------
188  integer(kind=ip_intwp_p) :: m,n,p,v
189  INTEGER(kind=ip_intwp_p) :: ierr, taskid
190  integer(kind=ip_intwp_p) :: vcnt
191  logical :: found, fastcheckout
192  character(len=ic_lvar) ,pointer :: vname0(:),vname(:)
193  character(len=ic_lvar2) ,pointer :: pname0(:),pname(:)
194  integer(kind=ip_intwp_p),pointer :: inout0(:),inout(:)
195  logical, parameter :: local_timers_on = .false.
196  character(len=*),parameter :: subname = '(oasis_var_setup)'
197  !--------------------------------------------------------
198 
199  call oasis_debug_enter(subname)
200 
201  call oasis_timer_start('var_setup')
202 
203  call oasis_timer_start('var_setup_reducelists')
204  allocate(vname0(prism_nvar))
205  allocate(pname0(prism_nvar))
206  allocate(inout0(prism_nvar))
207  do n = 1,prism_nvar
208  vname0(n) = prism_var(n)%name
209  inout0(n) = prism_var(n)%ops
210  pname0(n) = prism_part(prism_var(n)%part)%partname
211  enddo
212 
213  call oasis_mpi_reducelists(vname0,mpi_comm_local,vcnt,vname,'var_setup', &
214  fastcheck=.true.,fastcheckout=fastcheckout, &
215  linp2=pname0,lout2=pname,linp3=inout0,lout3=inout)
216 
217  deallocate(vname0)
218  deallocate(pname0)
219  deallocate(inout0)
220  call oasis_timer_stop('var_setup_reducelists')
221 
222  !-------------------------------------------------
223  !> * Initialize variables on tasks where they are not previously defined.
224  ! if fastcheck worked, then don't need to do this extra work to add undefined vars
225  !-------------------------------------------------
226 
227  if (.not. fastcheckout) then
228 
229  if (local_timers_on) call oasis_timer_start('var_setup_initvar')
230  do v = 1,vcnt
231 
232  !--- either a prism_var that already exists
233  found = .false.
234  n = 0
235  do while (n < prism_nvar .and. .not.found)
236  n = n + 1
237  if (prism_var(n)%name == vname(v)) then
238  found = .true.
239  endif
240  enddo
241 
242  !--- or a new prism_var that must be instantiated
243  if (.not.found) then
244  prism_nvar = prism_nvar + 1
245 
246  call oasis_var_zero(prism_var(prism_nvar))
247  prism_var(prism_nvar)%name = vname(v)
248  prism_var(prism_nvar)%ops = inout(v)
249  prism_var(prism_nvar)%ncpl = 0
250  !--- figure out the local part id for the part name
251  p = 0
252  found = .false.
253  do while (p < prism_npart .and. .not.found)
254  p = p + 1
255  if (prism_part(p)%partname == pname(v)) then
256  found = .true.
257  endif
258  enddo
259  if (found) then
260  prism_var(prism_nvar)%part = p
261  if (oasis_debug >= 15) then
262  write(nulprt,*) subname,' found part match ',trim(vname(v)),trim(pname(v)),p
263  endif
264  else
265  write(nulprt,*) subname,estr,'prism part not found part = ',trim(pname(v)),' var = ',trim(vname(v))
266  call oasis_abort()
267  endif
268 
269  if (oasis_debug >= 2) then
270  write(nulprt,*) ' '
271  write(nulprt,*) subname,' add var = ',prism_nvar,trim(prism_var(prism_nvar)%name),&
272  prism_var(prism_nvar)%part,&
273  trim(prism_part(prism_var(prism_nvar)%part)%partname),prism_var(prism_nvar)%ops
274  CALL oasis_flush(nulprt)
275  ENDIF
276  endif
277 
278  enddo ! v = 1,vcnt
279  if (local_timers_on) call oasis_timer_stop('var_setup_initvar')
280 
281  endif ! fastcheckout
282 
283  deallocate(vname,pname,inout)
284 
285  call oasis_timer_stop('var_setup')
286 
287  call oasis_debug_exit(subname)
288 
289  END SUBROUTINE oasis_var_setup
290 
291 !---------------------------------------------------------------
292 
293 !> Zero variable information
294 
295  SUBROUTINE oasis_var_zero(prism_var)
296  IMPLICIT NONE
297 
298  !--------------------------------------------------------
299  type(prism_var_type),intent(inout) :: prism_var
300  character(len=*),parameter :: subname = '(oasis_var_zero)'
301  !--------------------------------------------------------
302 
303  call oasis_debug_enter(subname)
304 
305  prism_var%name = 'oasis_var_name_unset'
306  prism_var%part = -1
307  prism_var%ndim = -1
308  prism_var%num = -1
309  prism_var%ops = -1
310  prism_var%type = -1
311  prism_var%size = -1
312  prism_var%ncpl = 0
313  prism_var%cpl = -1
314 
315  call oasis_debug_exit(subname)
316 
317  END SUBROUTINE oasis_var_zero
318 
319 !---------------------------------------------------------------
320  END MODULE mod_oasis_var
321 
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
OASIS partition data and methods.
System type methods.
subroutine, public oasis_def_var(id_nports, cdport, id_part, id_var_nodims, kinout, id_var_shape, ktype, kinfo)
The OASIS user interface to define variables.
Provides a generic and simpler interface into MPI calls for OASIS.
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
Provides a common location for several OASIS variables.
subroutine, public oasis_mpi_reducelists(linp1, comm, cntout, lout1, callstr, fastcheck, fastcheckout, linp2, lout2, spval2, linp3, lout3, spval3)
Custom method for reducing MPI lists across pes for OASIS.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
Defines kinds for OASIS.
subroutine, public oasis_flush(nu)
Flushes output to file.
subroutine, public oasis_var_setup()
Synchronize variables across all tasks, called at oasis enddef.
Performance timer methods.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine oasis_var_zero(prism_var)
Zero variable information.
Model variable data for model coupling.
OASIS variable data and methods.
Defines parameters for OASIS.