WAVEWATCH III  beta 0.0.1
Functions/Subroutines
w3uno2md Module Reference

Portable UNO2 scheme on irregular grid. More...

Functions/Subroutines

subroutine w3uno2 (MX, MY, NX, NY, VELO, DT, DX1, DX2, Q, BCLOSE, INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, NDSE, NDST)
 UNO2 scheme for irregular grid. More...
 
subroutine w3uno2r (MX, MY, NX, NY, CFLL, Q, BCLOSE, INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, NDSE, NDST)
 Preform one-dimensional propagation in a two-dimensional space with irregular boundaries and regular grid. More...
 
subroutine w3uno2s (MX, MY, NX, NY, CFLL, TRANS, Q, BCLOSE, INC, MAPACT, NACT, MAPBOU, NB0, NB1, NB2, NDSE, NDST)
 Like W3UNO2r with cell transparencies added. More...
 

Detailed Description

Portable UNO2 scheme on irregular grid.

Author
Jain-Guo Li
Date
1-Jul-2013

Function/Subroutine Documentation

◆ w3uno2()

subroutine w3uno2md::w3uno2 ( integer, intent(in)  MX,
integer, intent(in)  MY,
integer, intent(in)  NX,
integer, intent(in)  NY,
real, dimension(my*(mx+1)), intent(inout)  VELO,
real, intent(in)  DT,
real, dimension(my*(mx+1)), intent(inout)  DX1,
real, dimension(1-my:my*(mx+1)), intent(inout)  DX2,
real, dimension(1-my:my*(mx+2)), intent(inout)  Q,
logical, intent(in)  BCLOSE,
integer, intent(in)  INC,
integer, dimension(my*mx), intent(in)  MAPACT,
integer, intent(in)  NACT,
integer, dimension(my*mx), intent(in)  MAPBOU,
integer, intent(in)  NB0,
integer, intent(in)  NB1,
integer, intent(in)  NB2,
integer, intent(in)  NDSE,
integer, intent(in)  NDST 
)

UNO2 scheme for irregular grid.

Parameters
[in]MXField dimensions, if grid is 'closed' or circular, MX is the closed dimension.
[in]MYField dimensions
[in]NXPart of field actually used
[in]NYPart of field actually used
[in,out]VELOLocal velocities (MY, MX+1).
[in]DTTime step.
[in,out]DX1Band width at points (MY, MX+1).
[in,out]DX2Band width between points (MY,0:MX+1).
[in,out]QPropagated quantity.
[in]BCLOSEFlag for closed 'X' dimension.
[in]INCIncrement in 1-D array corresponding to increment in 2-D space.
[in]MAPACTList of active grid points.
[in]NACTSize of MAPACT.
[in]MAPBOUMap with boundary information (see W3MAP2).
[in]NB0Counter in MAPBOU
[in]NB1Counter in MAPBOU
[in]NB2Counter in MAPBOU
[in]NDSEError output unit number.
[in]NDSTTest output unit number.
Author
Jain-Guo Li
Date
1-Jul-2013

Definition at line 105 of file w3uno2md.F90.

105  !/
106  !
107  ! Parameter list
108  ! ----------------------------------------------------------------
109  ! MX,MY Int. I Field dimensions, if grid is 'closed' or
110  ! circular, MX is the closed dimension.
111  ! NX,NY Int. I Part of field actually used.
112  ! VELO R.A. I Local velocities. (MY, MX+1)
113  ! DT Real I Time step.
114  ! DX1 R.A. I/O Band width at points. (MY, MX+1)
115  ! DX2 R.A. I/O Band width between points. (MY,0:MX+1)
116  ! (local counter and counter+INC)
117  ! Q R.A. I/O Propagated quantity. (MY,0:MX+2)
118  ! BCLOSE Log. I Flag for closed 'X' dimension'
119  ! INC Int. I Increment in 1-D array corresponding to
120  ! increment in 2-D space.
121  ! MAPACT I.A. I List of active grid points.
122  ! NACT Int. I Size of MAPACT.
123  ! MAPBOU I.A. I Map with boundary information (see W3MAP2).
124  ! NBn Int. I Counters in MAPBOU.
125  ! NDSE Int. I Error output unit number.
126  ! NDST Int. I Test output unit number.
127  ! ----------------------------------------------------------------
128  ! - VELO amd Q need only bee filled in the (MY,MX) range,
129  ! extension is used internally for closure.
130  ! - VELO and Q are defined as 1-D arrays internally.
131  !
132  ! 4. Subroutines used :
133  !
134  ! STRACE Service routine.
135  !
136  ! 5. Called by :
137  !
138  ! W3XYP2 Propagation in physical space
139  !
140  ! 6. Error messages :
141  !
142  ! None.
143  !
144  ! 7. Remarks :
145  !
146  ! - This routine can be used independently from WAVEWATCH-III.
147  !
148  ! 8. Structure :
149  !
150  ! ------------------------------------------------------
151  ! 1. Initialize aux. array FLA.
152  ! 2. Fluxes for central points (3rd order + limiter).
153  ! 3. Fluxes boundary point above (1st order).
154  ! 4. Fluxes boundary point below (1st order).
155  ! 5. Closure of 'X' if required
156  ! 6. Propagate.
157  ! ------------------------------------------------------
158  !
159  ! 9. Switches :
160  !
161  ! !/S Enable subroutine tracing.
162  ! !/T Enable test output.
163  ! !/T0 Test output input/output fields.
164  ! !/T1 Test output fluxes.
165  ! !/T2 Test output integration.
166  !
167  ! 10. Source code :
168  !
169  !/ ------------------------------------------------------------------- /
170  IMPLICIT NONE
171  !/
172  !/ ------------------------------------------------------------------- /
173  !/ Parameter list
174  !/
175  INTEGER, INTENT(IN) :: MX, MY, NX, NY, INC, MAPACT(MY*MX), &
176  NACT, MAPBOU(MY*MX), NB0, NB1, NB2, &
177  NDSE, NDST
178  REAL, INTENT(IN) :: DT
179  REAL, INTENT(INOUT) :: VELO(MY*(MX+1)), DX1(MY*(MX+1)), &
180  DX2(1-MY:MY*(MX+1)), Q(1-MY:MY*(MX+2))
181  LOGICAL, INTENT(IN) :: BCLOSE
182  !/
183  !/ ------------------------------------------------------------------- /
184  !/ Local parameters
185  !/
186  INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, &
187  IAD00, IAD02, IADN0, IADN1, IADN2
188 #ifdef W3_S
189  INTEGER, SAVE :: IENT
190 #endif
191 #ifdef W3_T1
192  INTEGER :: IX2, IY2
193 #endif
194  REAL :: CFL, VEL, QB, DQ, DQNZ, QCN, QBN, &
195  QBR, CFAC, FLA(1-MY:MY*MX)
196 #ifdef W3_T0
197  REAL :: QMAX
198 #endif
199 #ifdef W3_T1
200  REAL :: QBO, QN, XCFL
201 #endif
202 #ifdef W3_T2
203  REAL :: QOLD
204 #endif
205  !/
206  !/ ------------------------------------------------------------------- /
207  !/
208 #ifdef W3_S
209  CALL strace (ient, 'W3UNO2')
210 #endif
211  !
212 #ifdef W3_T
213  WRITE (ndst,9000) mx, my, nx, ny, dt, bclose, inc, nb0, nb1, nb2
214 #endif
215  !
216 #ifdef W3_T0
217  qmax = 0.
218  DO iy=1, ny
219  DO ix=1, nx
220  qmax = max( qmax , q(iy+(ix-1)*my) )
221  END DO
222  END DO
223  qmax = max( 0.01*qmax , 1.e-10 )
224 #endif
225  !
226 #ifdef W3_T0
227  WRITE (ndst,9001) 'VELO'
228  DO iy=ny,1,-1
229  WRITE (ndst,9002) (nint(100.*velo(iy+(ix-1)*my) &
230  *dt/dx1(iy+(ix-1)*my)),ix=1,nx)
231  END DO
232  WRITE (ndst,9001) 'Q'
233  DO iy=ny,1,-1
234  WRITE (ndst,9002) (nint(q(iy+(ix-1)*my)/qmax),ix=1,nx)
235  END DO
236  WRITE (ndst,9001) 'MAPACT'
237  WRITE (ndst,9003) (mapact(ixy),ixy=1,nact)
238 #endif
239  !
240  ! 1. Initialize aux. array FLA and closure ------------------------- *
241  !
242  fla = 0.
243  !
244  IF ( bclose ) THEN
245 #ifdef W3_T
246  WRITE (ndst,9005)
247 #endif
248  iad00 = -my
249  iad02 = my
250  iadn0 = iad00 + my*nx
251  iadn1 = my*nx
252  iadn2 = iad02 + my*nx
253  DO iy=1, ny
254  q(iy+iad00) = q(iy+iadn0)
255  q(iy+iadn1) = q( iy )
256  q(iy+iadn2) = q(iy+iad02)
257  velo(iy+iadn1) = velo( iy )
258  dx1(iy+iadn1) = dx1( iy )
259  dx2(iy+iad00) = dx1(iy+iadn0)
260  dx2(iy+iadn1) = dx1( iy )
261  END DO
262  END IF
263  !
264  ! 2. Fluxes for central points ------------------------------------- *
265  ! ( 2rd order UNO2 scheme )
266  !
267 #ifdef W3_T1
268  WRITE (ndst,9010)
269  WRITE (ndst,9011) nb0, 'CENTRAL'
270 #endif
271  !
272  DO ip=1, nb0
273  !
274  ixy = mapbou(ip)
275  vel = 0.5 * ( velo(ixy) + velo(ixy+inc) )
276  ! Assuming velocity is at cell centre, so face velocity is an average.
277  cfl = dt * vel
278  ! Courant number without gradient distance (between IXY and IXY+INC cells)
279  ixyc = ixy - inc * int( min( 0. , sign(1.1,cfl) ) )
280  ! Central cell index, depending on flow direction.
281  ! IXY for positive CFL, IXY+INC for negative CFL
282  ! Upstream and downstream cell numbers
283  ixyd = ixyc + inc * int( sign(1.1,cfl) )
284  ! Minimum gradient is derived from the two sides of the central cell
285  !
286  qb = q(ixyc)+sign(0.5, q(ixyd)-q(ixyc))*(dx1(ixyc)-abs(cfl)) &
287  *min(abs(q(ixyc+inc)-q(ixyc))/dx2(ixyc), &
288  abs(q(ixyc)-q(ixyc-inc))/dx2(ixyc-inc) )
289  !
290 #ifdef W3_T1
291  qbo = qb
292 #endif
293  !
294  fla(ixy) = cfl * qb
295  !
296 #ifdef W3_T1
297  iy = mod( ixy , my )
298  ix = 1 + ixy/my
299  iy2 = mod( ixy+inc , my )
300  ix2 = 1 + (ixy+inc)/my
301  qn = max( qb, qbo, q(ixy-inc), q( ixy ), &
302  q(ixy+inc), q(ixy+2*inc) )
303  IF ( qn .GT. 1.e-10 ) THEN
304  qn = 1. /qn
305  WRITE (ndst,9012) ip, ix, iy, ix2, iy2, &
306  cfl, dt*velo(ixy)/dx1(ixy), &
307  dt*velo(ixy+inc)/dx1(ixy+inc), &
308  qbo*qn, qb*qn, q(ixy-inc)*qn, q( ixy )*qn, &
309  q(ixy+inc)*qn, q(ixy+2*inc)*qn
310  END IF
311 #endif
312  !
313  END DO
314  !
315  ! 3. Fluxes for points with boundary above ------------------------- *
316  ! ( 1st order without limiter )
317  !
318 #ifdef W3_T1
319  WRITE (ndst,9011) nb1-nb0, 'BOUNDARY ABOVE'
320 #endif
321  !
322  DO ip=nb0+1, nb1
323  ixy = mapbou(ip)
324  vel = velo(ixy)
325  ixyc = ixy - inc * int( min( 0. , sign(1.1,vel) ) )
326  fla(ixy) = vel * dt * q(ixyc)
327 #ifdef W3_T1
328  iy = mod( ixy , my )
329  ix = 1 + ixy/my
330  iy2 = mod( ixy+inc , my )
331  ix2 = 1 + (ixy+inc)/my
332  qn = max( q(ixy+inc), q(ixy) )
333  IF ( qn .GT. 1.e-10 ) THEN
334  qn = 1. /qn
335  WRITE (ndst,9013) ip, ix, iy, ix2, iy2, xcfl, &
336  dt*velo(ixy)/dx2(ixy), &
337  q(ixyc)*qn, q(ixy)*qn, q(ixy+inc)*qn
338  END IF
339 #endif
340  END DO
341  !
342  ! 4. Fluxes for points with boundary below ------------------------- *
343  ! ( 1st order without limiter )
344  !
345 #ifdef W3_T1
346  WRITE (ndst,9011) nb2-nb1, 'BOUNDARY BELOW'
347 #endif
348  !
349  DO ip=nb1+1, nb2
350  ixy = mapbou(ip)
351  vel = velo(ixy+inc)
352  ixyc = ixy - inc * int( min( 0. , sign(1.1,vel) ) )
353  fla(ixy) = vel * dt * q(ixyc)
354 #ifdef W3_T1
355  iy = mod( ixy , my )
356  ix = 1 + ixy/my
357  iy2 = mod( ixy+inc , my )
358  ix2 = 1 + (ixy+inc)/my
359  qn = max( q(ixy+inc), q(ixy) )
360  IF ( qn .GT. 1.e-10 ) THEN
361  qn = 1. /qn
362  WRITE (ndst,9014) ip, ix, iy, ix2, iy2, xcfl, &
363  dt*velo(ixy+inc)/dx2(ixy), &
364  q(ixyc)*qn, q(ixy)*qn, q(ixy+inc)*qn
365  END IF
366 #endif
367  END DO
368  !
369  ! 5. Global closure ----------------------------------------------- *
370  !
371  IF ( bclose ) THEN
372 #ifdef W3_T
373  WRITE (ndst,9015)
374 #endif
375  DO iy=1, ny
376  fla(iy+iad00) = fla(iy+iadn0)
377  END DO
378  END IF
379  !
380  ! 6. Propagation -------------------------------------------------- *
381  !
382 #ifdef W3_T2
383  WRITE (ndst,9020)
384 #endif
385  DO ip=1, nact
386  ixy = mapact(ip)
387 #ifdef W3_T2
388  qold = q(ixy)
389 #endif
390  ! Li Update transported quantity with fluxes
391  q(ixy) = max( 0., q(ixy)+( fla(ixy-inc)-fla(ixy) )/dx1(ixy) )
392  ! Li This positive filter is not necessary for UNO2 scheme but kept here.
393 #ifdef W3_T2
394  IF ( qold + q(ixy) .GT. 1.e-10 ) &
395  WRITE (ndst,9021) ip, ixy, qold, q(ixy), &
396  dt*fla(ixy-inc)/dx1(ixy), &
397  dt*fla(ixy)/dx1(ixy)
398 #endif
399  END DO
400  !
401 #ifdef W3_T0
402  WRITE (ndst,9001) 'Q'
403  DO iy=ny,1,-1
404  WRITE (ndst,9002) (nint(q(iy+(ix-1)*my)/qmax),ix=1,nx)
405  END DO
406 #endif
407  !
408  RETURN
409  !
410  ! Formats
411  !
412 #ifdef W3_T
413 9000 FORMAT ( ' TEST W3UNO2 : ARRAY DIMENSIONS :',2i6/ &
414  ' USED :',2i6/ &
415  ' TIME STEP :',f8.1/ &
416  ' BCLOSE, INC :',l6,i6/ &
417  ' NB0, NB1, NB2 :',3i6)
418 #endif
419 #ifdef W3_T0
420 9001 FORMAT ( ' TEST W3UNO2 : DUMP ARRAY ',a,' :')
421 9002 FORMAT ( 1x,43i3)
422 9003 FORMAT ( 1x,21i6)
423 #endif
424 #ifdef W3_T
425 9005 FORMAT (' TEST W3UNO2 : GLOBAL CLOSURE (1)')
426 #endif
427  !
428 #ifdef W3_T1
429 9010 FORMAT (' TEST W3UNO2 : IP, 2x(IX,IY), CFL (b,i,i+1), ', &
430  ' Q (b,b,i-1,i,i+1,i+2)')
431 9011 FORMAT (' TEST W3UNO2 :',i6,' POINTS OF TYPE ',a)
432 9012 FORMAT (10x,i6,4i4,1x,3f6.2,1x,f7.2,f6.2,1x,4f6.2)
433 9013 FORMAT (10x,i6,4i4,1x,f6.2,f6.2,' --- ',1x,f7.2,1x,' --- ',&
434  2f6.2,' --- ')
435 9014 FORMAT (10x,i6,4i4,1x,f6.2,' --- ',f6.2,1x,f7.2,1x,' --- ',&
436  2f6.2,' --- ')
437 #endif
438 #ifdef W3_T
439 9015 FORMAT (' TEST W3UNO2 : GLOBAL CLOSURE (2)')
440 #endif
441  !
442 #ifdef W3_T2
443 9020 FORMAT (' TEST W3UNO2 : IP, IXY, 2Q, 2FL')
444 9021 FORMAT (' ',2i6,2(1x,2e11.3))
445 #endif

References w3servmd::strace().

Referenced by w3pro2md::w3ktp2(), and w3pro3md::w3ktp3().

◆ w3uno2r()

subroutine w3uno2md::w3uno2r ( integer, intent(in)  MX,
integer, intent(in)  MY,
integer, intent(in)  NX,
integer, intent(in)  NY,
real, dimension(my*(mx+1)), intent(inout)  CFLL,
real, dimension(1-my:my*(mx+2)), intent(inout)  Q,
logical, intent(in)  BCLOSE,
integer, intent(in)  INC,
integer, dimension(my*mx), intent(in)  MAPACT,
integer, intent(in)  NACT,
integer, dimension(my*mx), intent(in)  MAPBOU,
integer, intent(in)  NB0,
integer, intent(in)  NB1,
integer, intent(in)  NB2,
integer, intent(in)  NDSE,
integer, intent(in)  NDST 
)

Preform one-dimensional propagation in a two-dimensional space with irregular boundaries and regular grid.

Parameters
[in]MXField dimensions, if grid is 'closed' or circular, MX is the closed dimension.
[in]MYField dimensions
[in]NXPart of field actually used
[in]NYPart of field actually used
[in,out]CFLLLocal Courant numbers (MY, MX+1).
[in,out]QPropagated quantity (MY,0:MX+2).
[in]BCLOSEFlag for closed 'X' dimension.
[in]INCIncrement in 1-D array corresponding to increment in 2-D space.
[in]MAPACTList of active grid points.
[in]NACTSize of MAPACT.
[in]MAPBOUMap with boundary information (see W3MAP2).
[in]NB0Counter in MAPBOU
[in]NB1Counter in MAPBOU
[in]NB2Counter in MAPBOU
[in]NDSEError output unit number.
[in]NDSTTest output unit number.
Author
Jain-Guo Li
Date
8-Jan-2018

Definition at line 475 of file w3uno2md.F90.

475  !/
476  !/ Adapted from W3QCK1 for UNO2 regular grid scheme.
477  !/ First created: 19 Mar 2008 Jian-Guo Li
478  !/ Last modified: 8 Jan 2018 Jian-Guo Li
479  !/
480  ! 1. Purpose :
481  !
482  ! Preform one-dimensional propagation in a two-dimensional space
483  ! with irregular boundaries and regular grid.
484  !
485  ! 2. Method :
486  !
487  ! UNO2 regular grid scheme
488  !
489  ! 3. Parameters :
490  !
491  ! Parameter list
492  ! ----------------------------------------------------------------
493  ! MX,MY Int. I Field dimensions, if grid is 'closed' or
494  ! circular, MX is the closed dimension.
495  ! NX,NY Int. I Part of field actually used.
496  ! CFLL R.A. I Local Courant numbers. (MY, MX+1)
497  ! Q R.A. I/O Propagated quantity. (MY,0:MX+2)
498  ! BCLOSE Log. I Flag for closed 'X' dimension'
499  ! INC Int. I Increment in 1-D array corresponding to
500  ! increment in 2-D space.
501  ! MAPACT I.A. I List of active grid points.
502  ! NACT Int. I Size of MAPACT.
503  ! MAPBOU I.A. I Map with boundary information (see W3MAP2).
504  ! NBn Int. I Counters in MAPBOU.
505  ! NDSE Int. I Error output unit number.
506  ! NDST Int. I Test output unit number.
507  ! ----------------------------------------------------------------
508  ! - CFLL amd Q need only bee filled in the (MY,MX) range,
509  ! extension is used internally for closure.
510  ! - CFLL and Q are defined as 1-D arrays internally.
511  !
512  ! 4. Subroutines used :
513  !
514  ! STRACE Service routine.
515  !
516  ! 5. Called by :
517  !
518  ! W3XYP2 Propagation in physical space
519  !
520  ! 6. Error messages :
521  !
522  ! None.
523  !
524  ! 7. Remarks :
525  !
526  ! - This routine can be used independently from WAVEWATCH-III.
527  !
528  ! 8. Structure :
529  !
530  ! ------------------------------------------------------
531  ! 1. Initialize aux. array FLA.
532  ! 2. Fluxes for central points (3rd order + limiter).
533  ! 3. Fluxes boundary point above (1st order).
534  ! 4. Fluxes boundary point below (1st order).
535  ! 5. Closure of 'X' if required
536  ! 6. Propagate.
537  ! ------------------------------------------------------
538  !
539  ! 9. Switches :
540  !
541  ! !/S Enable subroutine tracing.
542  ! !/T Enable test output.
543  ! !/T0 Test output input/output fields.
544  ! !/T1 Test output fluxes.
545  ! !/T2 Test output integration.
546  !
547  ! 10. Source code :
548  !
549  !/ ------------------------------------------------------------------- /
550  IMPLICIT NONE
551  !/
552  !/ ------------------------------------------------------------------- /
553  !/ Parameter list
554  !/
555  INTEGER, INTENT(IN) :: MX, MY, NX, NY, INC, MAPACT(MY*MX), &
556  NACT, MAPBOU(MY*MX), NB0, NB1, NB2, &
557  NDSE, NDST
558  REAL, INTENT(INOUT) :: CFLL(MY*(MX+1)), Q(1-MY:MY*(MX+2))
559  LOGICAL, INTENT(IN) :: BCLOSE
560  !/
561  !/ ------------------------------------------------------------------- /
562  !/ Local parameters
563  !/
564  INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, &
565  IAD00, IAD02, IADN0, IADN1, IADN2
566 #ifdef W3_S
567  INTEGER, SAVE :: IENT = 0
568 #endif
569 #ifdef W3_T1
570  INTEGER :: IX2, IY2
571 #endif
572  REAL :: CFL, QB, DQ, DQNZ, QCN, QBN, QBR, CFAC
573  REAL :: FLA(1-MY:MY*MX)
574 #ifdef W3_T0
575  REAL :: QMAX
576 #endif
577 #ifdef W3_T1
578  REAL :: QBO, QN
579 #endif
580 #ifdef W3_T2
581  REAL :: QOLD
582 #endif
583  !/
584  !/ ------------------------------------------------------------------- /
585  !/
586 #ifdef W3_S
587  CALL strace (ient, 'W3UNO2r')
588 #endif
589  !
590 #ifdef W3_T
591  WRITE (ndst,9000) mx, my, nx, ny, bclose, inc, nb0, nb1, nb2
592 #endif
593  !
594 #ifdef W3_T0
595  qmax = 0.
596  DO iy=1, ny
597  DO ix=1, nx
598  qmax = max( qmax , q(iy+(ix-1)*my) )
599  END DO
600  END DO
601  qmax = max( 0.01*qmax , 1.e-10 )
602 #endif
603  !
604 #ifdef W3_T0
605  WRITE (ndst,9001) 'CFLL'
606  DO iy=ny,1,-1
607  WRITE (ndst,9002) (nint(100.*cfll(iy+(ix-1)*my)),ix=1,nx)
608  END DO
609  WRITE (ndst,9001) 'Q'
610  DO iy=ny,1,-1
611  WRITE (ndst,9002) (nint(q(iy+(ix-1)*my)/qmax),ix=1,nx)
612  END DO
613  WRITE (ndst,9001) 'MAPACT'
614  WRITE (ndst,9003) (mapact(ixy),ixy=1,nact)
615 #endif
616  !
617  ! 1. Initialize aux. array FLA and closure ------------------------- *
618  !
619  fla = 0.
620  !
621  IF ( bclose ) THEN
622 #ifdef W3_T
623  WRITE (ndst,9005)
624 #endif
625  iad00 = -my
626  iad02 = my
627  iadn0 = iad00 + my*nx
628  iadn1 = my*nx
629  iadn2 = iad02 + my*nx
630  DO iy=1, ny
631  q(iy+iad00) = q(iy+iadn0)
632  q(iy+iadn1) = q( iy )
633  q(iy+iadn2) = q(iy+iad02)
634  cfll(iy+iadn1) = cfll( iy )
635  END DO
636  END IF
637  !
638  ! 2. Fluxes for central points ------------------------------------- *
639  ! ( 3rd order + limiter )
640  !
641 #ifdef W3_T1
642  WRITE (ndst,9010)
643  WRITE (ndst,9011) nb0, 'CENTRAL'
644 #endif
645  !
646  DO ip=1, nb0
647  !
648  ixy = mapbou(ip)
649  cfl = 0.5 * ( cfll(ixy) + cfll(ixy+inc) )
650  ixyc = ixy - inc * int( min( 0. , sign(1.1,cfl) ) )
651  ixyd = ixyc + inc * int( sign(1.1,cfl) )
652  qb = q(ixyc)+sign(0.5, q(ixyd)-q(ixyc))*(1.0-abs(cfl)) &
653  *min(abs(q(ixyc+inc)-q(ixyc)), &
654  abs(q(ixyc)-q(ixyc-inc)) )
655 #ifdef W3_T1
656  qbo = qb
657 #endif
658  !
659  fla(ixy) = cfl * qb
660  !
661 #ifdef W3_T1
662  iy = mod( ixy , my )
663  ix = 1 + ixy/my
664  iy2 = mod( ixy+inc , my )
665  ix2 = 1 + (ixy+inc)/my
666  qn = max( qb, qbo, q(ixy-inc), q( ixy ), &
667  q(ixy+inc), q(ixy+2*inc) )
668  IF ( qn .GT. 1.e-10 ) THEN
669  qn = 1. /qn
670  WRITE (ndst,9012) ip, ix, iy, ix2, iy2, &
671  cfl, cfll(ixy), cfll(ixy+inc), &
672  qbo*qn, qb*qn, q(ixy-inc)*qn, q( ixy )*qn, &
673  q(ixy+inc)*qn, q(ixy+2*inc)*qn
674  END IF
675 #endif
676  !
677  END DO
678  !
679  ! 3. Fluxes for points with boundary above ------------------------- *
680  ! ( 1st order without limiter )
681  !
682 #ifdef W3_T1
683  WRITE (ndst,9011) nb1-nb0, 'BOUNDARY ABOVE'
684 #endif
685  !
686  DO ip=nb0+1, nb1
687  ixy = mapbou(ip)
688  cfl = cfll(ixy)
689  ixyc = ixy - inc * int( min( 0. , sign(1.1,cfl) ) )
690  fla(ixy) = cfl * q(ixyc)
691 #ifdef W3_T1
692  iy = mod( ixy , my )
693  ix = 1 + ixy/my
694  iy2 = mod( ixy+inc , my )
695  ix2 = 1 + (ixy+inc)/my
696  qn = max( q(ixy+inc), q(ixy) )
697  IF ( qn .GT. 1.e-10 ) THEN
698  qn = 1. /qn
699  WRITE (ndst,9013) ip, ix, iy, ix2, iy2, cfl, &
700  cfll(ixy), q(ixyc)*qn, q(ixy)*qn, q(ixy+inc)*qn
701  END IF
702 #endif
703  END DO
704  !
705  ! 4. Fluxes for points with boundary below ------------------------- *
706  ! ( 1st order without limiter )
707  !
708 #ifdef W3_T1
709  WRITE (ndst,9011) nb2-nb1, 'BOUNDARY BELOW'
710 #endif
711  !
712  DO ip=nb1+1, nb2
713  ixy = mapbou(ip)
714  cfl = cfll(ixy+inc)
715  ixyc = ixy - inc * int( min( 0. , sign(1.1,cfl) ) )
716  fla(ixy) = cfl * q(ixyc)
717 #ifdef W3_T1
718  iy = mod( ixy , my )
719  ix = 1 + ixy/my
720  iy2 = mod( ixy+inc , my )
721  ix2 = 1 + (ixy+inc)/my
722  qn = max( q(ixy+inc), q(ixy) )
723  IF ( qn .GT. 1.e-10 ) THEN
724  qn = 1. /qn
725  WRITE (ndst,9014) ip, ix, iy, ix2, iy2, cfl, &
726  cfll(ixy+inc), q(ixyc)*qn, q(ixy)*qn, q(ixy+inc)*qn
727  END IF
728 #endif
729  END DO
730  !
731  ! 5. Global closure ----------------------------------------------- *
732  !
733  IF ( bclose ) THEN
734 #ifdef W3_T
735  WRITE (ndst,9015)
736 #endif
737  DO iy=1, ny
738  fla(iy+iad00) = fla(iy+iadn0)
739  END DO
740  END IF
741  !
742  ! 6. Propagation -------------------------------------------------- *
743  !
744 #ifdef W3_T2
745  WRITE (ndst,9020)
746 #endif
747  DO ip=1, nact
748  ixy = mapact(ip)
749 #ifdef W3_T2
750  qold = q(ixy)
751 #endif
752  q(ixy) = max( 0. , q(ixy) + fla(ixy-inc) - fla(ixy) )
753 #ifdef W3_T2
754  IF ( qold + q(ixy) .GT. 1.e-10 ) &
755  WRITE (ndst,9021) ip, ixy, qold, q(ixy), &
756  fla(ixy-inc), fla(ixy)
757 #endif
758  END DO
759  !
760 #ifdef W3_T0
761  WRITE (ndst,9001) 'Q'
762  DO iy=ny,1,-1
763  WRITE (ndst,9002) (nint(q(iy+(ix-1)*my)/qmax),ix=1,nx)
764  END DO
765 #endif
766  !
767  RETURN
768  !
769  ! Formats
770  !
771 #ifdef W3_T
772 9000 FORMAT ( ' TEST W3UNO2r : ARRAY DIMENSIONS :',2i6/ &
773  ' USED :',2i6/ &
774  ' BCLOSE, INC :',l6,i6/ &
775  ' NB0, NB1, NB2 :',3i6)
776 #endif
777 #ifdef W3_T0
778 9001 FORMAT ( ' TEST W3UNO2r : DUMP ARRAY ',a,' :')
779 9002 FORMAT ( 1x,43i3)
780 9003 FORMAT ( 1x,21i6)
781 #endif
782 #ifdef W3_T
783 9005 FORMAT (' TEST W3UNO2r : GLOBAL CLOSURE (1)')
784 #endif
785  !
786 #ifdef W3_T1
787 9010 FORMAT (' TEST W3UNO2r : IP, 2x(IX,IY), CFL (b,i,i+1), ', &
788  ' Q (b,b,i-1,i,i+1,i+2)')
789 9011 FORMAT (' TEST W3UNO2r :',i6,' POINTS OF TYPE ',a)
790 9012 FORMAT (10x,i6,4i4,1x,3f6.2,1x,f7.2,f6.2,1x,4f6.2)
791 9013 FORMAT (10x,i6,4i4,1x,f6.2,f6.2,' --- ',1x,f7.2,1x,' --- ',&
792  2f6.2,' --- ')
793 9014 FORMAT (10x,i6,4i4,1x,f6.2,' --- ',f6.2,1x,f7.2,1x,' --- ',&
794  2f6.2,' --- ')
795 #endif
796 #ifdef W3_T
797 9015 FORMAT (' TEST W3UNO2r : GLOBAL CLOSURE (2)')
798 #endif
799  !
800 #ifdef W3_T2
801 9020 FORMAT (' TEST W3UNO2r : IP, IXY, 2Q, 2FL')
802 9021 FORMAT (' ',2i6,2(1x,2e11.3))
803 #endif
804  !/

References w3servmd::strace().

Referenced by w3pro2md::w3ktp2(), and w3pro3md::w3ktp3().

◆ w3uno2s()

subroutine w3uno2md::w3uno2s ( integer, intent(in)  MX,
integer, intent(in)  MY,
integer, intent(in)  NX,
integer, intent(in)  NY,
real, dimension(my*(mx+1)), intent(inout)  CFLL,
real, dimension(my*mx,-1:1), intent(in)  TRANS,
real, dimension(1-my:my*(mx+2)), intent(inout)  Q,
logical, intent(in)  BCLOSE,
integer, intent(in)  INC,
integer, dimension(my*mx), intent(in)  MAPACT,
integer, intent(in)  NACT,
integer, dimension(my*mx), intent(in)  MAPBOU,
integer, intent(in)  NB0,
integer, intent(in)  NB1,
integer, intent(in)  NB2,
integer, intent(in)  NDSE,
integer, intent(in)  NDST 
)

Like W3UNO2r with cell transparencies added.

Adapted from W3QCK3 for UNO2 regular grid scheme with subgrid obstruction.

Parameters
[in]MXField dimensions, if grid is 'closed' or circular, MX is the closed dimension.
[in]MYField dimensions
[in]NXPart of field actually used
[in]NYPart of field actually used
[in]TRANS
[in,out]CFLLLocal Courant numbers (MY, MX+1).
[in,out]QPropagated quantity (MY,0:MX+2).
[in]BCLOSEFlag for closed 'X' dimension.
[in]INCIncrement in 1-D array corresponding to increment in 2-D space.
[in]MAPACTList of active grid points.
[in]NACTSize of MAPACT.
[in]MAPBOUMap with boundary information (see W3MAP2).
[in]NB0Counter in MAPBOU
[in]NB1Counter in MAPBOU
[in]NB2Counter in MAPBOU
[in]NDSEError output unit number.
[in]NDSTTest output unit number.
Author
Jain-Guo Li
Date
8-Jan-2018

Definition at line 839 of file w3uno2md.F90.

839  !/
840  !/
841  !/ Adapted from W3QCK3 for UNO2 regular grid scheme with
842  !/ subgrid obstruction.
843  !/ First created: 19 Mar 2008 Jian-Guo Li
844  !/ Last modified: 8 Jan 2018 Jian-Guo Li
845  !/
846  ! 1. Purpose :
847  !
848  ! Like W3UNO2r with cell transparencies added.
849  !
850  ! 2. Method :
851  !
852  ! 3. Parameters :
853  !
854  ! Parameter list
855  ! ----------------------------------------------------------------
856  ! MX,MY Int. I Field dimensions, if grid is 'closed' or
857  ! circular, MX is the closed dimension.
858  ! NX,NY Int. I Part of field actually used.
859  ! CFLL R.A. I Local Courant numbers. (MY, MX+1)
860  ! Q R.A. I/O Propagated quantity. (MY,0:MX+2)
861  ! BCLOSE Log. I Flag for closed 'X' dimension'
862  ! INC Int. I Increment in 1-D array corresponding to
863  ! increment in 2-D space.
864  ! MAPACT I.A. I List of active grid points.
865  ! NACT Int. I Size of MAPACT.
866  ! MAPBOU I.A. I Map with boundary information (see W3MAP2).
867  ! NBn Int. I Counters in MAPBOU.
868  ! NDSE Int. I Error output unit number.
869  ! NDST Int. I Test output unit number.
870  ! ----------------------------------------------------------------
871  ! - CFLL amd Q need only bee filled in the (MY,MX) range,
872  ! extension is used internally for closure.
873  ! - CFLL and Q are defined as 1-D arrays internally.
874  !
875  ! 4. Subroutines used :
876  !
877  ! STRACE Service routine.
878  !
879  ! 5. Called by :
880  !
881  ! W3XYP2 Propagation in physical space
882  !
883  ! 6. Error messages :
884  !
885  ! None.
886  !
887  ! 7. Remarks :
888  !
889  ! - This routine can be used independently from WAVEWATCH-III.
890  !
891  ! 8. Structure :
892  !
893  ! ------------------------------------------------------
894  ! 1. Initialize aux. array FLA.
895  ! 2. Fluxes for central points (3rd order + limiter).
896  ! 3. Fluxes boundary point above (1st order).
897  ! 4. Fluxes boundary point below (1st order).
898  ! 5. Closure of 'X' if required
899  ! 6. Propagate.
900  ! ------------------------------------------------------
901  !
902  ! 9. Switches :
903  !
904  ! !/OMPH Ading OMP directves for hybrid paralellization.
905  !
906  ! !/S Enable subroutine tracing.
907  ! !/T Enable test output.
908  ! !/T0 Test output input/output fields.
909  ! !/T1 Test output fluxes.
910  ! !/T2 Test output integration.
911  !
912  ! 10. Source code :
913  !
914  !/ ------------------------------------------------------------------- /
915  IMPLICIT NONE
916  !/
917  !/ ------------------------------------------------------------------- /
918  !/ Parameter list
919  !/
920  INTEGER, INTENT(IN) :: MX, MY, NX, NY, INC, MAPACT(MY*MX), &
921  NACT, MAPBOU(MY*MX), NB0, NB1, NB2, &
922  NDSE, NDST
923  REAL, INTENT(IN) :: TRANS(MY*MX,-1:1)
924  REAL, INTENT(INOUT) :: CFLL(MY*(MX+1)), Q(1-MY:MY*(MX+2))
925  LOGICAL, INTENT(IN) :: BCLOSE
926  !/
927  !/ ------------------------------------------------------------------- /
928  !/ Local parameters
929  !/
930  INTEGER :: IXY, IP, IXYC, IXYU, IXYD, IY, IX, &
931  IAD00, IAD02, IADN0, IADN1, IADN2, &
932  JN, JP
933 #ifdef W3_S
934  INTEGER, SAVE :: IENT = 0
935 #endif
936 #ifdef W3_T1
937  INTEGER :: IX2, IY2
938 #endif
939  REAL :: CFL, QB, DQ, DQNZ, QCN, QBN, QBR, CFAC
940  REAL :: FLA(1-MY:MY*MX)
941 #ifdef W3_T0
942  REAL :: QMAX
943 #endif
944 #ifdef W3_T1
945  REAL :: QBO, QN
946 #endif
947 #ifdef W3_T2
948  REAL :: QOLD
949 #endif
950  !/
951  !/ ------------------------------------------------------------------- /
952  !/
953 #ifdef W3_S
954  CALL strace (ient, 'W3UNO2s')
955 #endif
956  !
957 #ifdef W3_T
958  WRITE (ndst,9000) mx, my, nx, ny, bclose, inc, nb0, nb1, nb2
959 #endif
960  !
961 #ifdef W3_T0
962  qmax = 0.
963  DO iy=1, ny
964  DO ix=1, nx
965  qmax = max( qmax , q(iy+(ix-1)*my) )
966  END DO
967  END DO
968  qmax = max( 0.01*qmax , 1.e-10 )
969 #endif
970  !
971 #ifdef W3_T0
972  WRITE (ndst,9001) 'CFLL'
973  DO iy=ny,1,-1
974  WRITE (ndst,9002) (nint(100.*cfll(iy+(ix-1)*my)),ix=1,nx)
975  END DO
976  WRITE (ndst,9001) 'Q'
977  DO iy=ny,1,-1
978  WRITE (ndst,9002) (nint(q(iy+(ix-1)*my)/qmax),ix=1,nx)
979  END DO
980  WRITE (ndst,9001) 'MAPACT'
981  WRITE (ndst,9003) (mapact(ixy),ixy=1,nact)
982 #endif
983  !
984  ! 1. Initialize aux. array FLA and closure ------------------------- *
985  !
986  fla = 0.
987  !
988  IF ( bclose ) THEN
989 #ifdef W3_T
990  WRITE (ndst,9005)
991 #endif
992  iad00 = -my
993  iad02 = my
994  iadn0 = iad00 + my*nx
995  iadn1 = my*nx
996  iadn2 = iad02 + my*nx
997  !
998 #ifdef W3_OMPH
999  !$OMP PARALLEL DO PRIVATE (IY)
1000 #endif
1001  !
1002  DO iy=1, ny
1003  q(iy+iad00) = q(iy+iadn0)
1004  q(iy+iadn1) = q( iy )
1005  q(iy+iadn2) = q(iy+iad02)
1006  cfll(iy+iadn1) = cfll( iy )
1007  END DO
1008  !
1009 #ifdef W3_OMPH
1010  !$OMP END PARALLEL DO
1011 #endif
1012  !
1013  END IF
1014  !
1015  ! 2. Fluxes for central points ------------------------------------- *
1016  ! ( 3rd order + limiter )
1017  !
1018 #ifdef W3_T1
1019  WRITE (ndst,9010)
1020  WRITE (ndst,9011) nb0, 'CENTRAL'
1021 #endif
1022  !
1023 #ifdef W3_OMPH
1024  !$OMP PARALLEL DO PRIVATE (IP, IXY, CFL, &
1025 #ifdef W3_T1
1026  !$OMP QBO, IX, IY, IY2, IX2, QN &
1027 #endif
1028  !$OMP IXYC, IXYD, QB)
1029 #endif
1030  !
1031  DO ip=1, nb0
1032  !
1033  ixy = mapbou(ip)
1034  cfl = 0.5 * ( cfll(ixy) + cfll(ixy+inc) )
1035  ixyc = ixy - inc * int( min( 0. , sign(1.1,cfl) ) )
1036  ixyd = ixyc + inc * int( sign(1.1,cfl) )
1037  qb = q(ixyc)+sign(0.5, q(ixyd)-q(ixyc))*(1.0-abs(cfl)) &
1038  *min(abs(q(ixyc+inc)-q(ixyc)), &
1039  abs(q(ixyc)-q(ixyc-inc)) )
1040  !
1041 #ifdef W3_T1
1042  qbo = qb
1043 #endif
1044  !
1045  fla(ixy) = cfl * qb
1046  !
1047 #ifdef W3_T1
1048  iy = mod( ixy , my )
1049  ix = 1 + ixy/my
1050  iy2 = mod( ixy+inc , my )
1051  ix2 = 1 + (ixy+inc)/my
1052  qn = max( qb, qbo, q(ixy-inc), q( ixy ), &
1053  q(ixy+inc), q(ixy+2*inc) )
1054  IF ( qn .GT. 1.e-10 ) THEN
1055  qn = 1. /qn
1056  WRITE (ndst,9012) ip, ix, iy, ix2, iy2, &
1057  cfl, cfll(ixy), cfll(ixy+inc), &
1058  qbo*qn, qb*qn, q(ixy-inc)*qn, q( ixy )*qn, &
1059  q(ixy+inc)*qn, q(ixy+2*inc)*qn
1060  END IF
1061 #endif
1062  !
1063  END DO
1064  !
1065 #ifdef W3_OMPH
1066  !$OMP END PARALLEL DO
1067 #endif
1068  !
1069  ! 3. Fluxes for points with boundary above ------------------------- *
1070  ! ( 1st order without limiter )
1071  !
1072 #ifdef W3_T1
1073  WRITE (ndst,9011) nb1-nb0, 'BOUNDARY ABOVE'
1074 #endif
1075  !
1076  DO ip=nb0+1, nb1
1077  ixy = mapbou(ip)
1078  cfl = cfll(ixy)
1079  ixyc = ixy - inc * int( min( 0. , sign(1.1,cfl) ) )
1080  fla(ixy) = cfl * q(ixyc)
1081 #ifdef W3_T1
1082  iy = mod( ixy , my )
1083  ix = 1 + ixy/my
1084  iy2 = mod( ixy+inc , my )
1085  ix2 = 1 + (ixy+inc)/my
1086  qn = max( q(ixy+inc), q(ixy) )
1087  IF ( qn .GT. 1.e-10 ) THEN
1088  qn = 1. /qn
1089  WRITE (ndst,9013) ip, ix, iy, ix2, iy2, cfl, &
1090  cfll(ixy), q(ixyc)*qn, q(ixy)*qn, q(ixy+inc)*qn
1091  END IF
1092 #endif
1093  END DO
1094  !
1095  ! 4. Fluxes for points with boundary below ------------------------- *
1096  ! ( 1st order without limiter )
1097  !
1098 #ifdef W3_T1
1099  WRITE (ndst,9011) nb2-nb1, 'BOUNDARY BELOW'
1100 #endif
1101  !
1102  DO ip=nb1+1, nb2
1103  ixy = mapbou(ip)
1104  cfl = cfll(ixy+inc)
1105  ixyc = ixy - inc * int( min( 0. , sign(1.1,cfl) ) )
1106  fla(ixy) = cfl * q(ixyc)
1107 #ifdef W3_T1
1108  iy = mod( ixy , my )
1109  ix = 1 + ixy/my
1110  iy2 = mod( ixy+inc , my )
1111  ix2 = 1 + (ixy+inc)/my
1112  qn = max( q(ixy+inc), q(ixy) )
1113  IF ( qn .GT. 1.e-10 ) THEN
1114  qn = 1. /qn
1115  WRITE (ndst,9014) ip, ix, iy, ix2, iy2, cfl, cfll(ixy+inc), &
1116  q(ixyc)*qn, q(ixy)*qn, q(ixy+inc)*qn
1117  END IF
1118 #endif
1119  END DO
1120  !
1121  ! 5. Global closure ----------------------------------------------- *
1122  !
1123  IF ( bclose ) THEN
1124 #ifdef W3_T
1125  WRITE (ndst,9015)
1126 #endif
1127  DO iy=1, ny
1128  fla(iy+iad00) = fla(iy+iadn0)
1129  END DO
1130  END IF
1131  !
1132  ! 6. Propagation -------------------------------------------------- *
1133  !
1134 #ifdef W3_T2
1135  WRITE (ndst,9020)
1136 #endif
1137  !
1138 #ifdef W3_OMPH
1139  !$OMP PARALLEL DO &
1140 #ifdef W3_T2
1141  !$OMP PRIVATE(QOLD), &
1142 #endif
1143  !$OMP PRIVATE (IP, IXY, JN, JP)
1144 #endif
1145  !
1146  DO ip=1, nact
1147  !
1148  ixy = mapact(ip)
1149  IF ( fla(ixy-inc) .GT. 0. ) THEN
1150  jn = -1
1151  ELSE
1152  jn = 0
1153  END IF
1154  IF ( fla(ixy ) .LT. 0. ) THEN
1155  jp = 1
1156  ELSE
1157  jp = 0
1158  END IF
1159  !
1160 #ifdef W3_T2
1161  qold = q(ixy)
1162 #endif
1163  q(ixy) = max( 0. , q(ixy) + trans(ixy,jn) * fla(ixy-inc) &
1164  - trans(ixy,jp) * fla(ixy) )
1165 
1166 #ifdef W3_T2
1167  IF ( qold + q(ixy) .GT. 1.e-10 ) &
1168  WRITE (ndst,9021) ip, ixy, qold, q(ixy), &
1169  fla(ixy-inc), fla(ixy)
1170 #endif
1171  END DO
1172  !
1173 #ifdef W3_OMPH
1174  !$OMP END PARALLEL DO
1175 #endif
1176  !
1177 #ifdef W3_T0
1178  WRITE (ndst,9001) 'Q'
1179  DO iy=ny,1,-1
1180  WRITE (ndst,9002) (nint(q(iy+(ix-1)*my)/qmax),ix=1,nx)
1181  END DO
1182 #endif
1183  !
1184  RETURN
1185  !
1186  ! Formats
1187  !
1188 #ifdef W3_T
1189 9000 FORMAT ( ' TEST W3UNO2s : ARRAY DIMENSIONS :',2i6/ &
1190  ' USED :',2i6/ &
1191  ' BCLOSE, INC :',l6,i6/ &
1192  ' NB0, NB1, NB2 :',3i6)
1193 #endif
1194 #ifdef W3_T0
1195 9001 FORMAT ( ' TEST W3UNO2s : DUMP ARRAY ',a,' :')
1196 9002 FORMAT ( 1x,43i3)
1197 9003 FORMAT ( 1x,21i6)
1198 #endif
1199 #ifdef W3_T
1200 9005 FORMAT (' TEST W3UNO2s : GLOBAL CLOSURE (1)')
1201 #endif
1202  !
1203 #ifdef W3_T1
1204 9010 FORMAT (' TEST W3UNO2s : IP, 2x(IX,IY), CFL (b,i,i+1), ', &
1205  ' Q (b,b,i-1,i,i+1,i+2)')
1206 9011 FORMAT (' TEST W3UNO2s :',i6,' POINTS OF TYPE ',a)
1207 9012 FORMAT (10x,i6,4i4,1x,3f6.2,1x,f7.2,f6.2,1x,4f6.2)
1208 9013 FORMAT (10x,i6,4i4,1x,f6.2,f6.2,' --- ',1x,f7.2,1x,' --- ',&
1209  2f6.2,' --- ')
1210 9014 FORMAT (10x,i6,4i4,1x,f6.2,' --- ',f6.2,1x,f7.2,1x,' --- ',&
1211  2f6.2,' --- ')
1212 #endif
1213 #ifdef W3_T
1214 9015 FORMAT (' TEST W3UNO2s : GLOBAL CLOSURE (2)')
1215 #endif
1216  !
1217 #ifdef W3_T2
1218 9020 FORMAT (' TEST W3UNO2s : IP, IXY, 2Q, 2FL')
1219 9021 FORMAT (' ',2i6,2(1x,2e11.3))
1220 #endif
1221  !/
1222  !/ End of W3UNO2s ---------------------------------------------------- /
1223  !/

References w3servmd::strace().

Referenced by w3pro2md::w3xyp2(), and w3pro3md::w3xyp3().

w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3gdatmd::nx
integer, pointer nx
Definition: w3gdatmd.F90:1097