WAVEWATCH III  beta 0.0.1
ww3_prep.F90
Go to the documentation of this file.
1 
5 !
6 
7 #include "w3macros.h"
8 !/ ------------------------------------------------------------------- /
16 !
17 PROGRAM w3prep
18  !/
19  !/ +-----------------------------------+
20  !/ | WAVEWATCH III NOAA/NCEP |
21  !/ | H. L. Tolman |
22  !/ | A. Chawla |
23  !/ | FORTRAN 90 |
24  !/ | Last update : 22-Mar-2021 |
25  !/ +-----------------------------------+
26  !/
27  !/ 14-Jan-1999 : Final FORTRAN 77 ( version 1.18 )
28  !/ 18-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 )
29  !/ 11-Jan-2001 : Flat grid option added ( version 2.06 )
30  !/ 17-Jul-2001 : Clean-up ( version 2.11 )
31  !/ 24-Jan-2002 : Add data for data assimilation. ( version 2.17 )
32  !/ 30-Apr-2002 : Fix 'AI' bug for 1-D fields. ( version 2.20 )
33  !/ 24-Apr-2003 : Fix bug for NDAT = 0 in data. ( version 3.03 )
34  !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 )
35  !/ 28-Jun-2006 : Adding file name preamble. ( version 3.09 )
36  !/ 25-Sep-2007 : Switch header of file on or off, ( version 3.13 )
37  !/ Times to file (!/O15) (A. Chawla)
38  !/ 29-May-2009 : Preparing distribution version. ( version 3.14 )
39  !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 )
40  !/ (W. E. Rogers & T. J. Campbell, NRL)
41  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
42  !/ (W. E. Rogers & T. J. Campbell, NRL)
43  !/ 15-May-2010 : Add ISI (icebergs and sea ice). ( version 3.14.4 )
44  !/ 29-Oct-2010 : Implement unstructured grids ( version 3.14.4 )
45  !/ (A. Roland and F. Ardhuin)
46  !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
47  !/ specify index closure for a grid. ( version 3.14 )
48  !/ (T. J. Campbell, NRL)
49  !/ 1-Apr-2011 : Fix bug GLOBX forcing with unst. ( version 3.14.4 )
50  !/ 19-Sep-2011 : Fix bug prep forcing with unst. ( version 4.04 )
51  !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.OF )
52  !/ 3-Mar-2013 : Allows for longer input file name ( version 4.09 )
53  !/ 11-Nov-2013 : Allows for input binary files to be of WAVEWATCH
54  !/ type (i.e. accounts for the header) ( version 4.13 )
55  !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 )
56  !/ 22-Mar-2021 : Add momentum and air density ( version 7.13 )
57  !/
58  !/ Copyright 2009-2012 National Weather Service (NWS),
59  !/ National Oceanic and Atmospheric Administration. All rights
60  !/ reserved. WAVEWATCH III is a trademark of the NWS.
61  !/ No unauthorized use without permission.
62  !/
63  ! 1. Purpose :
64  !
65  ! Pre-processing of the input water level, current, wind, ice
66  ! fields, momentum and air density, as well as assimilation data
67  ! for the generic shell W3SHEL (ww3_shel.ftn).
68  !
69  ! 2. Method :
70  !
71  ! See documented input file.
72  !
73  ! 3. Parameters :
74  !
75  ! Local parameters.
76  ! ----------------------------------------------------------------
77  ! NDSI Int. Input unit number ("ww3_prep.inp").
78  ! NDSLL Int. Unit number(s) of long-lat file(s)
79  ! NDSF I.A. Unit number(s) of input file(s).
80  ! NDSDAT Int. Unit number for output data file.
81  ! IFLD Int. Integer input type.
82  ! ITYPE Int. Integer input 'format' type.
83  ! NFCOMP Int. Number of partial input to be processed.
84  ! FLTIME Log. Time flag for input fields, if false, single
85  ! field, time read from NDSI.
86  ! IDLALL Int. Layout indicator used by INA2R. +
87  ! IDFMLL Int. Id. FORMAT indicator. |
88  ! FORMLL C*16 Id. FORMAT. | Long-lat
89  ! FROMLL C*4 'UNIT' / 'NAME' indicator | file(s)
90  ! NAMELL C*65 Name of long-lat file(s) +
91  ! IDLAF I.A. +
92  ! IDFMF I.A. |
93  ! FORMF C.A. | Idem. fields file(s)
94  ! FROMF C*4 |
95  ! NAMEF C*65 +
96  ! FORMT C.A. Format or time in field.
97  ! XC R.A. Components of input vector field or first
98  ! input scalar field
99  ! YC R.A. Components of input vector field or second
100  ! input scalar field
101  ! FX,FY R.A. Output fields.
102  ! ACC Real Required interpolation accuracy.
103  ! ----------------------------------------------------------------
104  !
105  ! 4. Subroutines used :
106  !
107  ! Name Type Module Description
108  ! ----------------------------------------------------------------
109  ! W3NMOD Subr. W3GDATMD Set number of model.
110  ! W3SETG Subr. Id. Point to selected model.
111  ! W3NDAT Subr. W3WDATMD Set number of model for wave data.
112  ! W3SETW Subr. Id. Point to selected model for wave data.
113  ! W3NOUT Subr. W3ODATMD Set number of model for output.
114  ! W3SETO Subr. Id. Point to selected model for output.
115  ! ITRACE Subr. W3SERVMD Subroutine tracing initialization.
116  ! STRACE Subr. Id. Subroutine tracing.
117  ! NEXTLN Subr. Id. Get next line from input filw
118  ! EXTCDE Subr. Id. Abort program as graceful as possible.
119  ! STME21 Subr. W3TIMEMD Convert time to string.
120  ! INAR2R Subr. W3ARRYMD Read in an REAL array.
121  ! INAR2I Subr. Id. Read in an INTEGER array.
122  ! PRTBLK Subr. Id. Print plot of array.
123  ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file.
124  ! W3FLDO Subr. W3FLDSMD Opening of WAVEWATCH III generic shell
125  ! data file.
126  ! W3FLDP Subr. Id. Prepare interp. from arbitrary grid.
127  ! W3FLDG Subr. Id. Reading/writing shell input data.
128  ! W3FLDD Subr. Id. Reading/writing shell assim. data.
129  ! W3GSUC Func. W3GSRUMD Create grid-search-utility object
130  ! W3GSUD Subr. W3GSRUMD Destroy grid-search-utility object
131  ! W3GRMP Func. W3GSRUMD Compute interpolation weights
132  ! ----------------------------------------------------------------
133  !
134  ! 5. Called by :
135  !
136  ! None, stand-alone program.
137  !
138  ! 6. Error messages :
139  !
140  ! - Checks on files and reading from file.
141  ! - Checks on validity of input parameters.
142  !
143  ! 7. Remarks :
144  !
145  ! - Input fields need to be continuous in longitude and latitude.
146  ! - Longitude - latitude grid (Section 4.a) : program attempts to
147  ! detect closure type (ICLO) using longitudes of the grid. Thus,
148  ! it does not allow the user to specify the closure type, and so
149  ! tripole closure is not supported.
150  ! - Grid(s) from file (Section 4.a) : program reads logical variable
151  ! CLO(J) from .inp file. Thus, it does not allow the user to
152  ! specify more than two closure type (SMPL or NONE), and so
153  ! tripole closure is not supported.
154 
155  ! 8. Structure :
156  !
157  ! ----------------------------------------------------
158  ! 1.a Number of models.
159  ! ( W3NMOD , W3NOUT , W3SETG , W3SETO )
160  ! b I-O setup.
161  ! c Print heading(s).
162  ! 2. Read model definition file. ( W3IOGR )
163  ! 3.a Read major types from input file.
164  ! b Check major types.
165  ! c Additional input format types and time.
166  ! 4. Prepare interpolation.
167  ! a Longitude - latitude grid
168  ! b Grid(s) from file. ( W3FLDP )
169  ! c Initialize fields.
170  ! d Input location and format.
171  ! 5 Prepare input and output files.
172  ! a Open input file
173  ! b Open and prepare output file ( W3FLDO )
174  ! 6 Until end of file
175  ! a Read new time and fields
176  ! b Interpolate fields
177  ! c Write fields ( W3FLDG )
178  ! ----------------------------------------------------
179  !
180  ! 9. Switches :
181  !
182  ! !/WNT0 = !/WNT1
183  ! !/WNT1 Correct wind speeds to (approximately) conserve the wind
184  ! speed over the interpolation box.
185  ! !/WNT2 Id. energy (USE ONLY ONE !)
186  ! !/CRT1 Like !/WNT1 for currents.
187  ! !/CRT2 Like !/WNT2 for currents.
188  !
189  ! !/O3 Additional output in fields processing loop.
190  ! !/O15 Generate file with the times of the processed fields.
191  !
192  ! !/S Enable subroutine tracing.
193  ! !/T Enable test output,
194  ! !/T1 Full interpolation data.
195  ! !/T1a Echo of lat-long data in type Fn
196  ! !/T2 Full input data.
197  ! !/T3 Print-plot of output data.
198  !
199  ! !/NCO NCEP NCO modifications for operational implementation.
200  !
201  ! 10. Source code :
202  !
203  !/ ------------------------------------------------------------------- /
204  USE constants
205  !/
206  ! USE W3GDATMD, ONLY: W3NMOD, W3SETG
207 #ifdef W3_NL1
208  USE w3adatmd,ONLY: w3naux, w3seta
209 #endif
210  USE w3odatmd, ONLY: w3nout, w3seto
211  USE w3servmd, ONLY : itrace, nextln, extcde
212 #ifdef W3_S
213  USE w3servmd, ONLY : strace
214 #endif
215  USE w3timemd, ONLY : stme21
216  USE w3arrymd, ONLY : ina2r, ina2i
217 #ifdef W3_T2
218  USE w3arrymd, ONLY : prtblk
219 #endif
220 #ifdef W3_T3
221  USE w3arrymd, ONLY : prtblk
222 #endif
223  USE w3iogrmd, ONLY: w3iogr
224  USE w3fldsmd, ONLY: w3fldo, w3fldp, w3fldg, w3fldd
225  !/
226  USE w3gdatmd
227  USE w3gsrumd
228  USE w3odatmd, ONLY: ndse, ndst, ndso, fnmpre
229  !
230  IMPLICIT NONE
231  !/
232  !/ ------------------------------------------------------------------- /
233  !/ Local parameters
234  !/
235  INTEGER :: ndsi, ndsm, ndsdat, ndstrc, ntrace, &
236  ierr, ifld, itype, j, ix, iy, nfcomp,&
237  time(2), nxi, nyi, nxj(2), nyj(2), &
238  ndsll, idlall, idfmll, ndsf(2), &
239  idlaf(2), idfmf(2), time2(2), &
240  mxm, mym, dattyp, recldt, idat, &
241  ndat, jj, is(4), js(4)
242  INTEGER :: nxt, nyt
243  INTEGER :: iland = -999
244 #ifdef W3_O15
245  INTEGER :: ndstime
246 #endif
247  INTEGER, ALLOCATABLE :: ix21(:,:), ix22(:,:), &
248  iy21(:,:), iy22(:,:), &
249  jx21(:,:), jx22(:,:), &
250  jy21(:,:), jy22(:,:), mapovr(:,:)
251  INTEGER, ALLOCATABLE :: mask(:,:)
252  TYPE(t_gsu) :: gsi
253 #ifdef W3_S
254  INTEGER, SAVE :: ient = 0
255 #endif
256 #ifdef W3_T2
257  INTEGER :: ixp0, ixpn, ixpwdt = 60
258 #endif
259 #ifdef W3_T3
260  INTEGER :: ix0, ixn, ixwdt = 60
261  INTEGER, ALLOCATABLE :: mapout(:,:)
262 #endif
263  REAL :: x0i, xni, y0i, yni, sxi, syi, &
264  x, y, factor, efac, nodata, rw(4)
265  REAL :: acc = 0.05
266  REAL, ALLOCATABLE :: rd11(:,:), rd21(:,:), &
267  rd12(:,:), rd22(:,:), &
268  xd11(:,:), xd21(:,:), &
269  xd12(:,:), xd22(:,:), &
270  fx(:,:), fy(:,:), fa(:,:), &
271  a1(:,:), a2(:,:), a3(:,:)
272  REAL, POINTER :: ala(:,:), alo(:,:)
273  REAL, ALLOCATABLE :: xc(:,:), yc(:,:), ac(:,:), data(:,:)
274  LOGICAL :: ingrid
275  LOGICAL :: flstab, flberg, clo(2), fltime, flhdr
276  INTEGER :: iclo
277 #ifdef W3_T
278  LOGICAL :: flmod
279 #endif
280  CHARACTER :: comstr*1, idfld*3, idtype*2, &
281  idtime*23, fromll*4, formll*16, &
282  namell*65, fromf*4, namef*65
283  CHARACTER(LEN=12) :: idstr1(-7:7)
284  CHARACTER(LEN=15) :: idstr3(3)
285  CHARACTER(LEN=32) :: formt(2), formf(2)
286  CHARACTER(LEN=20) :: idstr2(5)
287  CHARACTER(LEN=13) :: tstr, idstr = 'WAVEWATCH III'
288  CHARACTER(LEN=3) :: tsfld
289  INTEGER :: gtypedum = 0
290  !
291  equivalence( nxi , nxj(1) ) , ( nyi , nyj(1) )
292  !/
293  !/ ------------------------------------------------------------------- /
294  !/
295  ! notes: Is it possible to combine ice parameters into one group,
296  ! similar to the way 1D spectra are in one group?
297  DATA idstr1 / 'ice param. 1' , 'ice param. 2' , &
298  'ice param. 3' , 'ice param. 4' , &
299  'ice param. 5' , 'mud density ' , &
300  'mud thkness ' , 'mud viscos. ' , &
301  'ice ' , 'water levels' , &
302  'winds ' , 'currents ' , &
303  'data ' , 'momentum ' , &
304  'air density ' /
305  DATA idstr2 / 'pre-processed file ' , 'long.-lat. grid ' , &
306  'grid from file (1) ' , 'grid from file (2) ' , &
307  'data (assimilation) ' /
308  DATA idstr3 / 'mean parameters', '1D spectra ', &
309  '2D spectra ' /
310  NULLIFY ( ala, alo )
311  !
312 #ifdef W3_NCO
313  ! CALL W3TAGB('WAVEPREP',1998,0007,0050,'NP21 ')
314 #endif
315  !
316  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
317  ! 1.a Set number of models
318  !
319  CALL w3nmod ( 1, 6, 6 )
320  CALL w3setg ( 1, 6, 6 )
321 #ifdef W3_NL1
322  CALL w3naux ( 6, 6 )
323  CALL w3seta ( 1, 6, 6 )
324 #endif
325  CALL w3nout ( 6, 6 )
326  CALL w3seto ( 1, 6, 6 )
327  !
328  ! 1.b IO set-up.
329  !
330  ndsi = 10
331  ndso = 6
332  ndse = 6
333  ndst = 6
334  ndsm = 11
335  ndsdat = 12
336 #ifdef W3_O15
337  ndstime = 13
338 #endif
339  !
340  ndstrc = 6
341  ntrace = 10
342  CALL itrace ( ndstrc, ntrace )
343  !
344 #ifdef W3_NCO
345  !
346  ! Redo according to NCO
347  !
348  ndsi = 11
349  ndso = 6
350  ndse = ndso
351  ndst = ndso
352  ndsm = 12
353  ndsdat = 51
354  ndstrc = ndso
355 #endif
356  !
357  ! 1.c Print header
358  !
359  WRITE (ndso,900)
360 #ifdef W3_S
361  CALL strace (ient, 'W3PREP')
362 #endif
363  !
364  j = len_trim(fnmpre)
365  OPEN (ndsi,file=fnmpre(:j)//'ww3_prep.inp',status='OLD', &
366  err=800,iostat=ierr)
367  rewind(ndsi)
368  READ (ndsi,'(A)',END=801,ERR=802,IOSTAT=IERR) comstr
369  IF (comstr.EQ.' ') comstr = '$'
370  WRITE (ndso,901) comstr
371  !
372  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
373  ! 2. Read model definition file.
374  !
375  CALL w3iogr ( 'READ', ndsm )
376  WRITE (ndso,902) gname
377  ALLOCATE ( ix21(nx,ny), ix22(nx,ny), iy21(nx,ny), iy22(nx,ny), &
378  jx21(nx,ny), jx22(nx,ny), jy21(nx,ny), jy22(nx,ny), &
379  mapovr(nx,ny) )
380  ALLOCATE ( rd11(nx,ny), rd21(nx,ny), rd12(nx,ny), rd22(nx,ny), &
381  xd11(nx,ny), xd21(nx,ny), xd12(nx,ny), xd22(nx,ny), &
382  fx(nx,ny), fy(nx,ny), fa(nx,ny), &
383  a1(nx,ny), a2(nx,ny), a3(nx,ny) )
384  !
385  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
386  ! 3.a Read types from input file.
387  !
388  CALL nextln ( comstr , ndsi , ndse )
389  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) IDFLD, IDTYPE, FLTIME, &
390  flhdr
391  !
392  ! 3.b Check types.
393  !
394  flstab = idfld .EQ. 'WNS'
395  flberg = idfld .EQ. 'ISI'
396  IF ( idfld.EQ.'IC1' ) THEN
397  ifld = -7
398  ELSE IF ( idfld.EQ.'IC2' ) THEN
399  ifld = -6
400  ELSE IF ( idfld.EQ.'IC3' ) THEN
401  ifld = -5
402  ELSE IF ( idfld.EQ.'IC4' ) THEN
403  ifld = -4
404  ELSE IF ( idfld.EQ.'IC5' ) THEN
405  ifld = -3
406  ELSE IF ( idfld.EQ.'MDN' ) THEN
407  ifld = -2
408  ELSE IF ( idfld.EQ.'MTH' ) THEN
409  ifld = -1
410  ELSE IF ( idfld.EQ.'MVS' ) THEN
411  ifld = 0
412  ELSE IF ( idfld.EQ.'ICE' .OR. flberg ) THEN
413  ifld = 1
414  ELSE IF ( idfld.EQ.'LEV' ) THEN
415  ifld = 2
416  ELSE IF ( idfld.EQ.'WND' .OR. flstab ) THEN
417  ifld = 3
418  ELSE IF ( idfld.EQ.'CUR' ) THEN
419  ifld = 4
420  ELSE IF ( idfld.EQ.'DAT' ) THEN
421  ifld = 5
422  ELSE IF ( idfld.EQ.'TAU' ) THEN
423  ifld = 6
424  ELSE IF ( idfld.EQ.'RHO' ) THEN
425  ifld = 7
426  ELSE
427  WRITE (ndse,1030) idfld
428  CALL extcde ( 1 )
429  END IF
430  !
431  nfcomp = 1
432  IF (idfld.EQ.'DAT') THEN
433  itype = 5
434  ELSE IF (idtype.EQ.'AI') THEN
435  itype = 1
436  ELSE IF (idtype.EQ.'LL') THEN
437  itype = 2
438  ELSE IF (idtype.EQ.'F1') THEN
439  itype = 3
440  ELSE IF (idtype.EQ.'F2') THEN
441  itype = 4
442  nfcomp = 2
443  ELSE
444  WRITE (ndse,1031) idtype
445  CALL extcde ( 2 )
446  END IF
447  !
448 #ifdef W3_T
449  IF (itype.NE.1 .AND. itype.NE.5) WRITE (ndst,9000) acc
450 #endif
451  !
452  WRITE (ndso,930) idstr1(ifld), idstr2(itype)
453  IF ( itype.NE.1 ) THEN
454 #ifdef W3_WNT0
455  IF (ifld.EQ.3) WRITE (ndso,1930)
456 #endif
457 #ifdef W3_WNT1
458  IF (ifld.EQ.3) WRITE (ndso,1930)
459 #endif
460 #ifdef W3_WNT2
461  IF (ifld.EQ.3) WRITE (ndso,2930)
462 #endif
463 #ifdef W3_CRT1
464  IF (ifld.EQ.4) WRITE (ndso,1930)
465 #endif
466 #ifdef W3_CRT2
467  IF (ifld.EQ.4) WRITE (ndso,2930)
468 #endif
469 #ifdef W3_WNT0
470  IF (ifld.EQ.6) WRITE (ndso,1930)
471 #endif
472 #ifdef W3_WNT1
473  IF (ifld.EQ.6) WRITE (ndso,1930)
474 #endif
475 #ifdef W3_WNT2
476  IF (ifld.EQ.6) WRITE (ndso,2930)
477 #endif
478  END IF
479  IF ( flberg ) WRITE (ndso,938)
480  IF ( flstab ) WRITE (ndso,939)
481  IF (itype.EQ.4 .AND. ifld.GT.2) THEN
482  WRITE (ndse,1032)
483  CALL extcde ( 3 )
484  END IF
485  !
486  ! 3.c Additional input for format types and time
487  ! ... time
488  !
489  IF (.NOT. fltime) THEN
490  CALL nextln ( comstr , ndsi , ndse )
491  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) time
492  IF (time(1).LT.10000000) THEN
493  WRITE (ndse,1035) time
494  CALL extcde ( 4 )
495  END IF
496  CALL stme21 ( time , idtime )
497  WRITE (ndso,931) idtime
498  END IF
499  !
500  j = 1
501  IF ( flagll ) THEN
502  factor = 1.
503  ELSE
504  factor = 1.e-3
505  END IF
506  !
507  ! ... type 1
508  !
509  IF (itype.EQ.1) THEN
510  !
511  nxi = nx
512  nyi = ny
513  ALLOCATE ( mask(nxi,nyi) )
514  mask = 1
515  IF(gtype .EQ. ungtype) THEN
516  !
517  ! X0, Y0 are the coordinates of the lower-left point in mesh
518  !
519  rw(1) = factor*x0 ; rw(2) = factor*maxx
520  rw(3) = factor*y0 ; rw(4) = factor*maxy
521  ELSE
522  rw(1) = factor*xgrd(1,1) ; rw(2) = factor*xgrd(ny,nx)
523  rw(3) = factor*ygrd(1,1) ; rw(4) = factor*ygrd(ny,nx)
524  END IF
525  WRITE (ndso,932) nxi, nyi
526  IF ( flagll ) THEN
527  WRITE (ndso,933) rw(1),rw(2),rw(3),rw(4)
528  ELSE
529  WRITE (ndso,733) rw(1),rw(2),rw(3),rw(4)
530  END IF
531  !
532  ! ... type 2
533  !
534  ELSE IF (itype.EQ.2) THEN
535  !
536  CALL nextln ( comstr , ndsi , ndse )
537  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
538  x0i, xni, nxi, y0i, yni, nyi
539  IF (nxi.LT.2 .OR. nyi.LT.2) THEN
540  WRITE (ndse,1036) nxi, nyi
541  CALL extcde ( 5 )
542  END IF
543  ALLOCATE ( mask(nxi,nyi) )
544  mask = 1
545  WRITE (ndso,932) nxi, nyi
546 
547  IF ( flagll ) THEN
548  WRITE (ndso,933) factor*x0i, factor*xni, &
549  factor*y0i, factor*yni
550  ELSE
551  WRITE (ndso,733) factor*x0i, factor*xni, &
552  factor*y0i, factor*yni
553  END IF
554  !
555  ! ... type 5
556  !
557  ELSE IF (itype.EQ.5) THEN
558  CALL nextln ( comstr , ndsi , ndse )
559  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
560  dattyp, recldt, nodata
561  IF (dattyp.LT.0 .OR. dattyp.GT.2) THEN
562  WRITE (ndse,1033) dattyp
563  CALL extcde ( 6 )
564  END IF
565  IF (recldt.LE.0) THEN
566  WRITE (ndse,1034) recldt
567  CALL extcde ( 7 )
568  END IF
569  WRITE (ndso,934) idstr3(dattyp+1), recldt, nodata
570  WRITE (idfld,935) dattyp
571  DEALLOCATE ( ix21, ix22, iy21, iy22, jx21, jx22, jy21, jy22, &
572  mapovr )
573  DEALLOCATE ( rd11, rd21, rd12, rd22, xd11, xd21, xd12, xd22, &
574  fx, fy, fa, a1, a2, a3 )
575  !
576  ! ... types 3 and 4 ... in preprocessing loop ....
577  !
578  END IF
579  !
580  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
581  ! 4 Prepare interpolation.
582  !
583  WRITE (ndso,940)
584  !
585  IF (itype.NE.1 .AND. itype.NE.5) THEN
586  !
587  ! 4.a Longitude - latitude grid
588  !
589  IF (itype.EQ.2) THEN
590  WRITE (ndso,941)
591  !
592  ! ... setup coordinates
593  !
594  sxi = (xni-x0i)/real(nxi-1)
595  syi = (yni-y0i)/real(nyi-1)
596  iclo = iclose_none
597  IF ( flagll ) THEN
598  IF ( abs(abs(real(nxi)*sxi)-360.) .LT. 0.1*abs(sxi) ) &
599  iclo = iclose_smpl
600  END IF
601  IF ( ASSOCIATED(ala) ) THEN
602  DEALLOCATE ( ala, alo )
603  NULLIFY ( ala, alo )
604  END IF
605  ALLOCATE ( ala(nxi,nyi), alo(nxi,nyi) )
606  DO iy=1, nyi
607  DO ix=1, nxi
608  alo(ix,iy) = x0i + real(ix-1)*sxi
609  ala(ix,iy) = y0i + real(iy-1)*syi
610  END DO
611  END DO
612  !
613  ! ... create grid search utility
614  !
615  gsi = w3gsuc( .true., flagll, iclo, alo, ala )
616  !
617  ! ... construct interpolation data
618  !
619 #ifdef W3_T1
620  WRITE (ndst,9045)
621 #endif
622  IF (gtype .NE. ungtype) THEN
623  DO iy=1,ny
624  DO ix=1,nx
625  ingrid = w3grmp( gsi, real(xgrd(iy,ix)), real(ygrd(iy,ix)), &
626  is, js, rw )
627 
628  IF ( .NOT.ingrid ) THEN
629 
630  ! Notes: It would make sense to give this warning for only cases where
631  ! the grid point is *not* masked. Obviously we don't care if
632  ! a masked grid point is not given winds, etc.
633 
634  WRITE(ndso,1042) ix, iy, xgrd(iy,ix), ygrd(iy,ix)
635 
636  ! Notes: We need to set these variables, even if we never intend to use them.
637  !...........Especially in the case of IX?? IY??, we cannot leave them unset,
638  !...........since they will be used as array indices later.
639 
640  ix21(ix,iy) = 1
641  ix22(ix,iy) = 1
642  iy21(ix,iy) = 1
643  iy22(ix,iy) = 1
644  rd11(ix,iy) = 0.0
645  rd21(ix,iy) = 0.0
646  rd12(ix,iy) = 0.0
647  rd22(ix,iy) = 0.0
648 
649  cycle
650  END IF
651 
652  ix21(ix,iy) = is(1)
653  ix22(ix,iy) = is(2)
654  iy21(ix,iy) = js(1)
655  iy22(ix,iy) = js(4)
656  rd11(ix,iy) = rw(1)
657  rd21(ix,iy) = rw(2)
658  rd12(ix,iy) = rw(4)
659  rd22(ix,iy) = rw(3)
660 #ifdef W3_T1
661  WRITE (ndst,9046) ix, iy, &
662  ix21(ix,iy),ix22(ix,iy),iy21(ix,iy),iy22(ix,iy), &
663  rd11(ix,iy),rd12(ix,iy),rd21(ix,iy),rd22(ix,iy)
664 #endif
665  END DO
666  END DO
667  ELSE
668  DO ix=1, nx
669  x = xgrd(1,ix)
670  y = ygrd(1,ix)
671 
672  ix21(ix,1) = 1 + int(mod(360.+(x-x0i),360.)/sxi)
673  !
674  ! Manages the simple closure of the grid
675  !
676  IF (iclo.EQ.iclose_none) THEN
677  ix21(ix,1) = max( 1 , min(ix21(ix,1),nxi-1) )
678  ix22(ix,1) = ix21(ix,1) + 1
679  ELSE
680  ix21(ix,1) = max( 1 , min(ix21(ix,1),nxi) )
681  ix22(ix,1) = mod(ix21(ix,1),nxi)+1
682  END IF
683  iy21(ix,1) = 1 + int((y-y0i)/syi)
684  iy21(ix,1) = max( 1 , min(iy21(ix,1),nyi-1) )
685  iy22(ix,1) = iy21(ix,1) + 1
686  !
687  rw(1) = mod(360.+(x-x0i),360.)/sxi - real(ix21(ix,1)-1)
688  rw(2) = (y-y0i)/syi - real(iy21(ix,1)-1)
689  !
690  IF (iy21(ix,1).EQ.1 .AND. rw(2).LT.acc) THEN
691  IF (rw(2).LT.-acc) THEN
692  WRITE (ndso,1044) y
693  ELSE IF (rw(2).LT.0.) THEN
694  rw(2) = 0.
695 #ifdef W3_T
696  flmod = .true.
697 #endif
698  END IF
699  END IF
700  !
701  IF (iy21(ix,1).EQ.nyi .AND. rw(2).GT.1.-acc) THEN
702  IF (rw(2).GT.1.+acc) THEN
703  WRITE (ndso,1044) y
704  ELSE IF (rw(2).GT.1.) THEN
705  rw(2) = 1.
706 #ifdef W3_T
707  flmod = .true.
708 #endif
709  END IF
710  END IF
711  !
712  efac = sqrt( max(0.,abs(rw(1)-0.5)-0.5)**2 + &
713  max(0.,abs(rw(2)-0.5)-0.5)**2 )
714  efac = 1. / ( 1. + 0.25*efac**2 )
715 
716 
717  rd11(ix,1) = efac * (1.-rw(1)) * (1.-rw(2))
718  rd21(ix,1) = efac * rw(1) * (1.-rw(2))
719  rd12(ix,1) = efac * (1.-rw(1)) * rw(2)
720  rd22(ix,1) = efac * rw(1) * rw(2)
721  END DO
722  END IF ! GTYPE .NE. UNGTYPE
723  !
724  CALL w3gsud( gsi )
725  DEALLOCATE ( ala, alo )
726  NULLIFY ( ala, alo )
727  !
728  ! 4.b Grid(s) from file
729  !
730  ELSE
731  WRITE (ndso,942)
732  !
733  ! ... prepare overlay map
734  !
735  DO iy=1, ny
736  DO ix=1, nx
737  IF ( mapsta(iy,ix) .EQ. 0 ) THEN
738  mapovr(ix,iy) = iland
739  ELSE
740  mapovr(ix,iy) = 0
741  END IF
742  END DO
743  END DO
744  !
745  ! ... loop over fields
746  !
747  DO j=1, nfcomp
748  !
749  WRITE (ndso,943) j
750  !
751  ! ... file info lat-long file
752  !
753  CALL nextln ( comstr , ndsi , ndse )
754  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
755  nxj(j), nyj(j), clo(j)
756  IF (nxj(j).LT.2 .OR. nyj(j).LT.2) THEN
757  WRITE (ndse,1036) nxj(j), nyj(j)
758  CALL extcde ( 10 )
759  END IF
760  IF ( ALLOCATED(mask) ) DEALLOCATE (mask)
761  ALLOCATE ( mask(nxj(j),nyj(j)) )
762  mask = 1
763  WRITE (ndso,944) nxj(j), nyj(j), clo(j)
764  !
765  CALL nextln ( comstr , ndsi , ndse )
766  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
767  fromll, idlall, idfmll, formll
768  IF (idlall.LT.1 .OR. idlall.GT.4) idlall = 1
769  IF (idfmll.LT.1 .OR. idfmll.GT.3) idfmll = 1
770  WRITE (ndso,945) idlall, idfmll
771  IF (idfmll.EQ.2) WRITE (ndso,946) formll
772  !
773  CALL nextln ( comstr , ndsi , ndse )
774  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, namell
775 #ifdef W3_NCO
776  ndsll = 20 + nfcomp
777 #endif
778  WRITE (ndso,947) ndsll
779  IF (fromll.EQ.'NAME') WRITE (ndso,948) namell
780  IF (ndsll.EQ.ndsi) THEN
781  WRITE (ndse,10381)
782  CALL nextln ( comstr , ndsi , ndse )
783  ELSE
784  !
785  ! ... open lat-long file
786  !
787  IF ( idfmll .EQ. 3 ) THEN
788  IF (fromll.EQ.'NAME') THEN
789  jj = len_trim(fnmpre)
790  OPEN (ndsll,file=fnmpre(:jj)//namell, &
791  form='UNFORMATTED', convert=file_endian,status='OLD', &
792  err=845,iostat=ierr)
793  ELSE
794  OPEN (ndsll, form='UNFORMATTED', convert=file_endian, &
795  status='OLD',err=845,iostat=ierr)
796  END IF
797  ELSE
798  IF (fromll.EQ.'NAME') THEN
799  jj = len_trim(fnmpre)
800  OPEN (ndsll,file=fnmpre(:jj)//namell, &
801  status='OLD',err=845,iostat=ierr)
802  ELSE
803  OPEN (ndsll, &
804  status='OLD',err=845,iostat=ierr)
805  END IF
806  END IF
807  !
808  END IF
809  !
810  ! ... read lat-lon data
811  !
812  IF ( ASSOCIATED(ala) ) THEN
813  DEALLOCATE ( ala, alo )
814  NULLIFY ( ala, alo )
815  END IF
816  ALLOCATE ( ala(nxj(j),nyj(j)), alo(nxj(j),nyj(j)) )
817  CALL ina2r (ala, nxj(j), nyj(j), 1, nxj(j), 1, nyj(j),&
818  ndsll, ndst, ndse, idfmll, formll, idlall, 1., 0.)
819  CALL ina2r (alo, nxj(j), nyj(j), 1, nxj(j), 1, nyj(j),&
820  ndsll, ndst, ndse, idfmll, formll, idlall, 1., 0.)
821  IF ( ndsll .NE. ndsi ) CLOSE (ndsll)
822  !
823  ! ... file info mask file
824  !
825  WRITE (ndso,949)
826  !
827  CALL nextln ( comstr , ndsi , ndse )
828  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
829  fromll, idlall, idfmll, formll
830  IF (idlall.LT.1 .OR. idlall.GT.4) idlall = 1
831  IF (idfmll.LT.1 .OR. idfmll.GT.3) idfmll = 1
832  WRITE (ndso,945) idlall, idfmll
833  IF (idfmll.EQ.2) WRITE (ndso,946) formll
834  !
835  CALL nextln ( comstr , ndsi , ndse )
836  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, namell
837 #ifdef W3_NCO
838  ndsll = 22 + nfcomp
839 #endif
840  WRITE (ndso,947) ndsll
841  IF (fromll.EQ.'NAME') WRITE (ndso,948) namell
842  WRITE (ndso,*) ' '
843  IF (ndsll.EQ.ndsi) THEN
844  WRITE (ndse,10382)
845  CALL nextln ( comstr , ndsi , ndse )
846  ELSE
847  !
848  ! ... open mask file
849  !
850  IF ( idfmll .EQ. 3 ) THEN
851  IF (fromll.EQ.'NAME') THEN
852  jj = len_trim(fnmpre)
853  OPEN (ndsll,file=fnmpre(:jj)//namell, &
854  form='UNFORMATTED', convert=file_endian,status='OLD', &
855  err=846,iostat=ierr)
856  ELSE
857  OPEN (ndsll,form='UNFORMATTED', convert=file_endian, &
858  status='OLD',err=846,iostat=ierr)
859  END IF
860  ELSE
861  IF (fromll.EQ.'NAME') THEN
862  jj = len_trim(fnmpre)
863  OPEN (ndsll,file=fnmpre(:jj)//namell, &
864  status='OLD',err=846,iostat=ierr)
865  ELSE
866  OPEN (ndsll, &
867  status='OLD',err=846,iostat=ierr)
868  END IF
869  END IF
870  !
871  END IF
872  !
873  ! ... read mask data
874  !
875  CALL ina2i (mask, nxj(j), nyj(j), 1,nxj(j), 1,nyj(j), &
876  ndsll, ndst, ndse, idfmll, formll, idlall, 1, 0)
877  IF ( ndsll .NE. ndsi ) CLOSE (ndsll)
878  !
879 #ifdef W3_T1a
880  WRITE (ndst,9050)
881  DO iy=1, nyj(j)
882  DO ix=1,nxj(j)
883  WRITE (ndst,9051) ix, iy, ala(ix,iy), &
884  alo(ix,iy), mask(ix,iy)
885  END DO
886  END DO
887 #endif
888  !
889  ! ... generate interpolation data
890  !
891  IF ( j .EQ. 1 ) THEN
892  CALL w3fldp ( ndso, ndst, ndse, ierr, flagll, &
893  nx, ny, nx, ny, real(ygrd), real(xgrd), mapovr, iland, &
894  nxj(j), nyj(j), nxj(j), nyj(j), clo(j), ala, alo, &
895  mask, rd11, rd21, rd12, rd22, ix21, ix22, iy21, &
896  iy22 )
897  ELSE
898  CALL w3fldp ( ndso, ndst, ndse, ierr, flagll, &
899  nx, ny, nx, ny, real(ygrd), real(xgrd), mapovr, iland, &
900  nxj(j), nyj(j), nxj(j), nyj(j), clo(j), ala, alo, &
901  mask, xd11, xd21, xd12, xd22, jx21, jx22, jy21, &
902  jy22 )
903  END IF
904  !
905  END DO
906  !
907  ! ... average two fields !
908  !
909  IF ( nfcomp .EQ. 2) THEN
910  DO ix=1, nx
911  DO iy=1, ny
912  IF ( mapovr(ix,iy) .GE. 2) THEN
913  factor = 1. / real(mapovr(ix,iy))
914  rd11(ix,iy) = factor * rd11(ix,iy)
915  rd12(ix,iy) = factor * rd12(ix,iy)
916  rd21(ix,iy) = factor * rd21(ix,iy)
917  rd22(ix,iy) = factor * rd22(ix,iy)
918  xd11(ix,iy) = factor * xd11(ix,iy)
919  xd12(ix,iy) = factor * xd12(ix,iy)
920  xd21(ix,iy) = factor * xd21(ix,iy)
921  xd22(ix,iy) = factor * xd22(ix,iy)
922  END IF
923  END DO
924  END DO
925  END IF
926  !
927  END IF
928  END IF
929  !
930  ! 4.c Input location and format
931  !
932  DO j=1, nfcomp
933  !
934  IF ( itype .GE. 5 ) THEN
935  WRITE (ndso,960)
936  ELSE
937  IF (itype.LE.3) THEN
938  WRITE (ndso,961) nxj(j), nyj(j)
939  ELSE
940  WRITE (ndso,962) j, nxj(j), nyj(j)
941  END IF
942  END IF
943  !
944  CALL nextln ( comstr , ndsi , ndse )
945  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
946  fromf, idlaf(j), idfmf(j), formt(j), formf(j)
947  IF (idlaf(j).LT.1 .OR. idlaf(j).GT.4) idlaf(j) = 1
948  IF (idfmf(j).LT.1 .OR. idfmf(j).GT.3) idfmf(j) = 1
949  IF ( itype .NE. 5 ) WRITE (ndso,963) idlaf(j)
950  WRITE (ndso,964) idfmf(j)
951  IF (idfmf(j).EQ.2) WRITE (ndso,965) formt(j), formf(j)
952  !
953  CALL nextln ( comstr , ndsi , ndse )
954  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) NDSF(J), namef
955 #ifdef W3_NCO
956  ndsf(j) = 24 + nfcomp
957 #endif
958  WRITE (ndso,966) ndsf(j)
959  IF (fromf.EQ.'NAME') WRITE (ndso,967) namef
960  !
961  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
962  ! 5 Prepare files
963  ! 5.a Open input file
964  !
965  WRITE (ndso,970)
966  !
967  IF ( idfmf(j) .EQ. 3 ) THEN
968  IF (ndsf(j).EQ.ndsi) THEN
969  WRITE (ndse,1051) ndsi
970  CALL extcde ( 20 )
971  ELSE
972  IF (fromf.EQ.'NAME') THEN
973  jj = len_trim(fnmpre)
974  OPEN (ndsf(j),file=fnmpre(:jj)//namef, &
975  form='UNFORMATTED', convert=file_endian,status='OLD',err=850, &
976  iostat=ierr)
977  ELSE
978  OPEN (ndsf(j),form='UNFORMATTED', convert=file_endian, &
979  status='OLD',err=850,iostat=ierr)
980  END IF
981  !
982  ! Adding a check to see if input file is a WAVEWATCH III file
983  ! (This check has only been added for binary wind files)
984  !
985  READ (ndsf(j),END=888,IOSTAT=IERR) TSTR, &
986  tsfld, nxt, nyt
987  IF (ierr .EQ. 0 .AND. tstr .EQ. idstr) THEN
988  IF (tsfld .NE. idfld .OR. nxt .NE. nxi &
989  .OR. nyt .NE. nyi ) THEN
990  WRITE (ndse,1052) tsfld, nxt, nyt, idfld, &
991  nxi, nyi
992  CALL extcde ( 21 )
993  END IF
994  ELSE
995  rewind(ndsf(j))
996  END IF
997  END IF
998  ELSE
999  IF (ndsf(j).EQ.ndsi) THEN
1000  CALL nextln ( comstr , ndsi , ndse )
1001  ELSE
1002  IF (fromf.EQ.'NAME') THEN
1003  jj = len_trim(fnmpre)
1004  OPEN (ndsf(j),file=fnmpre(:jj)//namef, &
1005  status='OLD',err=850,iostat=ierr)
1006  ELSE
1007  OPEN (ndsf(j),status='OLD',err=850,iostat=ierr)
1008  END IF
1009  END IF
1010  END IF
1011  !
1012  END DO
1013  !
1014  IF ( nfcomp .EQ. 1 ) THEN
1015  nxj(2) = nxj(1)
1016  nyj(2) = nyj(1)
1017  ndsf(2) = ndsf(1)
1018  idlaf(2) = idlaf(1)
1019  idfmf(2) = idfmf(1)
1020  formt(2) = formt(1)
1021  formf(2) = formf(1)
1022  END IF
1023  !
1024  ! 5.b Open and prepare output file
1025  !
1026  WRITE (ndso,971)
1027  j = len_trim(fnmpre)
1028  IF ( itype .LE. 4 ) THEN
1029  CALL w3fldo ( 'WRITE', idfld, ndsdat, ndst, ndse, &
1030  nx, ny, gtype, ierr, fpre=fnmpre(:j), &
1031  fhdr=flhdr )
1032  ELSE
1033  CALL w3fldo ( 'WRITE', idfld, ndsdat, ndst, ndse, &
1034  recldt, 0, gtypedum, ierr, fpre=fnmpre(:j) )
1035  END IF
1036  !
1037  ! 5.c Initialize fields
1038  !
1039  IF ( itype .NE. 5 ) THEN
1040  fx = 0.
1041  fy = 0.
1042  fa = 0.
1043  mxm = max( nxj(1), nxj(2) )
1044  mym = max( nyj(1), nyj(2) )
1045  ALLOCATE ( xc(mxm,mym), yc(mxm,mym), ac(mxm,mym) )
1046  xc = 0.
1047  yc = 0.
1048  ac = 0.
1049  END IF
1050  !
1051  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1052  ! 6 Begin loop over input fields
1053  !
1054 #ifdef W3_O15
1055  j = len_trim(fnmpre)
1056  OPEN (ndstime,file=fnmpre(:j)//'times.'//idfld, &
1057  err=870,iostat=ierr )
1058 #endif
1059  !
1060  WRITE (ndso,972)
1061  DO
1062  !
1063  ! 6.a Read new time and fields
1064  !
1065  IF ( fltime ) THEN
1066  !
1067  j = 1
1068  IF (idfmf(j).EQ.1) THEN
1069  READ (ndsf(j), * ,END=888,ERR=860,IOSTAT=IERR) time
1070  ELSE IF (idfmf(j).EQ.2) THEN
1071  READ (ndsf(j),formt(j),END=888,ERR=860,IOSTAT=IERR) time
1072  ELSE
1073  READ (ndsf(j), END=888,ERR=860,IOSTAT=IERR) time
1074  END IF
1075  ! <---
1076  IF (nfcomp.EQ.2) THEN
1077  j = 2
1078  IF (idfmf(j).EQ.1) THEN
1079  READ (ndsf(j), * ,END=888,ERR=860,IOSTAT=IERR) time2
1080  ELSE IF (idfmf(j).EQ.2) THEN
1081  READ (ndsf(j),formt(j),END=888,ERR=860,IOSTAT=IERR) time2
1082  ELSE
1083  READ (ndsf(j), END=888,ERR=860,IOSTAT=IERR) time2
1084  END IF
1085  IF (time2(1).NE.time(1) .OR. time2(2).NE.time(2)) GOTO 861
1086  END IF
1087  ! <---
1088  END IF
1089  !
1090  CALL stme21 ( time , idtime )
1091  WRITE (ndso,973) idtime
1092 #ifdef W3_O15
1093  WRITE (ndstime, 979, err=871,iostat=ierr) time
1094 #endif
1095 #ifdef W3_O3
1096  WRITE (ndso,974)
1097 #endif
1098  !
1099  ! ... Input
1100  !
1101  ! read in array from ww3_prep.inp
1102  IF ( itype .LE. 4 ) THEN
1103  CALL ina2r (xc, mxm, mym, 1, nxj(1), 1, nyj(1), &
1104  ndsf(1), ndst, ndse, idfmf(1), formf(1), idlaf(1), 1., 0.)
1105  !
1106 #ifdef W3_T2
1107  WRITE (ndst,9060) 1
1108  ixp0 = 1
1109  ixpn = min( ixp0+ixpwdt-1 , nxj(1) )
1110  DO
1111  CALL prtblk ( ndst, nxj(1), nyj(1), mxm, xc, mask, 0, 0.,&
1112  ixp0, ixpn, 1, 1, nyj(1), 1, 'Field 1', ' ')
1113  IF (ixpn.NE.nxj(1)) THEN
1114  ixp0 = ixp0 + ixpwdt
1115  ixpn = min( ixpn+ixpwdt , nxj(1) )
1116  ELSE
1117  EXIT
1118  END IF
1119  END DO
1120 #endif
1121  !
1122  IF (nfcomp.EQ.2 .OR. ifld.GE.3 .OR. flberg) THEN
1123  CALL ina2r (yc, mxm, mym, 1, nxj(2), 1, nyj(2), &
1124  ndsf(2), ndst, ndse, idfmf(2), formf(2), &
1125  idlaf(2), 1., 0.)
1126  !
1127 #ifdef W3_T2
1128  WRITE (ndst,9060) 2
1129  ixp0 = 1
1130  ixpn = min( ixp0+ixpwdt-1 , nxj(2) )
1131  DO
1132  CALL prtblk ( ndst, nxj(2), nyj(2), mxm, yc, mask, 0, 0., &
1133  ixp0, ixpn, 1, 1, nyj(2), 1, 'Field 2', ' ')
1134  IF (ixpn.NE.nxj(2)) THEN
1135  ixp0 = ixp0 + ixpwdt
1136  ixpn = min( ixpn+ixpwdt , nxj(2) )
1137  ELSE
1138  EXIT
1139  END IF
1140  END DO
1141 #endif
1142  !
1143  IF ( flstab ) THEN
1144  CALL ina2r (ac, mxm, mym, 1, nxj(2), 1, nyj(2), &
1145  ndsf(2), ndst, ndse, idfmf(2), formf(2), &
1146  idlaf(2), 1., 0. )
1147  !
1148 #ifdef W3_T2
1149  WRITE (ndst,9060) 3
1150  ixp0 = 1
1151  ixpn = min( ixp0+ixpwdt-1 , nxj(2) )
1152  DO
1153  CALL prtblk ( ndst, nxj(2), nyj(2), mxm, ac, mask, 0,&
1154  0., ixp0, ixpn, 1,1, nyj(2), 1, 'Field 3', ' ')
1155  IF (ixpn.NE.nxj(2)) THEN
1156  ixp0 = ixp0 + ixpwdt
1157  ixpn = min( ixpn+ixpwdt , nxj(2) )
1158  ELSE
1159  EXIT
1160  END IF
1161  END DO
1162 #endif
1163  !
1164  END IF
1165  !
1166  END IF
1167  !
1168  ELSE
1169  !
1170  IF (idfmf(1).EQ.3) THEN
1171  READ (ndsf(1), END=862,ERR=862,IOSTAT=IERR) ndat
1172  ELSE
1173  READ (ndsf(1),*,END=862,ERR=862,IOSTAT=IERR) ndat
1174  END IF
1175 #ifdef W3_O3
1176  WRITE (ndso,975) ndat
1177 #endif
1178  IF ( ndat.GT.0 ) THEN
1179  ALLOCATE ( DATA(recldt,ndat) )
1180  DO idat=1, ndat
1181  IF (idfmf(1).EQ.1) THEN
1182  READ (ndsf(1), * ,END=863,ERR=863, &
1183  iostat=ierr) DATA(:,idat)
1184  ELSE IF (idfmf(1).EQ.2) THEN
1185  READ (ndsf(1),formt(1),END=863,ERR=863, &
1186  iostat=ierr) DATA(:,idat)
1187  ELSE
1188  READ (ndsf(1), END=863,ERR=863, &
1189  iostat=ierr) DATA(:,idat)
1190  END IF
1191  END DO
1192  END IF
1193  !
1194 #ifdef W3_T2
1195  WRITE (ndst,9061)
1196  DO idat=1, ndat
1197  ix = min(6,recldt)
1198  WRITE (ndst,9062) idat, DATA(1:ix,idat)
1199  IF ( ix.LT.recldt ) WRITE (ndst,9063) DATA(ix+1:,:)
1200  END DO
1201 #endif
1202  !
1203  END IF
1204  !
1205  ! 6.b Interpolate fields
1206  ! ... No interpolation, type AI (should not use array syntax !!!)
1207  !
1208  IF (itype.EQ.1) THEN
1209  !
1210  IF (( ifld.LE.2 ).AND.( .NOT. flberg )) THEN
1211  DO iy=1, ny
1212  DO ix=1, nx
1213  fa(ix,iy) = xc(ix,iy)
1214  END DO
1215  END DO
1216  ELSE
1217  DO iy=1, ny
1218  DO ix=1, nx
1219  fx(ix,iy) = xc(ix,iy)
1220  fy(ix,iy) = yc(ix,iy)
1221  fa(ix,iy) = ac(ix,iy)
1222  END DO
1223  END DO
1224  END IF
1225  !
1226  ELSE IF (itype.NE.5) THEN
1227  !
1228  ! ... One-component fields
1229  !
1230 #ifdef W3_O3
1231  WRITE (ndso,976) ' '
1232 #endif
1233  IF (( ifld.LE.2 ).AND.( .NOT. flberg )) THEN
1234  !
1235  DO iy=1,ny
1236  DO ix=1,nx
1237  fa(ix,iy) &
1238  = rd11(ix,iy) * xc(ix21(ix,iy),iy21(ix,iy)) &
1239  + rd21(ix,iy) * xc(ix22(ix,iy),iy21(ix,iy)) &
1240  + rd12(ix,iy) * xc(ix21(ix,iy),iy22(ix,iy)) &
1241  + rd22(ix,iy) * xc(ix22(ix,iy),iy22(ix,iy))
1242  END DO
1243  END DO
1244  !
1245  IF (nfcomp.EQ.2) THEN
1246 #ifdef W3_O3
1247  WRITE (ndso,976) ' (2) '
1248 #endif
1249  DO iy=1,ny
1250  DO ix=1,nx
1251  fa(ix,iy) = fa(ix,iy) &
1252  + xd11(ix,iy) * yc(jx21(ix,iy),jy21(ix,iy)) &
1253  + xd21(ix,iy) * yc(jx22(ix,iy),jy21(ix,iy)) &
1254  + xd12(ix,iy) * yc(jx21(ix,iy),jy22(ix,iy)) &
1255  + xd22(ix,iy) * yc(jx22(ix,iy),jy22(ix,iy))
1256  END DO
1257  END DO
1258  END IF
1259  !
1260  ! ... Two-component fields
1261  !
1262  ELSE
1263  !
1264  DO iy=1,ny
1265  DO ix=1,nx
1266  IF (iy21(ix,iy).LT.1) THEN
1267  iy21(ix,iy)=1
1268  ix21(ix,iy)=1
1269  ix22(ix,iy)=1
1270  ENDIF
1271  IF (iy22(ix,iy).LT.1) iy22(ix,iy)=1
1272  IF (iy21(ix,iy).GT.mym) iy21(ix,iy)=mym
1273  IF (iy22(ix,iy).GT.mym) THEN
1274  iy22(ix,iy)=mym
1275  ix21(ix,iy)=1
1276  ix22(ix,iy)=1
1277  END IF
1278  fx(ix,iy) &
1279  = rd11(ix,iy) * xc(ix21(ix,iy),iy21(ix,iy)) &
1280  + rd21(ix,iy) * xc(ix22(ix,iy),iy21(ix,iy)) &
1281  + rd12(ix,iy) * xc(ix21(ix,iy),iy22(ix,iy)) &
1282  + rd22(ix,iy) * xc(ix22(ix,iy),iy22(ix,iy))
1283  fy(ix,iy) &
1284  = rd11(ix,iy) * yc(ix21(ix,iy),iy21(ix,iy)) &
1285  + rd21(ix,iy) * yc(ix22(ix,iy),iy21(ix,iy)) &
1286  + rd12(ix,iy) * yc(ix21(ix,iy),iy22(ix,iy)) &
1287  + rd22(ix,iy) * yc(ix22(ix,iy),iy22(ix,iy))
1288  fa(ix,iy) &
1289  = rd11(ix,iy) * ac(ix21(ix,iy),iy21(ix,iy)) &
1290  + rd21(ix,iy) * ac(ix22(ix,iy),iy21(ix,iy)) &
1291  + rd12(ix,iy) * ac(ix21(ix,iy),iy22(ix,iy)) &
1292  + rd22(ix,iy) * ac(ix22(ix,iy),iy22(ix,iy))
1293  a1(ix,iy) = max( 1.e-10 , &
1294  sqrt( fx(ix,iy)**2 + fy(ix,iy)**2 ) )
1295  a2(ix,iy) &
1296  = rd11(ix,iy) * sqrt(xc(ix21(ix,iy),iy21(ix,iy))**2 &
1297  +yc(ix21(ix,iy),iy21(ix,iy))**2) &
1298  + rd21(ix,iy) * sqrt(xc(ix22(ix,iy),iy21(ix,iy))**2 &
1299  +yc(ix22(ix,iy),iy21(ix,iy))**2) &
1300  + rd12(ix,iy) * sqrt(xc(ix21(ix,iy),iy22(ix,iy))**2 &
1301  +yc(ix21(ix,iy),iy22(ix,iy))**2) &
1302  + rd22(ix,iy) * sqrt(xc(ix22(ix,iy),iy22(ix,iy))**2 &
1303  +yc(ix22(ix,iy),iy22(ix,iy))**2)
1304  a3(ix,iy) = sqrt( &
1305  rd11(ix,iy) * ( xc(ix21(ix,iy),iy21(ix,iy))**2 &
1306  + yc(ix21(ix,iy),iy21(ix,iy))**2 ) &
1307  + rd21(ix,iy) * ( xc(ix22(ix,iy),iy21(ix,iy))**2 &
1308  + yc(ix22(ix,iy),iy21(ix,iy))**2 ) &
1309  + rd12(ix,iy) * ( xc(ix21(ix,iy),iy22(ix,iy))**2 &
1310  + yc(ix21(ix,iy),iy22(ix,iy))**2 ) &
1311  + rd22(ix,iy) * ( xc(ix22(ix,iy),iy22(ix,iy))**2 &
1312  + yc(ix22(ix,iy),iy22(ix,iy))**2 ) )
1313  END DO
1314  END DO
1315  !
1316  ! ... Winds, correct for velocity or energy conservation
1317  !
1318 #ifdef W3_WNT1
1319  IF (ifld.EQ.3) THEN
1320  DO iy=1,ny
1321  DO ix=1,nx
1322  factor = min( 1.5 , a2(ix,iy)/a1(ix,iy) )
1323  fx(ix,iy) = factor * fx(ix,iy)
1324  fy(ix,iy) = factor * fy(ix,iy)
1325  END DO
1326  END DO
1327  END IF
1328 #endif
1329  !
1330 #ifdef W3_WNT2
1331  IF (ifld.EQ.3) THEN
1332  DO iy=1,ny
1333  DO ix=1,nx
1334  factor = min( 1.5 , a3(ix,iy)/a1(ix,iy) )
1335  fx(ix,iy) = factor * fx(ix,iy)
1336  fy(ix,iy) = factor * fy(ix,iy)
1337  END DO
1338  END DO
1339  END IF
1340 #endif
1341  !
1342  ! ... Currents, correct for velocity or energy conservation
1343  !
1344 #ifdef W3_CRT1
1345  IF (ifld.EQ.4) THEN
1346  DO iy=1,ny
1347  DO ix=1,nx
1348  factor = min( 1.5 , a2(ix,iy)/a1(ix,iy) )
1349  fx(ix,iy) = factor * fx(ix,iy)
1350  fy(ix,iy) = factor * fy(ix,iy)
1351  END DO
1352  END DO
1353  END IF
1354 #endif
1355  !
1356 #ifdef W3_CRT2
1357  IF (ifld.EQ.4) THEN
1358  DO iy=1,ny
1359  DO ix=1,nx
1360  factor = min( 1.5 , a3(ix,iy)/a1(ix,iy) )
1361  fx(ix,iy) = factor * fx(ix,iy)
1362  fy(ix,iy) = factor * fy(ix,iy)
1363  END DO
1364  END DO
1365  END IF
1366 #endif
1367  !
1368  ! ... Momentum, correct for velocity or energy conservation
1369  !
1370 #ifdef W3_WNT1
1371  IF (ifld.EQ.6) THEN
1372  DO iy=1,ny
1373  DO ix=1,nx
1374  factor = min( 1.5 , a2(ix,iy)/a1(ix,iy) )
1375  fx(ix,iy) = factor * fx(ix,iy)
1376  fy(ix,iy) = factor * fy(ix,iy)
1377  END DO
1378  END DO
1379  END IF
1380 #endif
1381  !
1382 #ifdef W3_WNT2
1383  IF (ifld.EQ.6) THEN
1384  DO iy=1,ny
1385  DO ix=1,nx
1386  factor = min( 1.5 , a3(ix,iy)/a1(ix,iy) )
1387  fx(ix,iy) = factor * fx(ix,iy)
1388  fy(ix,iy) = factor * fy(ix,iy)
1389  END DO
1390  END DO
1391  END IF
1392 #endif
1393  END IF
1394  !
1395  END IF
1396  !
1397  ! ... Test output
1398  !
1399 #ifdef W3_T3
1400  IF ( .NOT. ALLOCATED(mapout) ) ALLOCATE ( mapout(nx,ny) )
1401  WRITE (ndst,9065)
1402  DO ix=1, nx
1403  DO iy=1, ny
1404  mapout(ix,iy) = mapsta(iy,ix)
1405  END DO
1406  END DO
1407  ix0 = 1
1408  ixn = min( ix0+ixwdt-1 , nx )
1409  DO
1410  IF (ifld.EQ.-7) THEN
1411  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1412  ix0, ixn, 1, 1, ny, 1, 'ice param 1', '(-)')
1413  ELSE IF (ifld.EQ.-6) THEN
1414  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1415  ix0, ixn, 1, 1, ny, 1, 'ice param 2', '(-)')
1416  ELSE IF (ifld.EQ.-5) THEN
1417  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1418  ix0, ixn, 1, 1, ny, 1, 'ice param 3', '(-)')
1419  ELSE IF (ifld.EQ.-4) THEN
1420  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1421  ix0, ixn, 1, 1, ny, 1, 'ice param 4', '(-)')
1422  ELSE IF (ifld.EQ.-3) THEN
1423  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1424  ix0, ixn, 1, 1, ny, 1, 'ice param 5', '(-)')
1425  ELSE IF (ifld.EQ.-2) THEN
1426  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1427  ix0, ixn, 1, 1, ny, 1, 'Mud Density', 'kg/m3')
1428  ELSE IF (ifld.EQ.-1) THEN
1429  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1430  ix0, ixn, 1, 1, ny, 1, 'Mud Thkness', '(-)')
1431  ELSE IF (ifld.EQ.0) THEN
1432  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1433  ix0, ixn, 1, 1, ny, 1, 'Mud Kin.Visc', 'm2/s')
1434  ELSE IF (ifld.EQ.1) THEN
1435  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1436  ix0, ixn, 1, 1, ny, 1, 'Fraction ice', '(-)')
1437  IF ( flberg ) &
1438  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1439  ix0, ixn, 1, 1, ny, 1, 'Iceberg a', '0.1/km')
1440  ELSE IF (ifld.EQ.2) THEN
1441  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1442  ix0, ixn, 1, 1, ny, 1, 'Water level', 'm')
1443  ELSE
1444  CALL prtblk (ndso, nx, ny, nx, fx, mapout, 0, 0., &
1445  ix0, ixn, 1, 1, ny, 1, 'Cart. X-comp', 'm/s')
1446  CALL prtblk (ndso, nx, ny, nx, fy, mapout, 0, 0., &
1447  ix0, ixn, 1, 1, ny, 1, 'Cart. Y-comp', 'm/s')
1448  IF ( flstab ) &
1449  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
1450  ix0, ixn, 1, 1, ny, 1, 'Tair-Tsea', 'degr')
1451  END IF
1452  IF (ixn.NE.nx) THEN
1453  ix0 = ix0 + ixwdt
1454  ixn = min( ixn+ixwdt , nx )
1455  ELSE
1456  EXIT
1457  END IF
1458  END DO
1459 #endif
1460  !
1461  ! 6.c Write fields
1462  !
1463  IF ( itype .LE. 4 ) THEN
1464 #ifdef W3_O3
1465  WRITE (ndso,977)
1466 #endif
1467  CALL w3fldg ('WRITE', idfld, ndsdat, ndst, ndse, nx, ny, &
1468  nx, ny, time, time, time, fx, fy, fa, time, &
1469  fx, fy, fa, ierr)
1470  ELSE IF ( itype .EQ. 5 ) THEN
1471  IF ( ndat .EQ. 0 ) THEN
1472 #ifdef W3_O3
1473  WRITE (ndso,978)
1474 #endif
1475  ELSE
1476 #ifdef W3_O3
1477  WRITE (ndso,977)
1478 #endif
1479  CALL w3fldd ('WRITE', idfld, ndsdat, ndst, ndse, time,&
1480  time, recldt, ndat, idat, DATA, ierr )
1481  DEALLOCATE ( DATA )
1482  END IF
1483  END IF
1484  IF (ierr.NE.0) CALL extcde ( 30 )
1485  !
1486  IF ( .NOT. fltime ) EXIT
1487  END DO
1488  !
1489  ! End loop over input fields
1490  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1491  !
1492  GOTO 888
1493  !
1494  ! Error escape locations
1495  !
1496 800 CONTINUE
1497  WRITE (ndse,1000) ierr
1498  CALL extcde ( 40 )
1499  !
1500 801 CONTINUE
1501  WRITE (ndse,1001)
1502  CALL extcde ( 41 )
1503  !
1504 802 CONTINUE
1505  WRITE (ndse,1002) ierr
1506  CALL extcde ( 42 )
1507  !
1508 845 CONTINUE
1509  WRITE (ndse,1045) ierr
1510  CALL extcde ( 47 )
1511  !
1512 846 CONTINUE
1513  WRITE (ndse,1046) ierr
1514  CALL extcde ( 48 )
1515  !
1516 850 CONTINUE
1517  WRITE (ndse,1050) ierr, ndsf(j), namef
1518  CALL extcde ( 49 )
1519  !
1520 860 CONTINUE
1521  WRITE (ndse,1060) j, ierr
1522  CALL extcde ( 50 )
1523  !
1524 861 CONTINUE
1525  WRITE (ndse,1061) time, time2
1526  CALL extcde ( 51 )
1527  !
1528 862 CONTINUE
1529  WRITE (ndse,1062) ierr
1530  CALL extcde ( 52 )
1531  !
1532 863 CONTINUE
1533  WRITE (ndse,1063) idat, ierr
1534  CALL extcde ( 53 )
1535  !
1536 #ifdef W3_O15
1537 870 CONTINUE
1538  WRITE (ndse,1070) idfld, ierr
1539  CALL extcde ( 54 )
1540 #endif
1541  !
1542 #ifdef W3_O15
1543 871 CONTINUE
1544  WRITE (ndse,1071) idtime, ierr
1545  CALL extcde ( 54 )
1546 #endif
1547  !
1548 888 CONTINUE
1549  WRITE (ndso,999)
1550  !
1551 #ifdef W3_NCO
1552  ! CALL W3TAGE('WAVEPREP')
1553 #endif
1554  !
1555  ! Formats
1556  !
1557 900 FORMAT (/15x,' *** WAVEWATCH III Input pre-processing *** '/ &
1558  15x,'==============================================='/)
1559 901 FORMAT ( ' Comment character is ''',a,''''/)
1560 902 FORMAT ( ' Grid name : ',a/)
1561  !
1562 930 FORMAT (/' Description of inputs'/ &
1563  ' --------------------------------------------------'/ &
1564  ' Input type : ',a/ &
1565  ' Format type : ',a)
1566 1930 FORMAT ( ' Field conserves velocity.')
1567 2930 FORMAT ( ' Field corrected for energy conservation.')
1568 931 FORMAT (/' Single field, time: ',a)
1569 932 FORMAT (/' Input grid dim. :',i5,3x,i5)
1570 933 FORMAT ( ' Longitude range :',2f8.2,' (deg)'/ &
1571  ' Latitude range :',2f8.2,' (deg)')
1572 733 FORMAT ( ' X range :',2f8.2,' (km)'/ &
1573  ' Y range :',2f8.2,' (km)')
1574 934 FORMAT (/' Data type : ',a/ &
1575  ' Data record length:',i5/ &
1576  ' Missing values :',f8.2)
1577 935 FORMAT ( 'DT',i1 )
1578 938 FORMAT ( ' Icebergs included.')
1579 939 FORMAT ( ' Air-sea temperature differences included.')
1580  !
1581 940 FORMAT (//' Preprocessing data'/ &
1582  ' --------------------------------------------------')
1583 941 FORMAT ( ' Interpolation factors ..... '/ &
1584  ' (longitude-latitude grid)')
1585 942 FORMAT ( ' Interpolation factors ..... '/ &
1586  ' (grid from file)')
1587 943 FORMAT (/' Longitude-latitude file ',i1,' :'/ &
1588  ' ---------------------------------------')
1589 944 FORMAT ( ' Input grid dim. :',i5,3x,i5/ &
1590  ' Closed longitudes :',l5)
1591 945 FORMAT ( ' Layout indicator :',i5/ &
1592  ' Format indicator :',i5)
1593 946 FORMAT ( ' Format : ',a)
1594 947 FORMAT ( ' Unit number :',i5)
1595 948 FORMAT ( ' File name : ',a)
1596 949 FORMAT (/' Corresponding map file '/ &
1597  ' ---------------------------------------')
1598  !
1599 960 FORMAT (/' Data file :'/ &
1600  ' ---------------------------------------')
1601 961 FORMAT (/' Data file :'/ &
1602  ' ---------------------------------------'/ &
1603  ' Input grid dim. :',i5,3x,i5)
1604 962 FORMAT (/' Data file (',i1,') :'/ &
1605  ' ---------------------------------------'/ &
1606  ' Input grid dim. :',i5,3x,i5)
1607 963 FORMAT ( ' Layout indicator :',i5)
1608 964 FORMAT ( ' Format indicator :',i5)
1609 965 FORMAT ( ' Format for time : ',a/ &
1610  ' Format for data : ',a)
1611 966 FORMAT ( ' Unit number :',i5)
1612 967 FORMAT ( ' File name : ',a)
1613  !
1614 970 FORMAT (/' Opening input data file .....')
1615 971 FORMAT (/' Opening output data file .....')
1616 972 FORMAT (//' Processing data'/ &
1617  ' --------------------------------------------------')
1618 973 FORMAT ( ' Time : ',a)
1619 #ifdef W3_O3
1620 974 FORMAT ( ' reading ....')
1621 975 FORMAT ( ' number of data records :',i6)
1622 976 FORMAT ( ' interpolating',a,'....')
1623 977 FORMAT ( ' writing ....')
1624 978 FORMAT ( ' skipping ....')
1625 #endif
1626  !
1627 #ifdef W3_O15
1628 979 FORMAT (1x,i8.8,1x,i6.6)
1629 #endif
1630  !
1631 999 FORMAT(//' End of program '/ &
1632  ' ========================================='/ &
1633  ' WAVEWATCH III Input preprocessing '/)
1634  !
1635 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1636  ' ERROR IN OPENING INPUT FILE'/ &
1637  ' IOSTAT =',i5/)
1638  !
1639 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1640  ' PREMATURE END OF INPUT FILE'/)
1641  !
1642 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1643  ' ERROR IN READING FROM INPUT FILE'/ &
1644  ' IOSTAT =',i5/)
1645  !
1646 1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1647  ' ILLEGAL FIELD ID -->',a,'<--'/)
1648 1031 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1649  ' ILLEGAL FORMAT ID -->',a,'<--'/)
1650 1032 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1651  ' THIS FORMAT TYPE IS ALLOWED FOR ICE AND LEV ONLY'/)
1652  !
1653 1033 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1654  ' ILLEGAL DATA RECORD LENGTH : ',i6/)
1655 1034 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1656  ' ILLEGAL DATA TYPE : ',i2/)
1657  !
1658 1035 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1659  ' ILLEGAL TIME : ',i8.8,i7.6/)
1660 1036 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1661  ' ILLEGAL SIZE OF INPUT GRID : ',i5,1x,i5/)
1662 10381 FORMAT (/' *** WAVEWATCH III WARNING IN W3PREP : '/ &
1663  ' LAT/LON DATA READ FROM INPUT FILE')
1664 10382 FORMAT (/' *** WAVEWATCH III WARNING IN W3PREP : '/ &
1665  ' MASK DATA READ FROM INPUT FILE')
1666  !
1667 1042 FORMAT (/' *** WAVEWATCH-III WARNING W3PREP : '/ &
1668  ' GRID POINT ',2i6,2f7.2,/ &
1669  ' NOT COVERED BY INPUT GRID.'/)
1670 1044 FORMAT (/' *** WAVEWATCH III WARNING W3PREP : '/ &
1671  ' Y = ',f10.1,' NOT COVERED BY INPUT GRID.'/)
1672  !
1673 
1674  !
1675 1045 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1676  ' ERROR IN OPENING LAT-LONG DATA FILE'/ &
1677  ' IOSTAT =',i5/)
1678  !
1679 1046 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1680  ' ERROR IN OPENING MASK FILE'/ &
1681  ' IOSTAT =',i5/)
1682  !
1683 1050 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1684  ' ERROR IN OPENING INPUT DATA FILE'/ &
1685  ' IOSTAT =',i5/ &
1686  ' NDSF =',i5/ &
1687  ' NAMEF = ',a/)
1688 1051 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1689  ' CANNOT READ UNFORMATTED FROM UNIT',i3/)
1690  !
1691 1052 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1692  ' ERROR IN READING FROM INPUT DATA FILE'/ &
1693  ' IN FILE , VARIABLE ID = ',a/ &
1694  ' ARRAY DIMENSION = ',2i5/ &
1695  ' EXPECTING , VARIABLE ID = ',a/ &
1696  ' ARRAY DIMENSION = ',2i5/)
1697  !
1698 1060 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1699  ' ERROR IN READING TIME FROM FILE (',i1,')'/ &
1700  ' IOSTAT =',i5/)
1701 1061 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1702  ' INCOMPATIBLE FIELD TIMES '/ &
1703  ' FIELD #1 : ',i8.8,i7.6/ &
1704  ' FIELD #2 : ',i8.8,i7.6/)
1705 1062 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1706  ' ERROR IN READING NDAT FROM FILE'/ &
1707  ' IOSTAT =',i5/)
1708 1063 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1709  ' ERROR IN READING DATA RECORD',i6,' FROM FILE'/ &
1710  ' IOSTAT =',i5/)
1711 #ifdef W3_O15
1712 1070 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1713  ' ERROR IN CREATING A TIMES FILE FOR ',a/ &
1714  ' IOSTAT =',i5/)
1715 1071 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
1716  ' ERROR IN WRITING TIME OUTPUT ',a/ &
1717  ' IOSTAT =',i5/)
1718 #endif
1719  !
1720 #ifdef W3_T
1721 9000 FORMAT (' TEST W3PREP : ACC : ',f6.3)
1722 #endif
1723  !
1724 #ifdef W3_T
1725 9040 FORMAT (' TEST W3PREP : INPUT GRID RANGES AND INCR. AFTER CORR.'/ &
1726  ' LON / X : ',3f10.2, &
1727  ' (GLOBAL=',l1,')'/ &
1728  ' LAT / Y : ',3f10.2)
1729 9041 FORMAT (' TEST W3PREP : INTERPOLATION DATA FOR ',a)
1730 9042 FORMAT (' ',i4,f8.2,2i4,2f8.2,1x,f6.3,1x,a)
1731 9043 FORMAT (' TEST W3PREP : GRID SHIFTED BY ',f5.0,' DEGREES / M')
1732 #endif
1733 #ifdef W3_T1
1734 9045 FORMAT (' TEST W3PREP : IX, IY, IXI(2), IYI(2), RD(4)')
1735 9046 FORMAT (' ',2i4,2x,4i4,2x,4f6.2)
1736 #endif
1737  !
1738 #ifdef W3_T1a
1739 9050 FORMAT (' TEST W3PREP : LAT-LONG OF INPUT FILE ')
1740 9051 FORMAT (' ',2i4,2f8.2,i4)
1741 #endif
1742  !
1743 #ifdef W3_T2
1744 9060 FORMAT (' TEST W3PREP : INPUT FIELD (',i1,') :'/)
1745 9061 FORMAT (' TEST W3PREP : INPUT DATA RECORDS :')
1746 9062 FORMAT (' ',i6,' : ',6e11.3)
1747 9063 FORMAT (' ',6e11.3)
1748 #endif
1749 #ifdef W3_T3
1750 9065 FORMAT (' TEST W3PREP : OUTPUT FIELD(S) :'/)
1751 #endif
1752  !/
1753  !/ End of W3PREP ----------------------------------------------------- /
1754  !/
1755 END PROGRAM w3prep
w3servmd::nextln
subroutine nextln(CHCKC, NDSI, NDSE)
Definition: w3servmd.F90:222
w3fldsmd::w3fldd
subroutine w3fldd(INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, NR, ND, NDOUT, DATA, IERR)
Definition: w3fldsmd.F90:1474
w3adatmd
Define data structures to set up wave model auxiliary data for several models simultaneously.
Definition: w3adatmd.F90:26
w3gsrumd
Definition: w3gsrumd.F90:17
w3odatmd::fnmpre
character(len=80) fnmpre
Definition: w3odatmd.F90:330
w3arrymd::ina2i
subroutine ina2i(ARRAY, MX, MY, LX, HX, LY, HY, NDS, NDST, NDSE, IDFM, RFORM, IDLA, VSC, VOF)
Definition: w3arrymd.F90:295
w3arrymd::ina2r
subroutine ina2r(ARRAY, MX, MY, LX, HX, LY, HY, NDS, NDST, NDSE, IDFM, RFORM, IDLA, VSC, VOF)
Definition: w3arrymd.F90:78
w3gdatmd::w3setg
subroutine w3setg(IMOD, NDSE, NDST)
Definition: w3gdatmd.F90:2152
w3odatmd::ndse
integer, pointer ndse
Definition: w3odatmd.F90:456
w3adatmd::w3seta
subroutine w3seta(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3adatmd.F90:2645
w3servmd
Definition: w3servmd.F90:3
w3odatmd::w3seto
subroutine w3seto(IMOD, NDSERR, NDSTST)
Definition: w3odatmd.F90:1523
w3timemd::stme21
subroutine stme21(TIME, DTME21)
Definition: w3timemd.F90:682
w3odatmd
Definition: w3odatmd.F90:3
w3adatmd::w3naux
subroutine w3naux(NDSE, NDST)
Set up the number of grids to be used.
Definition: w3adatmd.F90:704
w3iogrmd::w3iogr
subroutine w3iogr(INXOUT, NDSM, IMOD, FEXT ifdef W3_ASCII
Reading and writing of the model definition file.
Definition: w3iogrmd.F90:117
file
file(STRINGS ${CMAKE_BINARY_DIR}/switch switch_strings) separate_arguments(switches UNIX_COMMAND $
Definition: CMakeLists.txt:3
w3iogrmd
Reading/writing of model definition file.
Definition: w3iogrmd.F90:20
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3odatmd::ndso
integer, pointer ndso
Definition: w3odatmd.F90:456
w3gdatmd::w3nmod
subroutine w3nmod(NUMBER, NDSE, NDST, NAUX)
Definition: w3gdatmd.F90:1433
w3arrymd
Definition: w3arrymd.F90:3
w3odatmd::ndst
integer, pointer ndst
Definition: w3odatmd.F90:456
constants
Define some much-used constants for global use (all defined as PARAMETER).
Definition: constants.F90:20
w3gdatmd
Definition: w3gdatmd.F90:16
w3fldsmd::w3fldg
subroutine w3fldg(INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, NX, NY, T0, TN, TF0, FX0, FY0, FA0, TFN, FXN, FYN, FAN, IERR, FLAGSC ifdef W3_OASIS
Definition: w3fldsmd.F90:958
constants::file_endian
character(*), parameter file_endian
FILE_ENDIAN Filled by preprocessor with 'big_endian', 'little_endian', or 'native'.
Definition: constants.F90:86
w3fldsmd::w3fldp
subroutine w3fldp(NDSM, NDST, NDSE, IERR, FLAGLL, MX, MY, NX, NY, TLAT, TLON, MAPOVR, ILAND, MXI, MYI, NXI, NYI, CLOSED, ALAT, ALON, MASK, RD11, RD21, RD12, RD22, IX1, IX2, IY1, IY2)
Definition: w3fldsmd.F90:1750
w3servmd::extcde
subroutine extcde(IEXIT, UNIT, MSG, FILE, LINE, COMM)
Definition: w3servmd.F90:736
w3odatmd::w3nout
subroutine w3nout(NDSERR, NDSTST)
Definition: w3odatmd.F90:561
w3servmd::itrace
subroutine itrace(NDS, NMAX)
Definition: w3servmd.F90:91
w3fldsmd::w3fldo
subroutine w3fldo(INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, GTYPE, IERR, FEXT, FPRE, FHDR, TIDEFLAGIN)
Definition: w3fldsmd.F90:90
w3timemd
Definition: w3timemd.F90:3
w3arrymd::prtblk
subroutine prtblk(NDS, NX, NY, MX, F, MAP, MAP0, FSC, IX1, IX2, IX3, IY1, IY2, IY3, PRVAR, PRUNIT)
Definition: w3arrymd.F90:1112
w3prep
program w3prep
Preprocessing of input data.
Definition: ww3_prep.F90:17
w3gsrumd::t_gsu
Definition: w3gsrumd.F90:325
w3fldsmd
Definition: w3fldsmd.F90:3