WAVEWATCH III  beta 0.0.1
w3fldsmd.F90
Go to the documentation of this file.
1 #include "w3macros.h"
2 !/ ------------------------------------------------------------------- /
3 MODULE w3fldsmd
4  !/
5  !/ +-----------------------------------+
6  !/ | WAVEWATCH III NOAA/NCEP |
7  !/ | H. L. Tolman |
8  !/ | A. Chawla |
9  !/ | FORTRAN 90 |
10  !/ | Last update : 22-Mar-2021 |
11  !/ +-----------------------------------+
12  !/
13  !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 )
14  !/ 25-Jan-2002 : Data assimilation set up. ( version 2.17 )
15  !/ 26-Dec-2002 : Continuously moving grid. ( version 3.02 )
16  !/ 04-Sep-2003 : Bug fix W3FLHD. ( version 3.04 )
17  !/ 27-Dec-2004 : Multiple grid version. ( version 3.06 )
18  !/ 05-Jul-2005 : Correct first level/ice. ( version 3.07 )
19  !/ 27-Jun-2006 : Adding file name preamble. ( version 3.09 )
20  !/ 09-Oct-2007 : Make file header optional. ( version 3.13 )
21  !/ 29-May-2009 : Preparing distribution version. ( version 3.14 )
22  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
23  !/ (W. E. Rogers & T. J. Campbell, NRL)
24  !/ 04-Apr-2010 : Adding icebergs with ISI. ( version 3.14 )
25  !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLO (integer) to
26  !/ specify index closure for a grid. ( version 3.14 )
27  !/ (T. J. Campbell, NRL)
28  !/ 30-Oct-2012 : Implement tidal analysis ( version 4.08 )
29  !/ (F. Ardhuin)
30  !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.OF )
31  !/ 5-Mar-2012 : Cleanup of tidal analysis ( version 4.09 )
32  !/ 24-Apr-2015 : Adding OASIS coupling calls ( version 5.07 )
33  !/ (M. Accensi & F. Ardhuin, IFREMER)
34  !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 )
35  !/ 05-Jun-2018 : adds DEBUGFLS ( version 6.04 )
36  !/ 22-Mar-2021 : adds momentum and density input ( version 7.13 )
37  !/
38  !/ Copyright 2009-2012 National Weather Service (NWS),
39  !/ National Oceanic and Atmospheric Administration. All rights
40  !/ reserved. WAVEWATCH III is a trademark of the NWS.
41  !/ No unauthorized use without permission.
42  !/
43  ! 1. Purpose :
44  !
45  ! Gathers a set of routines to manage input fields of depth,
46  ! current, wind, ice concentration, atmospheric momentum, and
47  ! air density
48  !
49  ! 2. Variables and types :
50  !
51  ! 3. Subroutines and functions :
52  !
53  ! Name Type Scope Description
54  ! ----------------------------------------------------------------
55  ! W3FLDO Subr. Public Open data file.
56  ! W3FLDG Subr. Public. Read/write data file (fields).
57  ! W3FLDD Subr. Public. Read/write data file (data).
58  ! W3FLDP Subr. Public. Generic field interpolation.
59  ! W3FLDH Subr. Public. Process homogeneous fields.
60  ! W3FLDM Subr. Public. Process moving grid data.
61  ! W3FLDTIDE Subr. Public. Read/write tidal constituents
62  ! ----------------------------------------------------------------
63  !
64  ! 4. Subroutines and functions used :
65  !
66  ! Name Type Module Description
67  ! ----------------------------------------------------------------
68  ! STRACE Subr. W3SERVMD Subroutine tracing. ( !/S )
69  ! TICK21 Subr. W3TIMEMD Increment the clock.
70  ! DSEC21 R.F. W3TIMEMD Calculate time differnces.
71  ! ----------------------------------------------------------------
72  !
73  ! 5. Remarks :
74  !
75  ! - By design, these routines do not use the WAVEWATCH III data
76  ! structure. With this approach, they can be used in a straight-
77  ! forward way in other programs to generate WAVEWATCH III input
78  ! data sets directly from such programs.
79  !
80  ! 6. Switches :
81  !
82  ! 7. Source code :
83  !
84  !/ ------------------------------------------------------------------- /
85  PUBLIC
86 CONTAINS
87  !/ ------------------------------------------------------------------- /
88  SUBROUTINE w3fldo ( INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, &
89  GTYPE, IERR, FEXT, FPRE, FHDR, TIDEFLAGIN )
90  !/
91  !/ +-----------------------------------+
92  !/ | WAVEWATCH III NOAA/NCEP |
93  !/ | H. L. Tolman |
94  !/ | A. Chawla |
95  !/ | FORTRAN 90 |
96  !/ | Last update : 22-Mar-2021 |
97  !/ +-----------------------------------+
98  !/
99  !/ 15-Jan-1999 : Final FORTRAN 77 ( version 1.18 )
100  !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 )
101  !/ 24-Jan-2001 : Flat grid version (formats only) ( version 2.06 )
102  !/ 24-Jan-2002 : Assimilation data added. ( version 2.17 )
103  !/ 27-Dec-2004 : Multiple grid version. ( version 3.06 )
104  !/ 27-Jun-2006 : Adding file name preamble. ( version 3.09 )
105  !/ 09-Oct-2007 : Make file header optional. ( version 3.13 )
106  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
107  !/ (W. E. Rogers & T. J. Campbell, NRL)
108  !/ 04-Apr-2010 : Adding iceberg field. ( version 3.14 )
109  !/ 09-Sep-2012 : Implement tidal cons. (F. Ardhuin ) ( version 4.09 )
110  !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 )
111  !/ 22-Mar-2021 : adds momentum and density input ( version 7.13 )
112  !/
113  ! 1. Purpose :
114  !
115  ! Open and prepare WAVEWATCH III field files as used by the
116  ! generic shell and the field preprocessor.
117  !
118  ! 2. Method :
119  !
120  ! The file header contains a general WAVEWATCH III ID string,
121  ! a field ID string and the dimensions of the grid. If a file
122  ! is opened to be read, these parameters are all checked.
123  !
124  ! 3. Parameters :
125  !
126  ! Parameter list
127  ! ----------------------------------------------------------------
128  ! INXOUT C*(*) I Test string for read/write, valid are:
129  ! 'READ' and 'WRITE'.
130  ! IDFLD C*3 I/O ID string for field type, valid are: 'IC1',
131  ! 'IC2', 'IC3', 'IC4', 'IC5', 'MDN', 'MTH',
132  ! 'MVS', 'LEV', 'CUR', 'WND', 'WNS', 'ICE',
133  ! 'TAU', 'RHO', 'ISI', and 'DTn'.
134  ! NDS Int. I Dataset number for fields file.
135  ! NDST Int. I Dataset number for test output.
136  ! NDSE Int. I Dataset number for error output.
137  ! (No output if NDSE < 0).
138  ! NX, NY Int. I Discrete grid dimensions. \
139  ! GTYPE Int. I Integer flag indicating type of grid. /a
140  ! NX Int. I/O Record length. \
141  ! GTYPE Int. I Undefined value. /b
142  ! IERR Int. O Error indicator.
143  ! 0 : No errors.
144  ! 1 : Illegal INXOUT.
145  ! 2 : Illegal ID.
146  ! 3 : Error in opening file.
147  ! 4 : Write error in file.
148  ! 5 : Read error in file.
149  ! 6 : Premature EOF in read.
150  ! 7 : Unexpected file identifier read.
151  ! 8 : Unexpected field identifier read.
152  ! 9 : Unexpected grid dimensions read.
153  ! 10 : Unexpected data info.
154  ! ----------------------------------------------------------------
155  ! a) for output fields.
156  ! b) for input data.
157  !
158  ! 4. Subroutines used :
159  !
160  ! Name Type Module Description
161  ! ----------------------------------------------------------------
162  ! STRACE Subr. W3SERVMD Subroutine tracing.
163  ! ----------------------------------------------------------------
164  !
165  ! 5. Called by :
166  !
167  ! Name Type Module Description
168  ! ----------------------------------------------------------------
169  ! WW3_PREP Prog. N/A Input data preprocessor.
170  ! WW3_SHEL Prog. N/A Basic wave model driver.
171  ! ...... Prog. N/A Any other program that reads or
172  ! writes WAVEWATCH III data files.
173  ! ----------------------------------------------------------------
174  !
175  ! 6. Error messages :
176  !
177  ! See end of subroutine.
178  !
179  ! 7. Remarks :
180  !
181  ! - On read, the ID 'WND' may be changed to 'WNS' (including
182  ! stability data).
183  ! - On read, the ID 'ICE' may be changed to 'ISI' (including
184  ! iceberg data).
185  !
186  ! 8. Structure :
187  !
188  ! See source code.
189  !
190  ! 9. Switches :
191  !
192  ! !/S Enable subroutine tracing.
193  ! !/T Enable test output.
194  !
195  ! 10. Source code :
196  !
197  !/ ------------------------------------------------------------------- /
198  !/
199 #ifdef W3_S
200  USE w3servmd, ONLY: strace
201 #endif
202  !
203  USE w3odatmd, only : iaproc
204  USE constants, ONLY: file_endian
205 
206  IMPLICIT NONE
207  !/
208  !/ ------------------------------------------------------------------- /
209  !/ Parameter list
210  !/
211  INTEGER, INTENT(IN) :: NDS, NDST, NDSE, NY
212  INTEGER, INTENT(INOUT) :: NX
213  INTEGER, INTENT(OUT) :: IERR
214  INTEGER, INTENT(INOUT) :: GTYPE
215  CHARACTER(LEN=3), INTENT(INOUT) :: IDFLD
216  CHARACTER, INTENT(IN) :: INXOUT*(*)
217  CHARACTER, INTENT(IN), OPTIONAL :: FEXT*(*), FPRE*(*)
218  LOGICAL, INTENT(IN), OPTIONAL :: FHDR
219  INTEGER, INTENT(INOUT), OPTIONAL :: TIDEFLAGIN
220  !/
221  !/ ------------------------------------------------------------------- /
222  !/ Local parameters
223  !/
224  INTEGER :: NXT, NYT, GTYPET, I
225  INTEGER :: FILLER(3)
226 #ifdef W3_S
227  INTEGER, SAVE :: IENT = 0
228 #endif
229  LOGICAL :: WRITE
230  CHARACTER(LEN=3) :: TSFLD
231  CHARACTER(LEN=11) :: FORM = 'UNFORMATTED'
232  CHARACTER(LEN=13) :: TSSTR, IDSTR = 'WAVEWATCH III'
233  CHARACTER(LEN=20) :: TEMPXT
234  CHARACTER(LEN=30) :: FNAME
235  LOGICAL :: FDHDR = .true.
236  INTEGER :: TIDEFLAG = 0
237  LOGICAL :: TIDEOK = .false.
238  !
239  ! 'FORM' is used for initial testing of new files only.
240  !/
241  !/ ------------------------------------------------------------------- /
242  !/
243 #ifdef W3_S
244  CALL strace (ient, 'W3FLDO')
245 #endif
246  !
247 #ifdef W3_T
248  WRITE (ndst,9000) inxout, idfld, nds, ndst, ndse, &
249  nx, ny, gtype, ierr
250 #endif
251  !
252  ! test input parameters ---------------------------------------------- *
253  !
254 #ifdef W3_TIDE
255  tideok = .true.
256 #endif
257  filler(:)=0
258  IF ( PRESENT(tideflagin) ) THEN
259  tideflag = tideflagin
260  ELSE
261  tideflag = 0
262  END IF
263 
264  IF (inxout.NE.'READ' .AND. inxout.NE.'WRITE') GOTO 801
265  IF ( idfld.NE.'IC1' .AND. idfld.NE.'IC2' .AND. &
266  idfld.NE.'IC3' .AND. idfld.NE.'IC4' .AND. &
267  idfld.NE.'IC5' .AND. idfld.NE.'MDN' .AND. &
268  idfld.NE.'MTH' .AND. idfld.NE.'MVS' .AND. &
269  idfld.NE.'LEV' .AND. idfld.NE.'CUR' .AND. &
270  idfld.NE.'WND' .AND. idfld.NE.'WNS' .AND. &
271  idfld.NE.'ICE' .AND. idfld.NE.'TAU' .AND. &
272  idfld.NE.'RHO' .AND. idfld.NE.'DT0' .AND. &
273  idfld.NE.'DT1' .AND. idfld.NE.'DT2' .AND. &
274  idfld.NE.'ISI' ) GOTO 802
275  !
276  IF ( PRESENT(fext) ) THEN
277  tempxt = fext
278  i = len_trim(fext)
279  ELSE
280  tempxt = 'ww3'
281  i = 3
282  END IF
283  !
284  IF ( PRESENT(fhdr) ) THEN
285  fdhdr = fhdr
286  END IF
287  !
288  ! Set internal variables --------------------------------------------- *
289  !
290  IF ( idfld.EQ.'LEV' ) THEN
291  fname = 'level.' // tempxt(:i)
292  i = i + 6
293  ELSE IF ( idfld.EQ.'CUR' ) THEN
294  fname = 'current.' // tempxt(:i)
295  i = i + 8
296  ELSE IF ( idfld.EQ.'WND' .OR. idfld.EQ.'WNS' ) THEN
297  fname = 'wind.' // tempxt(:i)
298  i = i + 5
299  ELSE IF ( idfld.EQ.'ICE' .OR. idfld.EQ.'ISI' ) THEN
300  fname = 'ice.' // tempxt(:i)
301  i = i + 4
302  ELSE IF ( idfld.EQ.'TAU' ) THEN
303  fname = 'momentum.' // tempxt(:i)
304  i = i + 9
305  ELSE IF ( idfld.EQ.'RHO' ) THEN
306  fname = 'density.' // tempxt(:i)
307  i = i + 8
308  ELSE IF ( idfld.EQ.'DT0' ) THEN
309  fname = 'data0.' // tempxt(:i)
310  i = i + 6
311  ELSE IF ( idfld.EQ.'DT1' ) THEN
312  fname = 'data1.' // tempxt(:i)
313  i = i + 6
314  ELSE IF ( idfld.EQ.'DT2' ) THEN
315  fname = 'data2.' // tempxt(:i)
316  i = i + 6
317  ELSE IF ( idfld.EQ.'MDN' ) THEN
318  fname = 'muddens.' // tempxt(:i)
319  i = i + 8
320  ELSE IF ( idfld.EQ.'MTH' ) THEN
321  fname = 'mudthk.' // tempxt(:i)
322  i = i + 7
323  ELSE IF ( idfld.EQ.'MVS' ) THEN
324  fname = 'mudvisc.' // tempxt(:i)
325  i = i + 8
326  ELSE IF ( idfld.EQ.'IC1' ) THEN
327  fname = 'ice1.' // tempxt(:i)
328  i = i + 5
329  ELSE IF ( idfld.EQ.'IC2' ) THEN
330  fname = 'ice2.' // tempxt(:i)
331  i = i + 5
332  ELSE IF ( idfld.EQ.'IC3' ) THEN
333  fname = 'ice3.' // tempxt(:i)
334  i = i + 5
335  ELSE IF ( idfld.EQ.'IC4' ) THEN
336  fname = 'ice4.' // tempxt(:i)
337  i = i + 5
338  ELSE IF ( idfld.EQ.'IC5' ) THEN
339  fname = 'ice5.' // tempxt(:i)
340  i = i + 5
341  END IF
342  !
343  WRITE = inxout .EQ. 'WRITE'
344  !
345 #ifdef W3_T
346  WRITE (ndst,9001) WRITE, fname(:i)
347 #endif
348  !
349  ! Open file ---------------------------------------------------------- *
350  !
351  IF ( WRITE ) THEN
352  IF ( PRESENT(fpre) ) THEN
353  OPEN (nds,file=fpre//fname(:i),form=form, convert=file_endian, &
354  err=803, iostat=ierr)
355  ELSE
356  OPEN (nds,file=fname(:i),form=form,convert=file_endian, &
357  err=803,iostat=ierr)
358  END IF
359  ELSE
360  IF ( PRESENT(fpre) ) THEN
361  OPEN (nds,file=fpre//fname(:i),form=form,convert=file_endian, &
362  status='OLD',err=803,iostat=ierr)
363  ELSE
364  OPEN (nds,file=fname(:i),form=form,convert=file_endian, &
365  status='OLD',err=803,iostat=ierr)
366  END IF
367  END IF
368  !
369  ! Process test data -------------------------------------------------- *
370  !
371  IF ( WRITE ) THEN
372  IF ( fdhdr ) THEN
373  IF ( form .EQ. 'UNFORMATTED' ) THEN
374  !
375  ! The "filler" was added for compatibility with old binary forcing files
376  ! It is now also used for tidal info ...
377  !
378  WRITE (nds,err=804,iostat=ierr) &
379  idstr, idfld, nx, ny, gtype, filler(1:2), tideflag
380  ELSE
381  WRITE (nds,900,err=804,iostat=ierr) &
382  idstr, idfld, nx, ny, gtype, filler(1:2), tideflag
383  END IF
384  END IF
385  ELSE
386  IF ( form .EQ. 'UNFORMATTED' ) THEN
387  READ (nds,END=806,ERR=805,IOSTAT=IERR) &
388  tsstr, tsfld, nxt, nyt, gtypet, filler(1:2), tideflag
389  ELSE
390  READ (nds,900,END=806,ERR=805,IOSTAT=IERR) &
391  tsstr, tsfld, nxt, nyt, gtypet, filler(1:2), tideflag
392  END IF
393  IF ((filler(1).NE.0.OR.filler(2).NE.0).AND.tideflag.GE.0) tideflag=0
394  IF (tideflag.NE.0.AND.(.NOT.tideok)) THEN
395  GOTO 810
396  END IF
397  !
398  IF ( idstr .NE. tsstr ) GOTO 807
399  IF (( idfld.EQ.'WND' .AND. tsfld.EQ.'WNS') .OR. &
400  ( idfld.EQ.'ICE' .AND. tsfld.EQ.'ISI') ) THEN
401  idfld = tsfld
402 #ifdef W3_T
403  WRITE (ndst,9002) idfld
404 #endif
405  END IF
406  IF ( idfld .NE. tsfld ) GOTO 808
407  IF ( idfld(1:2) .NE. 'DT' ) THEN
408  IF ( nx.NE.nxt .OR. ny.NE.nyt ) THEN
409  GOTO 809
410  ELSE
411  nx = nxt
412  IF (gtype.LE.4) gtype = gtypet
413  END IF
414  END IF
415  END IF
416  !
417  ! File OK ------------------------------------------------------------ *
418  !
419  ierr = 0
420  IF ( PRESENT(tideflagin) ) THEN
421  tideflagin = tideflag
422  END IF
423 
424  RETURN
425  !
426  ! Error escape locations
427  !
428 801 CONTINUE
429  IF ( ndse .GE. 0 ) WRITE (ndse,1001) inxout
430  ierr = 1
431  RETURN
432  !
433 802 CONTINUE
434  IF ( ndse .GE. 0 ) WRITE (ndse,1002) idfld
435  ierr = 2
436  RETURN
437  !
438 803 CONTINUE
439  IF ( ndse .GE. 0 ) WRITE (ndse,1003) idfld, ierr
440  ierr = 3
441  RETURN
442  !
443 804 CONTINUE
444  IF ( ndse .GE. 0 ) WRITE (ndse,1004) idfld, ierr
445  ierr = 4
446  RETURN
447  !
448 805 CONTINUE
449  IF ( ndse .GE. 0 ) WRITE (ndse,1005) idfld, ierr
450  ierr = 5
451  RETURN
452  !
453 806 CONTINUE
454  IF ( ndse .GE. 0 ) WRITE (ndse,1006) idfld
455  ierr = 6
456  RETURN
457  !
458 807 CONTINUE
459  IF ( ndse .GE. 0 ) WRITE (ndse,1007) tsstr, idstr
460  ierr = 7
461  RETURN
462  !
463 808 CONTINUE
464  IF ( ndse .GE. 0 ) WRITE (ndse,1008) tsfld, idfld
465  ierr = 8
466  RETURN
467  !
468 809 CONTINUE
469  IF ( ndse .GE. 0 ) WRITE (ndse,1009) &
470  nxt, nyt, gtypet, &
471  nx , ny , gtype
472  ierr = 9
473  RETURN
474  !
475 810 CONTINUE
476  IF ( ndse .GE. 0 ) WRITE (ndse,1010) &
477  filler(1:2),tideflag
478  ierr = 10
479  RETURN
480  !
481  ! Formats
482  !
483 900 FORMAT (1x,a13,1x,a3,6i12)
484  !
485 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
486  ' ILLEGAL INXOUT STRING : ',a/)
487 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
488  ' ILLEGAL FIELD ID STRING : ',a/)
489 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
490  ' ERROR IN OPENING ',a,' FILE, IOSTAT =',i6/)
491 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
492  ' ERROR IN WRITING TO ',a,' FILE, IOSTAT =',i6/)
493 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
494  ' ERROR IN READING ',a,' FILE, IOSTAT =',i6/)
495 
496 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
497  ' PREMATURE END OF ',a,' FILE'/)
498 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
499  ' ILLEGAL FILE ID STRING >',a,'<'/ &
500  ' SHOULD BE >',a,'<'/)
501 1008 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
502  ' ILLEGAL FIELD ID STRING >',a,'<'/ &
503  ' SHOULD BE >',a,'<'/)
504 1009 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
505  ' INCOMPATIBLE GRID DATA : ',3(1x,i10)/ &
506  ' SHOULD BE : ',3(1x,i10)/)
507 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDO : '/ &
508  ' FILLER indicates use of tidal constituents',3i4, /&
509  ' For this the code should be compiled with TIDE switch'/)
510  !
511 #ifdef W3_T
512 9000 FORMAT (' TEST W3FLDO : INXOUT : ',a/ &
513  ' IDFLD : ',a/ &
514  ' NDS : ',i2/ &
515  ' NDST : ',i2/ &
516  ' NDSE : ',i2/ &
517  ' NX, NY : ',i9,3x,i9/ &
518  ' GTYPE : ',i2/ &
519  ' IERR : ',i2)
520 9001 FORMAT (' WRITE : ',l2/ &
521  ' FNAME : [',a,']')
522 9002 FORMAT (' NEW IDFLD : ',a)
523 #endif
524  !/
525  !/ End of W3FLDO ---------------------------------------------------- /
526  !/
527  END SUBROUTINE w3fldo
528 
529  !/ ------------------------------------------------------------------- /
530  SUBROUTINE w3fldtide1 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IERR )
531  !/
532  !/ +-----------------------------------+
533  !/ | WAVEWATCH III NOAA/NCEP |
534  !/ | F. Ardhuin |
535  !/ | |
536  !/ | FORTRAN 90 |
537  !/ | Last update : 22-Mar-2021 |
538  !/ +-----------------------------------+
539  !/
540  !/ 24-Sep-2012 : Creation ( version 4.09 )
541  !/ 30-Jun-2013 : Split in 2 subroutines ( version 4.11 )
542  !/ 22-Mar-2021 : adds momentum and density input ( version 7.13 )
543  !/
544  ! 1. Purpose :
545  !
546  ! Reads and writes tidal consituents
547  !
548  ! 2. Method :
549  !
550  !
551  ! 3. Parameters :
552  !
553  ! Parameter list
554  ! ----------------------------------------------------------------
555  ! INXOUT C*(*) I Test string for read/write, valid are:
556  ! 'READ' and 'WRITE'.
557  ! IDFLD C*3 I/O ID string for field type, valid are:
558  ! 'LEV', 'CUR', 'WND', 'WNS', 'ICE', 'ISI',
559  ! 'TAU', 'RHO', and 'DTn'.
560  ! NDS Int. I Dataset number for fields file.
561  ! NDST Int. I Dataset number for test output.
562  ! NDSE Int. I Dataset number for error output.
563  ! (No output if NDSE < 0).
564  ! NX, NY Int. I Discrete grid dimensions. \
565  ! IERR Int. O Error indicator.
566  ! 0 : No errors.
567  ! 1 : Illegal INXOUT.
568  ! ----------------------------------------------------------------
569  ! a) for output fields.
570  ! b) for input data.
571  !
572  ! 4. Subroutines used :
573  !
574  ! Name Type Module Description
575  ! ----------------------------------------------------------------
576  ! STRACE Subr. W3SERVMD Subroutine tracing.
577  ! ----------------------------------------------------------------
578  !
579  ! 5. Called by :
580  !
581  ! Name Type Module Description
582  ! ----------------------------------------------------------------
583  ! WW3_PREP Prog. N/A Input data preprocessor.
584  ! WW3_PRNC Prog. N/A NetCDF input data preprocessor.
585  ! WW3_SHEL Prog. N/A Basic wave model driver.
586  ! ----------------------------------------------------------------
587  !
588  ! 6. Error messages :
589  !
590  ! See end of subroutine.
591  !
592  ! 7. Remarks :
593  !
594  ! - On read, the ID 'WND' may be changed to 'WNS' (including
595  ! stability data).
596  ! - On read, the ID 'ICE' may be changed to 'ISI' (including
597  ! iceberg data).
598  !
599  ! 8. Structure :
600  !
601  ! See source code.
602  !
603  ! 9. Switches :
604  !
605  ! !/S Enable subroutine tracing.
606  ! !/T Enable test output.
607  !
608  ! 10. Source code :
609  !
610  !/ ------------------------------------------------------------------- /
611  !/
612 #ifdef W3_S
613  USE w3servmd, ONLY: strace
614 #endif
615  !
616 #ifdef W3_TIDE
617  USE w3tidemd
618 #endif
619  USE w3idatmd
620  IMPLICIT NONE
621  !/
622  !/ ------------------------------------------------------------------- /
623  !/ Parameter list
624  !/
625  INTEGER, INTENT(IN) :: NDS, NDST, NDSE, NX, NY
626  CHARACTER(LEN=3), INTENT(INOUT) :: IDFLD
627  CHARACTER*(*), INTENT(IN) :: INXOUT
628  INTEGER, INTENT(OUT) :: IERR
629  !/
630  !/ ------------------------------------------------------------------- /
631  !/ Local parameters
632  !/
633 #ifdef W3_S
634  INTEGER, SAVE :: IENT = 0
635 #endif
636  LOGICAL :: WRITE
637  INTEGER :: I, IX
638  !
639  !/
640  !/ ------------------------------------------------------------------- /
641  !/
642 #ifdef W3_S
643  CALL strace (ient, 'W3FLDTIDE1')
644 #endif
645  !
646  ! test input parameters ---------------------------------------------- *
647  !
648  IF (inxout.NE.'READ' .AND. inxout.NE.'WRITE') GOTO 801
649  IF ( idfld.NE.'LEV' .AND. idfld.NE.'CUR' .AND. &
650  idfld.NE.'WND' .AND. idfld.NE.'WNS' .AND. &
651  idfld.NE.'ICE' .AND. idfld.NE.'TAU' .AND. &
652  idfld.NE.'RHO' .AND. idfld.NE.'DT0' .AND. &
653  idfld.NE.'DT1' .AND. idfld.NE.'DT2' .AND. &
654  idfld.NE.'ISI' ) GOTO 802
655  WRITE = inxout .EQ. 'WRITE'
656 
657 #ifdef W3_TIDE
658  IF ( WRITE ) THEN
659  WRITE (nds,err=804,iostat=ierr) &
660  tide_mf
661  ELSE
662  READ (nds,END=806,ERR=805,IOSTAT=IERR) &
663  tide_mf
664  ntide = tide_mf
665  END IF
666 #endif
667  !
668  !
669  ! File OK ------------------------------------------------------------ *
670  !
671  ierr = 0
672  RETURN
673  !
674  ! Error escape locations
675  !
676 801 CONTINUE
677  IF ( ndse .GE. 0 ) WRITE (ndse,1001) inxout
678  ierr = 1
679  RETURN
680  !
681 802 CONTINUE
682  IF ( ndse .GE. 0 ) WRITE (ndse,1002) idfld
683  ierr = 2
684  RETURN
685  !
686 804 CONTINUE
687  IF ( ndse .GE. 0 ) WRITE (ndse,1004) idfld, ierr
688  ierr = 4
689  RETURN
690  !
691 805 CONTINUE
692  IF ( ndse .GE. 0 ) WRITE (ndse,1005) idfld, ierr
693  ierr = 5
694  RETURN
695  !
696 806 CONTINUE
697  IF ( ndse .GE. 0 ) WRITE (ndse,1006) idfld
698  ierr = 6
699  RETURN
700  !
701  ! Formats
702  !
703 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE1 : '/ &
704  ' ILLEGAL INXOUT STRING : ',a/)
705 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE1 : '/ &
706  ' ILLEGAL FIELD ID STRING : ',a/)
707 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE1 : '/ &
708  ' ERROR IN WRITING TO ',a,' FILE, IOSTAT =',i6/)
709 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE1 : '/ &
710  ' ERROR IN READING ',a,' FILE, IOSTAT =',i6/)
711 
712 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE1 : '/ &
713  ' PREMATURE END OF ',a,' FILE'/)
714  !/
715  !/ End of W3FLDO ---------------------------------------------------- /
716  !/
717  END SUBROUTINE w3fldtide1
718 
719 
720  !/ ------------------------------------------------------------------- /
721  SUBROUTINE w3fldtide2 ( INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IDAT, IERR )
722  !/
723  !/ +-----------------------------------+
724  !/ | WAVEWATCH III NOAA/NCEP |
725  !/ | F. Ardhuin |
726  !/ | |
727  !/ | FORTRAN 90 |
728  !/ | Last update : 22-Mar-2021 |
729  !/ +-----------------------------------+
730  !/
731  !/ 24-Sep-2012 : Creation ( version 4.09 )
732  !/ 30-Jun-2013 : Split in 2 subroutines ( version 4.11 )
733  !/ 22-Mar-2021 : adds momentum and density input ( version 7.13 )
734  !/
735  ! 1. Purpose :
736  !
737  ! Reads and writes tidal constituents
738  !
739  ! 2. Method :
740  !
741  !
742  ! 3. Parameters :
743  !
744  ! Parameter list
745  ! ----------------------------------------------------------------
746  ! INXOUT C*(*) I Test string for read/write, valid are:
747  ! 'READ' and 'WRITE'.
748  ! IDFLD C*3 I/O ID string for field type, valid are:
749  ! 'LEV', 'CUR', 'WND', 'WNS', 'ICE', 'ISI',
750  ! 'TAU', 'RHO', and 'DTn'.
751  ! NDS Int. I Dataset number for fields file.
752  ! NDST Int. I Dataset number for test output.
753  ! NDSE Int. I Dataset number for error output.
754  ! (No output if NDSE < 0).
755  ! NX, NY Int. I Discrete grid dimensions. \
756  ! IDAT Int. I Equal to 1 if W3IDATMD arrays are to be filled
757  ! IERR Int. O Error indicator.
758  ! 0 : No errors.
759  ! 1 : Illegal INXOUT.
760  ! ----------------------------------------------------------------
761  ! a) for output fields.
762  ! b) for input data.
763  !
764  ! 4. Subroutines used :
765  !
766  ! Name Type Module Description
767  ! ----------------------------------------------------------------
768  ! STRACE Subr. W3SERVMD Subroutine tracing.
769  ! ----------------------------------------------------------------
770  !
771  ! 5. Called by :
772  !
773  ! Name Type Module Description
774  ! ----------------------------------------------------------------
775  ! WW3_PREP Prog. N/A Input data preprocessor.
776  ! WW3_PRNC Prog. N/A NetCDF input data preprocessor.
777  ! WW3_SHEL Prog. N/A Basic wave model driver.
778  ! ----------------------------------------------------------------
779  !
780  ! 6. Error messages :
781  !
782  ! See end of subroutine.
783  !
784  ! 7. Remarks :
785  !
786  ! - On read, the ID 'WND' may be changed to 'WNS' (including
787  ! stability data).
788  ! - On read, the ID 'ICE' may be changed to 'ISI' (including
789  ! iceberg data).
790  !
791  ! 8. Structure :
792  !
793  ! See source code.
794  !
795  ! 9. Switches :
796  !
797  ! !/S Enable subroutine tracing.
798  ! !/T Enable test output.
799  !
800  ! 10. Source code :
801  !
802  !/ ------------------------------------------------------------------- /
803  !/
804 #ifdef W3_S
805  USE w3servmd, ONLY: strace
806 #endif
807  !
808 #ifdef W3_TIDE
809  USE w3tidemd
810 #endif
811  USE w3idatmd
812  IMPLICIT NONE
813  !/
814  !/ ------------------------------------------------------------------- /
815  !/ Parameter list
816  !/
817  INTEGER, INTENT(IN) :: NDS, NDST, NDSE, NX, NY, IDAT
818  CHARACTER(LEN=3), INTENT(INOUT) :: IDFLD
819  CHARACTER*(*), INTENT(IN) :: INXOUT
820  INTEGER, INTENT(OUT) :: IERR
821  !/
822  !/ ------------------------------------------------------------------- /
823  !/ Local parameters
824  !/
825 #ifdef W3_S
826  INTEGER, SAVE :: IENT = 0
827 #endif
828  LOGICAL :: WRITE
829  INTEGER :: I, IX, TIDE_MF1
830  CHARACTER(LEN=100) :: LIST(70)
831  !/
832  !/ ------------------------------------------------------------------- /
833  !/
834 #ifdef W3_S
835  CALL strace (ient, 'W3FLDTIDE2')
836 #endif
837  !
838  ! test input parameters ---------------------------------------------- *
839  !
840  IF (inxout.NE.'READ' .AND. inxout.NE.'WRITE') GOTO 801
841  IF ( idfld.NE.'LEV' .AND. idfld.NE.'CUR' .AND. &
842  idfld.NE.'WND' .AND. idfld.NE.'WNS' .AND. &
843  idfld.NE.'ICE' .AND. idfld.NE.'TAU' .AND. &
844  idfld.NE.'RHO' .AND. idfld.NE.'DT0' .AND. &
845  idfld.NE.'DT1' .AND. idfld.NE.'DT2' .AND. &
846  idfld.NE.'ISI' ) GOTO 802
847  WRITE = inxout .EQ. 'WRITE'
848 
849 #ifdef W3_TIDE
850  IF ( WRITE ) THEN
851  WRITE (nds,err=804,iostat=ierr) &
852  tide_freqc(:),tidecon_name(:),tidal_const(:,:,:,:,:)
853  ELSE
854  IF (.NOT. ALLOCATED(tidal_const)) ALLOCATE(tidal_const(nx,ny,tide_mf,2,2))
855  IF (.NOT. ALLOCATED(tide_freqc)) ALLOCATE(tide_freqc(tide_mf))
856  IF (.NOT. ALLOCATED(tidecon_namei)) ALLOCATE(tidecon_namei(tide_mf))
857  READ (nds,END=806,ERR=805,IOSTAT=IERR) &
858  tide_freqc,tidecon_namei(:),tidal_const(:,:,:,:,:)
859  list(:)=''
860  tide_mf1=tide_mf
861  DO i=1,tide_mf
862  list(i)=tidecon_namei(i)
863  END DO
864  CALL tide_find_indices_analysis(list)
865  IF (tide_mf1.NE.tide_mf) GOTO 807
866  CALL tide_set_indices
867  IF(idfld.EQ.'LEV') THEN
868  IF (idat.EQ.1) wltide(:,:,:,:)=tidal_const(:,:,:,1,:)
869  ELSE
870  IF (idat.EQ.1) cxtide(:,:,:,:)=tidal_const(:,:,:,1,:)
871  IF (idat.EQ.1) cytide(:,:,:,:)=tidal_const(:,:,:,2,:)
872  END IF
873  END IF
874 #endif
875 #ifdef W3_TIDET
876  DO i=1,ntide
877  WRITE(ndst,*) 'Tidal constituents for IX = 1:', idfld,' ',tidecon_name(i),tidal_const(1,1,i,1,1),tidal_const(1,1,i,1,2), &
878  '##',tidal_const(1,1,i,2,1),tidal_const(1,1,i,2,2)
879  END DO
880  DO i=1,ntide
881  WRITE(ndst,*) 'Tidal constituents for IX = 2:', idfld,' ',tidecon_name(i),tidal_const(2,1,i,1,1),tidal_const(2,1,i,1,2), &
882  '##',tidal_const(2,1,i,2,1),tidal_const(2,1,i,2,2)
883  END DO
884  DO ix=1,nx
885  IF (idfld.EQ.'CUR') WRITE (989,'(I10,X,176F10.3)') ix,cxtide(ix,1,:,1),cytide(ix,1,:,1), &
886  cxtide(ix,1,:,2),cytide(ix,1,:,2)
887  END DO
888  IF (idfld.EQ.'CUR') WRITE(988,'(F10.3,/)') cxtide(:,1,15,1)
889  IF (idfld.EQ.'CUR') WRITE(988,'(F10.3,/)') cxtide(:,1,15,2)
890 #endif
891  !
892  !
893  ! File OK ------------------------------------------------------------ *
894  !
895  ierr = 0
896  RETURN
897  !
898  ! Error escape locations
899  !
900 801 CONTINUE
901  IF ( ndse .GE. 0 ) WRITE (ndse,1001) inxout
902  ierr = 1
903  RETURN
904  !
905 802 CONTINUE
906  IF ( ndse .GE. 0 ) WRITE (ndse,1002) idfld
907  ierr = 2
908  RETURN
909  !
910 804 CONTINUE
911  IF ( ndse .GE. 0 ) WRITE (ndse,1004) idfld, ierr
912  ierr = 4
913  RETURN
914  !
915 805 CONTINUE
916  IF ( ndse .GE. 0 ) WRITE (ndse,1005) idfld, ierr
917  ierr = 5
918  RETURN
919  !
920 806 CONTINUE
921  IF ( ndse .GE. 0 ) WRITE (ndse,1006) idfld
922  ierr = 6
923  RETURN
924  !
925 807 CONTINUE
926 #ifdef W3_TIDE
927  IF ( ndse .GE. 0 ) WRITE (ndse,1007) tidecon_namei(:)
928 #endif
929  ierr = 7
930  RETURN
931  !
932  ! Formats
933  !
934 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ &
935  ' ILLEGAL INXOUT STRING : ',a/)
936 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ &
937  ' ILLEGAL FIELD ID STRING : ',a/)
938 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ &
939  ' ERROR IN WRITING TO ',a,' FILE, IOSTAT =',i6/)
940 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ &
941  ' ERROR IN READING ',a,' FILE, IOSTAT =',i6/)
942 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ &
943  ' PREMATURE END OF ',a,' FILE'/)
944 #ifdef W3_TIDE
945 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDTIDE2 : '/ &
946  ' TIDAL CONSTITUENTS NOT RECOGNIZED ',a /)
947 #endif
948  !/
949  !/ End of W3FLDO ---------------------------------------------------- /
950  !/
951  END SUBROUTINE w3fldtide2
952 
953  !/ ------------------------------------------------------------------- /
954  SUBROUTINE w3fldg (INXOUT, IDFLD, NDS, NDST, NDSE, MX, MY, &
955  NX, NY, T0, TN, TF0, FX0, FY0, FA0, &
956  TFN, FXN, FYN, FAN, IERR, FLAGSC &
957 #ifdef W3_OASIS
958  , COUPL_COMM &
959 #endif
960  )
961  !/
962  !/ +-----------------------------------+
963  !/ | WAVEWATCH III NOAA/NCEP |
964  !/ | H. L. Tolman |
965  !/ | FORTRAN 90 |
966  !/ | Last update : 13-Aug-2021 |
967  !/ +-----------------------------------+
968  !/
969  !/ 15-Jan-1999 : Final FORTRAN 77 ( version 1.18 )
970  !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 )
971  !/ 05-Jul-2005 : Correct first level/ice. ( version 3.07 )
972  !/ 04-Apr-2010 : Adding icebergs in ISI ( version 3.14 )
973  !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 )
974  !/ 24-Apr-2015 : Adding OASIS coupling calls ( version 5.07 )
975  !/ (M. Accensi & F. Ardhuin, IFREMER)
976  !/ 25-Sep-2020 : Receive coupled fields at T+0 ( version 7.10 )
977  !/ 22-Mar-2021 : adds momentum and density input ( version 7.13 )
978  !/ 13-Aug-2021 : Allow scalar fields to be time ( version 7.14 )
979  !/ interpolated
980  !/
981  ! 1. Purpose :
982  !
983  ! Update input fields in the WAVEWATCH III generic shell from a
984  ! WAVEWATCH III shell data file or write from preprocessor.
985  !
986  ! 2. Method :
987  !
988  ! Read from file opened by W3FLDO.
989  !
990  ! 3. Parameters :
991  !
992  ! Parameter list
993  ! ----------------------------------------------------------------
994  ! INXOUT C*(*) I Test string for read/write, valid are:
995  ! 'READ' and 'WRITE'.
996  ! IDFLD C*3 I ID string for field type, valid are: 'IC1',
997  ! 'IC2', 'IC3', 'IC4', 'IC5', 'MDN', 'MTH', 'MVS',
998  ! 'LEV', 'CUR', 'WND', 'WNS', 'ICE', 'ISI',
999  ! 'TAU', and 'RHO'.
1000  ! NDS Int. I Dataset number for fields file.
1001  ! NDST Int. I Dataset number for test output.
1002  ! NDSE Int. I Dataset number for error output.
1003  ! (No error output if NDSE < 0 ).
1004  ! MX,MY Int. I Array dimensions output fields.
1005  ! NX,NY Int. I Discrete grid dimensions.
1006  ! T0-N I.A. I Time interval considered (dummy for write).
1007  ! TF0-N I.A. I/O Field times (TFN dummy for write).
1008  ! Fxx R.A. I/O Input fields (FxN dummy for write).
1009  ! subtypes: FX0, FY0, FA0, FXN, FYN, FAN
1010  ! (meaning is inferred from context as follows)
1011  ! "0" denotes "prior time level"
1012  ! "N" denotes "next time level"
1013  ! "X" denotes x in a vector
1014  ! "Y" denotes y in a vector
1015  ! "A" denotes scalar
1016  ! IERR Int. O Error indicator,
1017  ! -1 Past last data
1018  ! 0 OK,
1019  ! 1 : Illegal INXOUT.
1020  ! 2 : Illegal IDFLD.
1021  ! 3 : Error in writing time.
1022  ! 4 : Error in writing field.
1023  ! 5 : Error in reading time.
1024  ! 6 : Premature EOF reading field.
1025  ! 7 : Error reading field.
1026  ! FLAGSC Log. I/O Flag for coupling field
1027  ! COUPL_COMM Int. I MPI communicator for coupling
1028  ! ----------------------------------------------------------------
1029  !
1030  ! 4. Subroutines used :
1031  !
1032  ! Name Type Module Description
1033  ! ----------------------------------------------------------------
1034  ! STRACE Subr. Id. Subroutine tracing.
1035  ! TICK21 Subr. W3TIMEMD Advance time.
1036  ! DSEC21 Func. Id. Difference between times.
1037  ! ----------------------------------------------------------------
1038  !
1039  ! 5. Called by :
1040  !
1041  ! Name Type Module Description
1042  ! ----------------------------------------------------------------
1043  ! WW3_PREP Prog. N/A Input data preprocessor.
1044  ! WW3_SHEL Prog. N/A Basic wave model driver.
1045  ! ...... Prog. N/A Any other program that reads or
1046  ! writes WAVEWATCH III data files.
1047  ! ----------------------------------------------------------------
1048  !
1049  ! 6. Error messages :
1050  !
1051  ! See end of subroutine.
1052  !
1053  ! 7. Remarks :
1054  !
1055  ! - Saving of previous fields needed only for reading of 2-D fields.
1056  !
1057  ! 8. Structure :
1058  !
1059  ! See source code.
1060  !
1061  ! 9. Switches :
1062  !
1063  ! !/S Enable subroutine tracing.
1064  ! !/T Enable test output.
1065  !
1066  ! 10. Source code :
1067  !
1068  !/ ------------------------------------------------------------------- /
1069  !/
1070 #ifdef W3_S
1071  USE w3servmd, ONLY: strace
1072 #endif
1073  USE w3timemd
1074 #ifdef W3_OASIS
1075  USE w3oacpmd, ONLY: id_oasis_time, cplt0
1076 #endif
1077 #ifdef W3_OASACM
1078  USE w3agcmmd, ONLY: rcv_fields_from_atmos
1079 #endif
1080 #ifdef W3_OASOCM
1081  USE w3ogcmmd, ONLY: rcv_fields_from_ocean
1082 #endif
1083 #ifdef W3_OASICM
1084  USE w3igcmmd, ONLY: rcv_fields_from_ice
1085 #endif
1086 #ifdef W3_OASIS
1087  USE w3odatmd, ONLY: dtout
1088 #endif
1089  IMPLICIT NONE
1090  !/
1091  !/ ------------------------------------------------------------------- /
1092  !/ Parameter list
1093  !/
1094  INTEGER, INTENT(IN) :: NDS, NDST, NDSE, MX, MY, &
1095  NX, NY, T0(2), TN(2)
1096  INTEGER, INTENT(INOUT) :: TF0(2), TFN(2)
1097  INTEGER, INTENT(OUT) :: IERR
1098  REAL, INTENT(INOUT) :: FX0(MX,MY), FY0(MX,MY), &
1099  FXN(MX,MY), FYN(MX,MY), &
1100  FA0(MX,MY), FAN(MX,MY)
1101  CHARACTER, INTENT(IN) :: INXOUT*(*)
1102  CHARACTER(LEN=3), INTENT(IN) :: IDFLD
1103  LOGICAL, INTENT(INOUT), OPTIONAL :: FLAGSC
1104 #ifdef W3_OASIS
1105  INTEGER, INTENT(IN), OPTIONAL :: COUPL_COMM
1106 #endif
1107 
1108  !/
1109  !/ ------------------------------------------------------------------- /
1110  !/ Local parameters
1111  !/
1112  INTEGER :: IX, IY, J, ISTAT
1113 #ifdef W3_S
1114  INTEGER, SAVE :: IENT = 0
1115 #endif
1116  REAL :: DTTST
1117  LOGICAL :: WRITE, FL2D, FLFRST, FLBE, FLST, &
1118  FLINTERP, FLCOUPL
1119  LOGICAL, PARAMETER :: FLAGSC_DEFAULT = .false.
1120  !/
1121  !/ ------------------------------------------------------------------- /
1122  !/
1123 #ifdef W3_S
1124  CALL strace (ient, 'W3FLDG')
1125 #endif
1126  !/
1127  ierr = 0
1128  !
1129 #ifdef W3_T
1130  WRITE (ndst,9000) inxout, idfld, nds, ndst, ndse, mx, my, &
1131  nx, ny, tf0, tfn, ierr
1132 #endif
1133  !
1134  ! test input parameters ---------------------------------------------- *
1135  !
1136  IF (inxout.NE.'READ' .AND. inxout.NE.'WRITE') GOTO 801
1137  IF ( idfld.NE.'IC1' .AND. idfld.NE.'IC2' .AND. &
1138  idfld.NE.'IC3' .AND. idfld.NE.'IC4' .AND. &
1139  idfld.NE.'IC5' .AND. idfld.NE.'MDN' .AND. &
1140  idfld.NE.'MTH' .AND. idfld.NE.'MVS' .AND. &
1141  idfld.NE.'LEV' .AND. idfld.NE.'CUR' .AND. &
1142  idfld.NE.'WND' .AND. idfld.NE.'WNS' .AND. &
1143  idfld.NE.'ICE' .AND. idfld.NE.'ISI' .AND. &
1144  idfld.NE.'TAU' .AND. idfld.NE.'RHO' ) GOTO 802
1145  !
1146  ! Set internal variables --------------------------------------------- *
1147  !
1148  WRITE = inxout .EQ. 'WRITE'
1149  fl2d = idfld.EQ.'CUR' .OR. idfld.EQ.'WND' .OR. idfld.EQ.'WNS' &
1150  .OR. idfld.EQ.'ISI' .OR. idfld.EQ.'TAU'
1151  flbe = idfld.EQ.'ISI'
1152  flst = idfld.EQ.'WNS'
1153 
1154  IF ( .NOT. PRESENT(flagsc) ) THEN
1155  flcoupl=flagsc_default
1156  ELSE
1157  flcoupl=flagsc
1158  END IF
1159 
1160  ! this flag is necessary to define the field at the start and end time
1161  ! of integration for the first time step which is integrated on 0
1162  ! to be able to output integrated variables like cha, ust, taw
1163 
1164  flinterp = idfld.EQ.'CUR' .OR. idfld.EQ.'WND' .OR. idfld.EQ.'WNS' &
1165  .OR. idfld.EQ.'TAU' .OR. idfld.EQ.'RHO'
1166  ! if the model is coupled, no interpolation in time must be done
1167 
1168  IF (flcoupl) flinterp = .false.
1169 
1170  flfrst = tfn(1) .EQ. -1
1171  !
1172 #ifdef W3_T
1173  WRITE (ndst,9001) WRITE, fl2d, flbe, flst, flfrst
1174 #endif
1175  !
1176  ! Loop over times / fields ========================================== *
1177  !
1178  DO
1179  !
1180  ! Shift fields (interpolated fields only)
1181  !
1182  IF ( (.NOT.write) .AND. flinterp ) THEN
1183  !
1184  tf0(1) = tfn(1)
1185  tf0(2) = tfn(2)
1186 #ifdef W3_T
1187  WRITE (ndst,9020)
1188 #endif
1189  ! unless TFN has been changed in the do loop, the following line is essentally
1190  ! "if not.flfrst"
1191  IF ( tfn(1) .NE. -1 ) THEN
1192  DO ix=1, nx
1193  DO iy=1, ny
1194  fx0(ix,iy) = fxn(ix,iy)
1195  IF (fl2d) fy0(ix,iy) = fyn(ix,iy)
1196  END DO
1197  IF( flst .OR. .NOT.fl2d ) THEN
1198  DO iy=1, ny
1199  fa0(ix,iy) = fan(ix,iy)
1200  END DO
1201  END IF
1202  END DO
1203 #ifdef W3_T
1204  ELSE
1205  WRITE (ndst,9021)
1206 #endif
1207  END IF
1208  !
1209  END IF
1210 
1211  !
1212  ! Process fields, write --------------------------------------------- *
1213  !
1214  IF ( WRITE ) THEN
1215  !
1216 #ifdef W3_T
1217  WRITE (ndst,9030) tf0
1218 #endif
1219  WRITE (nds,err=803,iostat=istat) tf0
1220  IF ( .NOT. fl2d ) THEN
1221  j = 1
1222  WRITE (nds,err=804,iostat=istat) &
1223  ((fa0(ix,iy),ix=1,nx),iy=1,ny)
1224  ELSE
1225  j = 1
1226  WRITE (nds,err=804,iostat=istat) &
1227  ((fx0(ix,iy),ix=1,nx),iy=1,ny)
1228  j = 2
1229  WRITE (nds,err=804,iostat=istat) &
1230  ((fy0(ix,iy),ix=1,nx),iy=1,ny)
1231  j = 3
1232  IF ( flst ) WRITE (nds,err=804,iostat=istat) &
1233  ((fa0(ix,iy),ix=1,nx),iy=1,ny)
1234  END IF
1235  !
1236  EXIT
1237  !
1238  ! Process fields, read ---------------------------------------------- *
1239  !
1240  ELSE
1241  !
1242 #ifdef W3_OASIS
1243  IF (flcoupl) THEN
1244  ! Do not receive coupling fields at the end of the first integration time in case of
1245  ! forcing with a non interpolated field (like lev, ice, ...)
1246  IF ( (id_oasis_time.EQ.0 .AND. ( flfrst .OR. cplt0 )) .OR. &
1247  (id_oasis_time.GT.0)) THEN
1248 #endif
1249  !
1250 #ifdef W3_OASACM
1251  ! Getting U10 (FXN) and V10 (FYN) from atmospheric model
1252  CALL rcv_fields_from_atmos(coupl_comm, &
1253  idfld, fxn, fyn, fan)
1254 #endif
1255 #ifdef W3_OASOCM
1256  ! Getting UCUR (CX), VCUR (CY), WLV from ocean model
1257  CALL rcv_fields_from_ocean(coupl_comm, &
1258  idfld, fxn, fyn, fan)
1259 #endif
1260 #ifdef W3_OASICM
1261  ! Getting ICEF from ice model
1262  CALL rcv_fields_from_ice(coupl_comm, &
1263  idfld, fxn, fyn, fan)
1264 #endif
1265 
1266 #ifdef W3_OASIS
1267  ! Increment the time field TFN to the next coupling time
1268  tfn(1)=t0(1)
1269  tfn(2)=t0(2)
1270  CALL tick21(tfn,dtout(7))
1271  END IF
1272  ELSE
1273 #endif
1274  READ (nds,END=800,ERR=805,IOSTAT=ISTAT) tfn
1275 #ifdef W3_T
1276  WRITE (ndst,9031) tfn
1277 #endif
1278  IF ( .NOT. fl2d ) THEN
1279  ! note: "J" here does *not* refer to data type, wlev etc.
1280  ! It refers to the dimension.
1281  j = 1
1282  READ (nds,END=806,ERR=807,IOSTAT=ISTAT) &
1283  ((fan(ix,iy),ix=1,nx),iy=1,ny)
1284  ELSE
1285  j = 1
1286  READ (nds,END=806,ERR=807,IOSTAT=ISTAT) &
1287  ((fxn(ix,iy),ix=1,nx),iy=1,ny)
1288  j = 2
1289  READ (nds,END=806,ERR=807,IOSTAT=ISTAT) &
1290  ((fyn(ix,iy),ix=1,nx),iy=1,ny)
1291 
1292  ! this was added for ISI files to store ICE in FAN and BERG in FYN
1293 
1294  IF (flbe) fan(:,:) = fxn(:,:)
1295 
1296  ! this was added for WNS files to store WND in FXN & FYN and AST in FAN
1297 
1298  j = 3
1299  IF ( flst ) READ (nds,END=806,ERR=807,IOSTAT=ISTAT) &
1300  ((fan(ix,iy),ix=1,nx),iy=1,ny)
1301  END IF
1302 #ifdef W3_OASIS
1303  END IF
1304 #endif
1305  !
1306  ! Check time, branch back if necessary
1307  !
1308  dttst = dsec21( t0 , tfn )
1309 
1310  ! Exit if the time is the first time and the field is not interpolated in time
1311 
1312  IF ( .NOT.flinterp .AND. flfrst .AND. dttst .EQ. 0. ) EXIT
1313 
1314  ! Exit if the time of the input field is larger than the current time
1315 
1316  IF ( dttst .GT. 0. ) EXIT
1317  !
1318  END IF
1319  !
1320  END DO
1321  !
1322  ! Branch point for EOF and interpolated fields (forcing current, wind or winds)
1323  !
1324 300 CONTINUE
1325 
1326  ! If the field is interpolated in time and the start time of interpolation is not set
1327  ! save the time and field values at the start time and field of interpolation
1328 
1329  IF ( .NOT.WRITE .AND. flinterp .AND. tf0(1) .EQ. -1 ) THEN
1330  !
1331 #ifdef W3_T
1332  WRITE (ndst,9040)
1333 #endif
1334  tf0(1) = t0(1)
1335  tf0(2) = t0(2)
1336  !
1337  DO ix=1, nx
1338  DO iy=1, ny
1339  fx0(ix,iy) = fxn(ix,iy)
1340  IF (fl2d) fy0(ix,iy) = fyn(ix,iy)
1341  END DO
1342  IF( flst .OR. .NOT.fl2d ) THEN
1343  DO iy=1, ny
1344  fa0(ix,iy) = fan(ix,iy)
1345  END DO
1346  END IF
1347  END DO
1348  !
1349  END IF
1350  !
1351  ! Branch point for EOF and not interpolated fields (coupled fields, ice, lev, ...)
1352  !
1353 500 CONTINUE
1354  !
1355 #ifdef W3_T
1356  IF ( flinterp ) THEN
1357  WRITE (ndst,9041) tf0, tfn
1358  ELSE
1359  WRITE (ndst,9042) tfn
1360  END IF
1361 #endif
1362  !
1363  ! Process fields, end ----------------------------------------------- *
1364  !
1365  RETURN
1366  !
1367  ! EOF escape location (have read to end of file)
1368  !
1369 800 CONTINUE
1370  ierr = -1
1371  !
1372  IF ( flinterp ) THEN
1373  tfn(1) = tn(1)
1374  tfn(2) = tn(2)
1375  CALL tick21 ( tfn , 1. )
1376  END IF
1377 #ifdef W3_T
1378  WRITE (ndst,9032) tfn, ierr
1379 #endif
1380  !
1381  IF ( flinterp ) THEN
1382  GOTO 300
1383  ELSE
1384  GOTO 500
1385  END IF
1386  !
1387  !
1388  ! Error escape locations
1389  !
1390 801 CONTINUE
1391  IF ( ndse .GE. 0 ) WRITE (ndse,1001) inxout
1392  ierr = 1
1393  RETURN
1394  !
1395 802 CONTINUE
1396  IF ( ndse .GE. 0 ) WRITE (ndse,1002) idfld
1397  ierr = 2
1398  RETURN
1399  !
1400 803 CONTINUE
1401  IF ( ndse .GE. 0 ) WRITE (ndse,1003) istat
1402  ierr = 3
1403  RETURN
1404  !
1405 804 CONTINUE
1406  IF ( ndse .GE. 0 ) WRITE (ndse,1004) j, istat
1407  ierr = 4
1408  RETURN
1409  !
1410 805 CONTINUE
1411  IF ( ndse .GE. 0 ) WRITE (ndse,1005) istat
1412  ierr = 5
1413  RETURN
1414  !
1415 806 CONTINUE
1416  IF ( ndse .GE. 0 ) WRITE (ndse,1006) j, istat
1417  ierr = 6
1418  RETURN
1419  !
1420 807 CONTINUE
1421  IF ( ndse .GE. 0 ) WRITE (ndse,1007) j, istat
1422  ierr = 7
1423  RETURN
1424  !
1425  ! Formats
1426  !
1427 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ &
1428  ' ILLEGAL INXOUT STRING : ',a/)
1429 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ &
1430  ' ILLEGAL FIELD ID STRING : ',a/)
1431 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ &
1432  ' ERROR IN WRITING TIME, IOSTAT =',i6/)
1433 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ &
1434  ' ERROR IN WRITING FIELD ',i1,', IOSTAT =',i6/)
1435 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ &
1436  ' ERROR IN READING TIME, IOSTAT =',i6/)
1437 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ &
1438  ' PRMATURE EOF READING FIELD ',i1,', IOSTAT =',i6/)
1439 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDG : '/ &
1440  ' ERROR IN READING FIELD ',i1,', IOSTAT =',i6/)
1441  !
1442 #ifdef W3_T
1443 9000 FORMAT (' TEST W3FLDG : INXOUT : ',a/ &
1444  ' IDFLD : ',a/ &
1445  ' NDS(T/E) :',3i4/ &
1446  ' MX, MY :',2i8/ &
1447  ' NX, NY :',2i8/ &
1448  ' TF0 :',i9.8,i7.6/ &
1449  ' TFN :',i9.8,i7.6/ &
1450  ' IERR :',i4)
1451 9001 FORMAT (' TEST W3FLDG : WRITE :',l4/ &
1452  ' FL2D :',l4/ &
1453  ' FLBE :',l4/ &
1454  ' FLST :',l4/ &
1455  ' FIRST :',l4)
1456 9020 FORMAT (' TEST W3FLDG : FIELD SHIFTED')
1457 9021 FORMAT (' NO FIELD TO SHIFT')
1458 9030 FORMAT (' TEST W3FLDG : WRITE TIME : ',i8,i7.6)
1459 9031 FORMAT (' TEST W3FLDG : NEW TIME : ',i8,i7.6)
1460 9032 FORMAT (' TEST W3FLDG : NEW TIME : ',i8,i7.6, &
1461  ' EOF (IERR =',i3,')')
1462 9040 FORMAT (' TEST W3FLDG : FILLING IN FIRST FIELD')
1463 9041 FORMAT (' TEST W3FLDG : FINAL TIMES: ',i8,i7.6/ &
1464  ' ',i8,i7.6)
1465 9042 FORMAT (' TEST W3FLDG : FINAL TIME : ',i8,i7.6)
1466 #endif
1467  !/
1468  !/ End of W3FLDG ----------------------------------------------------- /
1469  !/
1470  END SUBROUTINE w3fldg
1471  !/ ------------------------------------------------------------------- /
1472  SUBROUTINE w3fldd (INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, &
1473  NR, ND, NDOUT, DATA, IERR )
1474  !/
1475  !/ +-----------------------------------+
1476  !/ | WAVEWATCH III NOAA/NCEP |
1477  !/ | H. L. Tolman |
1478  !/ | FORTRAN 90 |
1479  !/ | Last update : 26-Dec-2012 |
1480  !/ +-----------------------------------+
1481  !/
1482  !/ 24-Jan-2002 : Origination. ( version 2.17 )
1483  !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 )
1484  !/
1485  ! 1. Purpose :
1486  !
1487  ! Update assimilation data in the WAVEWATCH III generic shell from
1488  ! a WAVEWATCH III shell data file or write from preprocessor.
1489  !
1490  ! 2. Method :
1491  !
1492  ! Read from file opened by W3FLDO.
1493  !
1494  ! 3. Parameters :
1495  !
1496  ! Parameter list
1497  ! ----------------------------------------------------------------
1498  ! INXOUT C*(*) I Test string for read/write, valid are:
1499  ! 'WRITE' Write a data field to file.
1500  ! 'SIZE' Get the number of records of
1501  ! next data set.
1502  ! 'READ' Read the data set found by
1503  ! 'SIZE' after allocating proper
1504  ! data array.
1505  ! IDFLD C*3 I ID string for field type, valid are:
1506  ! 'DT0', 'DT1', and 'DT2'.
1507  ! NDS Int. I Dataset number for fields file.
1508  ! NDST Int. I Dataset number for test output.
1509  ! NDSE Int. I Dataset number for error output.
1510  ! (No error output if NDSE < 0 ).
1511  ! TIME I.A. I Minimum time for data.
1512  ! TD I.A. I/O Data time.
1513  ! NR,ND Int. I Array dimensions.
1514  ! NDOUT Int. O Number of data to be read next.
1515  ! DATA R.A. I/O Data array.
1516  ! IERR Int. O Error indicator,
1517  ! -1 Past last data
1518  ! 0 OK,
1519  ! 1 : Illegal INXOUT.
1520  ! 2 : Illegal IDFLD.
1521  ! 3 : Error in writing time.
1522  ! 4 : Error in writing data.
1523  ! 5 : Error in reading time.
1524  ! 6 : Premature EOF reading data.
1525  ! 7 : Error reading data.
1526  ! ----------------------------------------------------------------
1527  !
1528  ! 4. Subroutines used :
1529  !
1530  ! Name Type Module Description
1531  ! ----------------------------------------------------------------
1532  ! STRACE Subr. Id. Subroutine tracing.
1533  ! TICK21 Subr. W3TIMEMD Advance time.
1534  ! DSEC21 Func. Id. Difference between times.
1535  ! ----------------------------------------------------------------
1536  !
1537  ! 5. Called by :
1538  !
1539  ! Name Type Module Description
1540  ! ----------------------------------------------------------------
1541  ! WW3_PREP Prog. N/A Input data preprocessor.
1542  ! WW3_SHEL Prog. N/A Basic wave model driver.
1543  ! ...... Prog. N/A Any other program that reads or
1544  ! writes WAVEWATCH III data files.
1545  ! ----------------------------------------------------------------
1546  !
1547  ! 6. Error messages :
1548  !
1549  ! See end of subroutine.
1550  !
1551  ! 7. Remarks :
1552  !
1553  ! 8. Structure :
1554  !
1555  ! See source code.
1556  !
1557  ! 9. Switches :
1558  !
1559  ! !/S Enable subroutine tracing.
1560  ! !/T Enable test output.
1561  !
1562  ! 10. Source code :
1563  !
1564  !/ ------------------------------------------------------------------- /
1565  !/
1566 #ifdef W3_S
1567  USE w3servmd, ONLY: strace
1568 #endif
1569  USE w3timemd
1570  !
1571  IMPLICIT NONE
1572  !/
1573  !/ ------------------------------------------------------------------- /
1574  !/ Parameter list
1575  !/
1576  INTEGER, INTENT(IN) :: NDS, NDST, NDSE, TIME(2), NR, ND
1577  INTEGER, INTENT(INOUT) :: TD(2), NDOUT
1578  INTEGER, INTENT(OUT) :: IERR
1579  REAL, INTENT(INOUT) :: DATA(NR,ND)
1580  CHARACTER, INTENT(IN) :: INXOUT*(*)
1581  CHARACTER(LEN=3), INTENT(IN) :: IDFLD
1582  !/
1583  !/ ------------------------------------------------------------------- /
1584  !/ Local parameters
1585  !/
1586  INTEGER :: ISTAT, NRT
1587 #ifdef W3_S
1588  INTEGER, SAVE :: IENT = 0
1589 #endif
1590  REAL :: DTTST
1591  LOGICAL :: WRITE, SIZE
1592  !/
1593  !/ ------------------------------------------------------------------- /
1594  !/
1595 #ifdef W3_S
1596  CALL strace (ient, 'W3FLDD')
1597 #endif
1598  !/
1599  ierr = 0
1600  !
1601 #ifdef W3_T
1602  WRITE (ndst,9000) inxout, idfld, nds, ndst, ndse, nr, nd, &
1603  time, td, ierr
1604 #endif
1605  !
1606  ! test input parameters ---------------------------------------------- *
1607  !
1608  IF ( inxout.NE.'READ' .AND. inxout.NE.'WRITE' .AND. &
1609  inxout.NE.'SIZE' ) GOTO 801
1610  IF ( idfld.NE.'DT0' .AND. idfld.NE.'DT1' .AND. &
1611  idfld.NE.'DT2' ) GOTO 802
1612  !
1613  ! Set internal variables --------------------------------------------- *
1614  !
1615  WRITE = inxout .EQ. 'WRITE'
1616  SIZE = inxout .EQ. 'SIZE'
1617  !
1618 #ifdef W3_T
1619  WRITE (ndst,9001) WRITE, SIZE
1620 #endif
1621  !
1622  ! Process fields, write --------------------------------------------- *
1623  !
1624  IF ( WRITE ) THEN
1625  !
1626 #ifdef W3_T
1627  WRITE (ndst,9020) td, nd
1628 #endif
1629  WRITE (nds,err=803,iostat=istat) td, nd
1630  WRITE (nds,err=804,iostat=istat) DATA
1631  !
1632  ! Process fields, read size ----------------------------------------- *
1633  !
1634  ELSE IF ( SIZE ) THEN
1635  !
1636 100 CONTINUE
1637  READ (nds,END=800,ERR=805,IOSTAT=ISTAT) TD, ndout
1638 #ifdef W3_T
1639  WRITE (ndst,9021) td, ndout
1640 #endif
1641  !
1642  ! Check time, read and branch back if necessary
1643  !
1644  dttst = dsec21( time , td )
1645  IF ( dttst.LT.0. .OR. ndout.EQ.0 ) THEN
1646  IF (ndout.GT.0) READ (nds,END=806,ERR=807,IOSTAT=ISTAT)
1647  GOTO 100
1648  END IF
1649  !
1650  ! Process fields, read data ----------------------------------------- *
1651  !
1652  ELSE
1653  !
1654  READ (nds,END=806,ERR=807,IOSTAT=ISTAT) data
1655 #ifdef W3_T
1656  WRITE (ndst,9030) td
1657 #endif
1658  END IF
1659  !
1660  ! Process fields, end ----------------------------------------------- *
1661  !
1662  RETURN
1663  !
1664  ! EOF escape location
1665  !
1666 800 CONTINUE
1667  ierr = -1
1668  RETURN
1669  !
1670  ! Error escape locations
1671  !
1672 801 CONTINUE
1673  IF ( ndse .GE. 0 ) WRITE (ndse,1001) inxout
1674  ierr = 1
1675  RETURN
1676  !
1677 802 CONTINUE
1678  IF ( ndse .GE. 0 ) WRITE (ndse,1002) idfld
1679  ierr = 2
1680  RETURN
1681  !
1682 803 CONTINUE
1683  IF ( ndse .GE. 0 ) WRITE (ndse,1003) istat
1684  ierr = 3
1685  RETURN
1686  !
1687 804 CONTINUE
1688  IF ( ndse .GE. 0 ) WRITE (ndse,1004) istat
1689  ierr = 4
1690  RETURN
1691  !
1692 805 CONTINUE
1693  IF ( ndse .GE. 0 ) WRITE (ndse,1005) istat
1694  ierr = 5
1695  RETURN
1696  !
1697 806 CONTINUE
1698  IF ( ndse .GE. 0 ) WRITE (ndse,1006) istat
1699  ierr = 6
1700  RETURN
1701  !
1702 807 CONTINUE
1703  IF ( ndse .GE. 0 ) WRITE (ndse,1007) istat
1704  ierr = 7
1705  RETURN
1706  !
1707  ! Formats
1708  !
1709 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ &
1710  ' ILLEGAL INXOUT STRING : ',a/)
1711 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ &
1712  ' ILLEGAL FIELD ID STRING : ',a/)
1713 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ &
1714  ' ERROR IN WRITING TIME, IOSTAT =',i6/)
1715 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ &
1716  ' ERROR IN WRITING DATA, IOSTAT =',i6/)
1717 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ &
1718  ' ERROR IN READING TIME, IOSTAT =',i6/)
1719 1006 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ &
1720  ' PRMATURE EOF READING DATA, IOSTAT =',i6/)
1721 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDD : '/ &
1722  ' ERROR IN READING DATA, IOSTAT =',i6/)
1723  !
1724 #ifdef W3_T
1725 9000 FORMAT (' TEST W3FLDD : INXOUT : ',a/ &
1726  ' IDFLD : ',a/ &
1727  ' NDS(T/E) :',3i4/ &
1728  ' NR, ND :',2i4/ &
1729  ' TIME :',i8,i7.6/ &
1730  ' TD :',i8,i7.6/ &
1731  ' IERR :',i4)
1732 9001 FORMAT (' TEST W3FLDD : WRITE :',l4/ &
1733  ' SIZE :',l4)
1734 9020 FORMAT (' TEST W3FLDD : WRITE TIME : ',i8,i7.6/ &
1735  ' RECORDS : ',i6)
1736 9021 FORMAT (' TEST W3FLDD : NEW TIME : ',i8,i7.6/ &
1737  ' RECORDS : ',i6)
1738 9030 FORMAT (' TEST W3FLDD : FINAL TIME : ',i8,i7.6)
1739 #endif
1740  !/
1741  !/ End of W3FLDD ----------------------------------------------------- /
1742  !/
1743  END SUBROUTINE w3fldd
1744  !/ ------------------------------------------------------------------- /
1745  SUBROUTINE w3fldp ( NDSM, NDST, NDSE, IERR, FLAGLL, &
1746  MX, MY, NX, NY, &
1747  TLAT, TLON, MAPOVR, ILAND, MXI, MYI, &
1748  NXI, NYI, CLOSED, ALAT, ALON, MASK, &
1749  RD11, RD21, RD12, RD22, IX1, IX2, IY1, IY2 )
1750  !/
1751  !/ +-----------------------------------+
1752  !/ | WAVEWATCH III NOAA/NCEP |
1753  !/ | H. L. Tolman |
1754  !/ | FORTRAN 90 |
1755  !/ | Last update : 30-Oct-2009 |
1756  !/ +-----------------------------------+
1757  !/
1758  !/ 08-Feb-1999 : Final FORTRAN 77 ( version 1.18 )
1759  !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 )
1760  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
1761  !/ (W. E. Rogers & T. J. Campbell, NRL)
1762  !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 )
1763  !/
1764  ! 1. Purpose :
1765  !
1766  ! General purpose routine for interpolating data of an irregular
1767  ! grid given by ALAT and ALON to a target grid given by TLAT and TLON.
1768  !
1769  ! 2. Method :
1770  !
1771  ! Use the grid search and remapping utilities (W3GSRUMD).
1772  ! Bi-linear interpolation.
1773  !
1774  ! 3. Parameters :
1775  !
1776  ! Parameter list
1777  ! ----------------------------------------------------------------
1778  ! NDSM Int. I Unit number message output (disabled if 0).
1779  ! NDST Int. I Unit number test output.
1780  ! NDSE Int. I Unit number error output.
1781  ! IERR Int. O Error indicator (number of lost points due
1782  ! to ap conflicts).
1783  ! FLAGLL Log. I Coordinate system flag (T=Lat/Lon, F=Cartesian)
1784  ! MX,MY Int. I Array dimensions for output type arrays.
1785  ! NX,NY Int. I Id. actual field syze.
1786  ! TLAT R.A. I Y-coordinates of output grid.
1787  ! TLON R.A. I X-coordinates of output grid.
1788  ! MAPOVR I.A. I/O Overlay map, the value of a grid point is
1789  ! incremeted by 1 of the corresponding grid
1790  ! point of the output grid is covered by the
1791  ! input grid. Land points are masked out by
1792  ! setting them to ILAND.
1793  ! ILAND Int. I Value for land points in MAPOVR (typically<0)
1794  ! MXI,MYI Int. I Array dimensions for input fields.
1795  ! NXI,NYI Int. I Id. actual field sizes.
1796  ! CLOSED Log. I Flag for closed longitude range in input.
1797  ! ALAT R.A. I Y-coordinates of input grid.
1798  ! ALON R.A. I/O X-coordinates of input grid.
1799  ! (will be modified if CLOSED)
1800  ! MASK I.A. I Land-sea mask for input field (0=land).
1801  ! RDnn R.A. O Interpolation factors (see below).
1802  ! IXn,IYn I.A. O Interpolation addresses (see below).
1803  ! ----------------------------------------------------------------
1804  !
1805  ! RD12| |RD22
1806  ! IY2 --+----------+--
1807  ! | |
1808  ! | |
1809  ! | |
1810  ! | |
1811  ! IY1 --+----------+--
1812  ! RD11| |RD21
1813  !
1814  ! IX1 IX2
1815  !
1816  !
1817  ! Internal parameters
1818  ! ----------------------------------------------------------------
1819  ! ----------------------------------------------------------------
1820  !
1821  ! 4. Subroutines used :
1822  !
1823  ! Name Type Module Description
1824  ! ----------------------------------------------------------------
1825  ! STRACE Subr. Id. Subroutine tracing.
1826  ! TICK21 Subr. W3TIMEMD Advance time.
1827  ! DSEC21 Func. Id. Difference between times.
1828  ! W3GSUC Func. W3GSRUMD Create grid-search-utility object
1829  ! W3GSUD Subr. W3GSRUMD Destroy grid-search-utility object
1830  ! W3GRMP Func. W3GSRUMD Compute interpolation weights
1831  ! ----------------------------------------------------------------
1832  !
1833  ! 5. Called by :
1834  !
1835  ! Name Type Module Description
1836  ! ----------------------------------------------------------------
1837  ! WW3_PREP Prog. N/A Input data preprocessor.
1838  ! ...... Prog. N/A Any other program that reads or
1839  ! writes WAVEWATCH III data files.
1840  ! ----------------------------------------------------------------
1841  !
1842  ! 6. Error messages :
1843  !
1844  ! 7. Remarks :
1845  !
1846  ! - Land points in the input grid are taken out of the interp.
1847  ! algorithm. If this results in zero weight factors through the
1848  ! interpolation box in the input grid, the closest 2 sea point
1849  ! for an extended 4x4 grid are used for interpolation, weighted
1850  ! by the inverse distance.
1851  ! - The "CLOSED" variable comes from ww3_prep.inp and is associated
1852  ! with the input grid (e.g. grid that winds are provided on).
1853  ! It is a logical, not an integer, so it only allows two cases:
1854  ! no closure, or simple closure. "ww3_prep" only supports these
1855  ! two (not tripole).
1856  !
1857  ! 8. Structure :
1858  !
1859  ! -----------------------------------------------------------------
1860  ! 1. Initializations.
1861  ! a Initialize counters and factors.
1862  ! b Setup logical mask
1863  ! c Create grid-search-utility object
1864  ! 2. Loop over output grid
1865  ! a Check if sea point
1866  ! b Find enclosing cell and compute interpolation weights using
1867  ! W3GRMP
1868  ! c Non-masked or partially masked cell
1869  ! d Fully masked cell
1870  ! e Update overlay map
1871  ! 2. Finalizations.
1872  ! a Final output
1873  ! b Destroy grid-search-utility object
1874  ! -----------------------------------------------------------------
1875  !
1876  ! 9. Switches :
1877  !
1878  ! !/S Enable subroutine tracing.
1879  !
1880  ! !/T Enable limited test output.
1881  ! !/T1 Enable full debugging in W3GRMP
1882  !
1883  ! 10. Source code :
1884  !
1885  !/ ------------------------------------------------------------------- /
1886  !/
1887  USE w3gsrumd
1888 #ifdef W3_S
1889  USE w3servmd, ONLY: strace
1890 #endif
1891  !
1892  IMPLICIT NONE
1893  !/
1894  !/ ------------------------------------------------------------------- /
1895  !/ Parameter list
1896  !/
1897  INTEGER, INTENT(IN) :: NDSM, NDST, NDSE, MX, MY, NX, NY, &
1898  MXI, MYI, NXI, NYI, MASK(MXI,MYI)
1899  INTEGER, INTENT(INOUT) :: MAPOVR(MX,MY), ILAND
1900  INTEGER, INTENT(OUT) :: IERR, IX1(MX,MY), IX2(MX,MY), &
1901  IY1(MX,MY), IY2(MX,MY)
1902  REAL, INTENT(IN) :: TLAT(MY,MX), TLON(MY,MX)
1903  REAL, INTENT(IN) ,TARGET :: ALAT(MXI,MYI)
1904  REAL, INTENT(INOUT),TARGET :: ALON(MXI,MYI)
1905  REAL, INTENT(OUT) :: RD11(MX,MY), RD12(MX,MY), &
1906  RD21(MX,MY), RD22(MX,MY)
1907  LOGICAL, INTENT(IN) :: FLAGLL, CLOSED
1908  !/
1909  !/ ------------------------------------------------------------------- /
1910  !/ Local parameters
1911  !/
1912 #ifdef W3_S
1913  INTEGER, SAVE :: IENT = 0
1914 #endif
1915  TYPE(t_gsu) :: GSU
1916  INTEGER :: IX, IY, I, J, NNBR, II(4), JJ(4), &
1917  MSKC, IFOUND, IMASK, ICOR1
1918  REAL :: RR(4), X, Y
1919  REAL, POINTER :: PLAT(:,:), PLON(:,:)
1920  LOGICAL :: INGRID, LMSK(MXI,MYI)
1921  LOGICAL :: LDBG = .false.
1922  INTEGER, PARAMETER :: NNBR_MAX = 2
1923  INTEGER :: ICLO
1924  !/
1925  !/ ------------------------------------------------------------------- /
1926  !/
1927 #ifdef W3_S
1928  CALL strace (ient, 'W3FLDP')
1929 #endif
1930  !
1931 #ifdef W3_T
1932  WRITE (ndst,9000) ndsm, ndst, ndse, mx, my, nx, ny, iland, &
1933  mxi, myi, nxi, nyi, closed
1934 #endif
1935  !
1936  ! 1. Initializations ------------------------------------------------ *
1937  ! 1.a Initialize counters and factors
1938  !
1939 #ifdef W3_T8
1940  ldbg = .true.
1941 #endif
1942  ierr = 0
1943  ifound = 0
1944  imask = 0
1945  icor1 = 0
1946  iclo = iclo_none
1947  IF ( flagll .AND. closed ) iclo = iclo_smpl
1948  !
1949  DO ix=1, nx
1950  DO iy=1, ny
1951  rd11(ix,iy) = 0.
1952  rd12(ix,iy) = 0.
1953  rd21(ix,iy) = 0.
1954  rd22(ix,iy) = 0.
1955  ix1(ix,iy) = 1
1956  ix2(ix,iy) = 1
1957  iy1(ix,iy) = 1
1958  iy2(ix,iy) = 1
1959  END DO
1960  END DO
1961  !
1962  ! 1.b Setup logical mask
1963  !
1964  lmsk = mask .EQ. 0
1965  !
1966  ! 1.c Create grid-search-utility object for input grid
1967  !
1968  plat => alat
1969  plon => alon
1970  gsu = w3gsuc( .true., flagll, iclo, plon, plat )
1971  !
1972 #ifdef W3_T
1973  WRITE (ndst,9001)
1974  CALL w3gsup( gsu, ndst )
1975 #endif
1976  !
1977  ! 2. Loop over output grid ------------------------------------------ *
1978  !
1979  DO iy=1, ny
1980  DO ix=1, nx
1981  !
1982  x = tlon(iy,ix)
1983  y = tlat(iy,ix)
1984 #ifdef W3_T1
1985  WRITE (ndst,9010) ix, iy, x, y
1986 #endif
1987  !
1988  ! 2.a Check if sea point
1989  !
1990  IF ( mapovr(ix,iy) .NE. iland ) THEN
1991  !
1992  ! 2.b Find enclosing cell and compute interpolation weights
1993  !
1994  nnbr = nnbr_max
1995  ingrid = w3grmp( gsu, x, y, ii, jj, rr, &
1996  mask=lmsk, mskc=mskc, nnbr=nnbr, debug=ldbg )
1997  !
1998  IF ( ingrid ) THEN
1999  !
2000  ! 2.c Non-masked or partially masked cell: simply store the weights
2001  !
2002  IF ( mskc.EQ.mskc_none .OR. mskc.EQ.mskc_part ) THEN
2003  !
2004  IF ( mskc.EQ.mskc_part ) imask = imask + 1
2005  !
2006  ! ..... Here we switch from counter-clockwise order to column-major
2007  ix1(ix,iy) = ii(1)
2008  ix2(ix,iy) = ii(2)
2009  iy1(ix,iy) = jj(1)
2010  iy2(ix,iy) = jj(4)
2011  rd11(ix,iy) = rr(1)
2012  rd21(ix,iy) = rr(2)
2013  rd12(ix,iy) = rr(4)
2014  rd22(ix,iy) = rr(3)
2015  !
2016  ! 2.d Fully masked cell
2017  !
2018  ELSE !MSKC.EQ.MSKC_FULL
2019  !
2020  imask = imask + 1
2021  !
2022  IF ( nnbr .GT. 0 ) THEN
2023  icor1 = icor1 + 1
2024  ix1(ix,iy) = ii(1)
2025  iy1(ix,iy) = jj(1)
2026  rd11(ix,iy) = rr(1)
2027  IF ( nnbr .GT. 1 ) THEN
2028  ix1(ix,iy) = ii(2)
2029  iy1(ix,iy) = jj(2)
2030  rd22(ix,iy) = rr(2)
2031  END IF
2032 #ifdef W3_T
2033  IF ( nnbr .EQ. 1 ) THEN
2034  WRITE (ndst,9043) &
2035  ix1(ix,iy), iy1(ix,iy), rd11(ix,iy)
2036  ELSE
2037  WRITE (ndst,9044) &
2038  ix1(ix,iy), iy1(ix,iy), rd11(ix,iy), &
2039  ix2(ix,iy), iy2(ix,iy), rd22(ix,iy)
2040  END IF
2041 #endif
2042  ELSE
2043  ierr = ierr + 1
2044  WRITE (ndse,910) ix, iy, x, y, &
2045  ii(1), ii(2), jj(1), jj(2)
2046  END IF ! NNBR
2047  !
2048  END IF ! MSKC
2049  !
2050 #ifdef W3_T
2051  WRITE (ndst,9031) &
2052  ix1(ix,iy), iy1(ix,iy), rd11(ix,iy), &
2053  ix2(ix,iy), iy1(ix,iy), rd21(ix,iy), &
2054  ix1(ix,iy), iy2(ix,iy), rd12(ix,iy), &
2055  ix2(ix,iy), iy2(ix,iy), rd22(ix,iy)
2056 #endif
2057  !
2058  ! 2.e Update overlay map
2059  !
2060  mapovr(ix,iy) = mapovr(ix,iy) + 1
2061  ifound = ifound + 1
2062  !
2063 #ifdef W3_T1
2064  ELSE ! .NOT.INGRID
2065  WRITE (ndst,9021)
2066 #endif
2067  END IF ! INGRID
2068 #ifdef W3_T1
2069  ELSE ! land-point
2070  WRITE (ndst,9020) ix, iy, x, y, 'LAND'
2071 #endif
2072  ENDIF ! sea-point
2073  !
2074  ! ... End loop over output grid -------------------------------------- *
2075  !
2076  END DO
2077  END DO
2078  !
2079  ! 3. Finalizations -------------------------------------------------- *
2080  ! 3.a Final output
2081  !
2082  IF (ndsm.NE.0) WRITE (ndsm,900) ifound, imask, icor1, ierr
2083  !
2084  ! 3.b Destroy grid-search-utility object
2085  !
2086  CALL w3gsud(gsu)
2087  !
2088  RETURN
2089  !
2090  ! Formats
2091  !
2092 900 FORMAT (/' *** MESSAGE W3FLDP: FINAL SEA POINT COUNT :',i8/ &
2093  ' INTERPOLATION ACROSS SHORE:',i8/ &
2094  ' CORRECTED COASTAL POINTS :',i8/ &
2095  ' UNCORRECTABLE C. POINTS :',i8/)
2096  !
2097 910 FORMAT ( ' *** WARNING W3FLDP : SEA POINT ON LAND MASK ', &
2098  '(COULD NOT BE CORRECTED)'/ &
2099  ' COORDINATES IN OUTPUT GRID :',2i4,2f8.2/ &
2100  ' X-COUNTERS IN INPUT GRID :',2i4/ &
2101  ' Y-COUNTERS IN INPUT GRID :',2i4)
2102  !
2103 #ifdef W3_T
2104 9000 FORMAT ( ' TEST W3FLDP : NDSM/T/E : ',3i8/ &
2105  ' MX, MY : ',2i8/ &
2106  ' NX, NY : ',2i8/ &
2107  ' ILAND : ',i8/ &
2108  ' MXI, MYI : ',2i8/ &
2109  ' NXI, NYI : ',2i8/ &
2110  ' CLOSED : ',l8)
2111 9001 FORMAT ( ' TEST W3FLDP : GRID SEARCH INFO -- OUTPUT FROM W3GSUP')
2112 #endif
2113  !
2114 #ifdef W3_T1
2115 9010 FORMAT ( ' TEST W3FLDP : IX =',i4,' IY =',i4, &
2116  ' LONGITUDE =',f8.2, ' LATITUDE =',f8.2, &
2117  ' ================================')
2118 9020 FORMAT ( ' TEST W3FLDP : IX =',i4,' IY =',i4, &
2119  ' LONGITUDE =',f8.2, ' LATITUDE =',f8.2, &
2120  ' (',a,')')
2121 9021 FORMAT ( ' ***** OUT OF RANGE *****')
2122 #endif
2123  !
2124 #ifdef W3_T
2125 9031 FORMAT ( ' TEST W3FLDP : FINAL INTERPOLATION DATA (IX,IY,R)', &
2126  4(/' ',2i4,f7.3))
2127 9043 FORMAT ( ' TEST W3FLDP : CORRECTED INTERPOLATION '/ &
2128  ' POINT 1 : ',2i4,f6.2)
2129 9044 FORMAT ( ' TEST W3FLDP : CORRECTED INTERPOLATION '/ &
2130  ' POINT 1 : ',2i4,f6.2/ &
2131  ' POINT 2 : ',2i4,f6.2)
2132 #endif
2133  !/
2134  !/ End of W3FLDP ----------------------------------------------------- /
2135  !/
2136  END SUBROUTINE w3fldp
2137  !/ ------------------------------------------------------------------- /
2138  SUBROUTINE w3fldh (J, NDST, NDSE, MX, MY, NX, NY, T0, TN, &
2139  NH, NHM, THO, HA, HD, HS, TF0, FX0, FY0, FS0,&
2140  TFN, FXN, FYN, FSN, IERR)
2141  !/
2142  !/ +-----------------------------------+
2143  !/ | WAVEWATCH III NOAA/NCEP |
2144  !/ | H. L. Tolman |
2145  !/ | FORTRAN 90 |
2146  !/ | Last update : 22-Mar-2021 |
2147  !/ +-----------------------------------+
2148  !/
2149  !/ 15-Jan-1999 : Final FORTRAN 77 ( version 1.18 )
2150  !/ 30-Nov-1999 : Upgrade to FORTRAN 90 ( version 2.00 )
2151  !/ 04-Sep-2003 : Bug fix par. list declaration. ( version 3.04 )
2152  !/ 05-Jul-2005 : Correct first level/ice. ( version 3.07 )
2153  !/ 15-May-2018 : Allow homog ice. ( version 6.05 )
2154  !/ 22-Mar-2021 : adds momentum and density input ( version 7.13 )
2155  !/
2156  ! 1. Purpose :
2157  !
2158  ! Update homogeneous input fields for the WAVEWATCH III generic
2159  ! shell.
2160  !
2161  ! 2. Method :
2162  !
2163  ! Variables defining the homogeneous fields are transfered through
2164  ! the parameter list (see section 3).
2165  !
2166  ! 3. Parameters :
2167  !
2168  ! Parameter list
2169  ! ----------------------------------------------------------------
2170  ! J Int I Field number of input field as in shell.
2171  ! -7 : ice parameter 1
2172  ! -6 : ice parameter 2
2173  ! -5 : ice parameter 3
2174  ! -4 : ice parameter 4
2175  ! -3 : ice parameter 5
2176  ! -2 : mud parameter 1
2177  ! -1 : mud parameter 2
2178  ! 0 : mud parameter 3
2179  ! 1 : water levels
2180  ! 2 : currents
2181  ! 3 : winds
2182  ! 4 : ice
2183  ! 5 : atmospheric momentum
2184  ! 6 : air density
2185  ! 10 : moving grid
2186  ! NDST Int. I Unit number test output.
2187  ! NDSE Int. I Unit number error messages.
2188  ! (No output if NDSE < 0).
2189  ! MX,MY Int. I Array dimensions output fields.
2190  ! NX,NY Int. I Field dimensions output fields.
2191  ! T0-N I.A. I Time interval considered.
2192  ! NH Int. I/O Number of homogeneous fields J.
2193  ! NHM Int. I Array dimension corresponding to NH.
2194  ! THO I.A. I/O Times for all homogeneous fields left.
2195  ! HA R.A. I/O Id. amplitude.
2196  ! HD R.A. I/O Id. direction (degr., Naut.).
2197  ! HS R.A. I/O Id. air-sea temperature difference (degr.).
2198  ! TF0-N I.A. I/O Times of input fields
2199  ! Fxx R.A. I/O Input fields (X, Y, Scalar)
2200  ! IERR Int. O Error indicator,
2201  ! 0 OK,
2202  ! 1 Illegal field number
2203  ! -1 Past last data
2204  ! ----------------------------------------------------------------
2205  !
2206  ! 4. Subroutines used :
2207  !
2208  ! Name Type Module Description
2209  ! ----------------------------------------------------------------
2210  ! STRACE Subr. Id. Subroutine tracing.
2211  ! TICK21 Subr. W3TIMEMD Advance time.
2212  ! DSEC21 Func. Id. Difference between times.
2213  ! ----------------------------------------------------------------
2214  !
2215  ! 5. Called by :
2216  !
2217  ! Name Type Module Description
2218  ! ----------------------------------------------------------------
2219  ! WW3_SHEL Prog. N/A Basic wave model driver.
2220  ! ----------------------------------------------------------------
2221  !
2222  ! 6. Error messages :
2223  !
2224  ! - See end of subroutine.
2225  ! - Array dimensions not checked.
2226  !
2227  ! 7. Remarks :
2228  !
2229  ! - No homogeneous ice fields available.
2230  ! - Previous fields needed only for 2-D fields.
2231  !
2232  ! 8. Structure :
2233  !
2234  ! See source code.
2235  !
2236  ! 9. Switches :
2237  !
2238  ! !/S Enable subroutine tracing.
2239  ! !/T Enable test output.
2240  !
2241  ! 10. Source code :
2242  !
2243  !/ ------------------------------------------------------------------- /
2244  !/
2245 #ifdef W3_S
2246  USE w3servmd, ONLY: strace
2247 #endif
2248  USE w3timemd
2249  !
2250  IMPLICIT NONE
2251  !/
2252  !/ ------------------------------------------------------------------- /
2253  !/ Parameter list
2254  !/
2255  INTEGER, INTENT(IN) :: J, NDST, NDSE, MX, MY, NX, NY, &
2256  T0(2), TN(2), NHM
2257  INTEGER, INTENT(INOUT) :: NH, THO(2,-7:10,NHM), TF0(2), TFN(2)
2258  INTEGER, INTENT(OUT) :: IERR
2259  REAL, INTENT(INOUT) :: HA(NHM,-7:10), HD(NHM,-7:10), HS(NHM,-7:10), &
2260  FX0(MX,MY), FY0(MX,MY), FS0(MX,MY), &
2261  FXN(MX,MY), FYN(MX,MY), FSN(MX,MY)
2262  !/
2263  !/ ------------------------------------------------------------------- /
2264  !/ Local parameters
2265  !/
2266  INTEGER :: IX, IY, I
2267 #ifdef W3_S
2268  INTEGER, SAVE :: IENT = 0
2269 #endif
2270  REAL :: X, Y, DIR, DTTST, DERA
2271  LOGICAL :: FLFRST
2272  !/
2273  !/ ------------------------------------------------------------------- /
2274  !/
2275 #ifdef W3_S
2276  CALL strace (ient, 'W3FLDH')
2277 #endif
2278  !
2279  ierr = 0
2280  dera = atan(1.)/45.
2281 
2282 
2283  !
2284 #ifdef W3_T
2285  WRITE (ndst,9000) j, ndst, ndse, mx, my, nx, ny, t0, tn, &
2286  nh, nhm, tf0, tfn, ierr
2287 #endif
2288  !
2289  ! Test field ID number for validity
2290  !
2291  IF ( j.LT.-7 .OR. j .GT.10 ) GOTO 801
2292  flfrst = tfn(1) .EQ. -1
2293  !
2294 #ifdef W3_T
2295  WRITE (ndst,9001) flfrst
2296 #endif
2297  !
2298  ! Loop over times / fields ========================================== *
2299  !
2300  DO
2301  !
2302  ! Shift fields
2303  !
2304  tf0(1) = tfn(1)
2305  tf0(2) = tfn(2)
2306  IF ( tfn(1) .NE. -1 ) THEN
2307  IF ( (j .EQ. 2) .OR. (j .EQ. 5) ) THEN
2308  DO ix=1, nx
2309  DO iy=1, ny
2310  fx0(ix,iy) = fxn(ix,iy)
2311  fy0(ix,iy) = fyn(ix,iy)
2312  END DO
2313  END DO
2314 #ifdef W3_T
2315  WRITE (ndst,9020)
2316 #endif
2317  ELSE IF ( j .EQ. 3 ) THEN
2318  DO ix=1, nx
2319  DO iy=1, ny
2320  fx0(ix,iy) = fxn(ix,iy)
2321  fy0(ix,iy) = fyn(ix,iy)
2322  fs0(ix,iy) = fsn(ix,iy)
2323  END DO
2324  END DO
2325 #ifdef W3_T
2326  WRITE (ndst,9020)
2327 #endif
2328  END IF
2329 #ifdef W3_T
2330  ELSE
2331  IF ( j .NE. 1 ) WRITE (ndst,9021)
2332 #endif
2333  END IF
2334  !
2335  ! New field
2336  !
2337  IF ( nh .NE. 0. ) THEN
2338  tfn(1) = tho(1,j,1)
2339  tfn(2) = tho(2,j,1)
2340  ! ic* md* lev ice
2341  IF ( (j.LE.1) .OR. (j.EQ.4) .OR. (j.EQ.6) ) THEN
2342  DO ix=1, nx
2343  DO iy=1, ny
2344  fsn(ix,iy) = ha(1,j)
2345  END DO
2346  END DO
2347 #ifdef W3_T
2348  WRITE (ndst,9050) ha(1,j)
2349 #endif
2350  END IF
2351  ! cur
2352  IF ( (j .EQ. 2) .OR. (j .EQ. 5) ) THEN
2353  dir = ( 270. - hd(1,j) ) * dera
2354  x = ha(1,j) * cos(dir)
2355  y = ha(1,j) * sin(dir)
2356  DO ix=1, nx
2357  DO iy=1, ny
2358  fxn(ix,iy) = x
2359  fyn(ix,iy) = y
2360  END DO
2361  END DO
2362 #ifdef W3_T
2363  WRITE (ndst,9050) x, y
2364 #endif
2365  END IF
2366  ! wnd
2367  IF ( j .EQ. 3 ) THEN
2368  dir = ( 270. - hd(1,j) ) * dera
2369  x = ha(1,j) * cos(dir)
2370  y = ha(1,j) * sin(dir)
2371  DO ix=1, nx
2372  DO iy=1, ny
2373  fxn(ix,iy) = x
2374  fyn(ix,iy) = y
2375  fsn(ix,iy) = hs(1,j)
2376  END DO
2377  END DO
2378 #ifdef W3_T
2379  WRITE (ndst,9050) x, y, hs(1,j)
2380 #endif
2381  END IF
2382  !
2383  ! Shift data arrays
2384  !
2385  DO i=1, nh-1
2386  tho(1,j,i) = tho(1,j,i+1)
2387  tho(2,j,i) = tho(2,j,i+1)
2388  ha(i,j) = ha(i+1,j)
2389  hd(i,j) = hd(i+1,j)
2390  hs(i,j) = hs(i+1,j)
2391  END DO
2392  nh = nh - 1
2393 #ifdef W3_T
2394  WRITE (ndst,9051) tfn
2395 #endif
2396  !
2397  ELSE
2398  !
2399  tfn(1) = tn(1)
2400  tfn(2) = tn(2)
2401  CALL tick21 ( tfn , 1. )
2402  ierr = -1
2403 #ifdef W3_T
2404  WRITE (ndst,9052) tfn, ierr
2405 #endif
2406  !
2407  END IF
2408  !
2409  ! Check time
2410  !
2411 
2412  dttst = dsec21( t0 , tfn )
2413 
2414  ! exit if field time is later than run time
2415  IF ( dttst .GT. 0. ) EXIT
2416  ! exit if field is ic* or md* or lev or ice
2417  ! and first forcing field has been stored
2418  ! at start run time
2419  IF ( j.LE.(1).OR.(j.EQ.4).OR.(j.EQ.6) ) THEN
2420  IF (flfrst .AND. dttst.EQ.0. ) EXIT
2421  END IF
2422  END DO
2423  !
2424  ! Check if first field
2425  !
2426  IF ( j.NE.1 .AND. tfn(1) .EQ. -1 ) THEN
2427 #ifdef W3_T
2428  WRITE (ndst,9060)
2429 #endif
2430  tf0(1) = t0(1)
2431  tf0(2) = t0(2)
2432  !
2433  DO ix=1, nx
2434  DO iy=1, ny
2435  fx0(ix,iy) = fxn(ix,iy)
2436  fy0(ix,iy) = fyn(ix,iy)
2437  fs0(ix,iy) = fsn(ix,iy)
2438  END DO
2439  END DO
2440  END IF
2441  !
2442 #ifdef W3_T
2443  IF ( j .GT. 1 ) THEN
2444  WRITE (ndst,9061) tf0, tfn
2445  ELSE
2446  WRITE (ndst,9062) tfn
2447  END IF
2448 #endif
2449  !
2450  RETURN
2451  !
2452  ! Error escape locations
2453  !
2454 801 CONTINUE
2455  IF ( ndse .GE. 0 ) WRITE (ndse,1001) j
2456  ierr = 1
2457  RETURN
2458  !
2459  ! Formats
2460  !
2461 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDH : '/ &
2462  ' ILLEGAL FIELD ID NR : ',i4/)
2463  !
2464 #ifdef W3_T
2465 9000 FORMAT (' TEST W3FLDH : J, NDST/E : ',3i4/ &
2466  ' DIMENSIONS : ',4i4/ &
2467  ' T0 : ',i8,i7.6/ &
2468  ' TN : ',i8,i7.6/ &
2469  ' NH(M) : ',2i4/ &
2470  ' TF0 : ',i8,i7.6/ &
2471  ' TFN, IERR : ',i8,i7.6,i4)
2472 9001 FORMAT (' TEST W3FLDH : FIRST FIELD : ',l2)
2473 9020 FORMAT (' TEST W3FLDH : FIELD SHIFTED')
2474 9021 FORMAT (' NO FIELD TO SHIFT')
2475 9050 FORMAT (' TEST W3FLDH : NEW VALUE(S) : ',3f8.2)
2476 9051 FORMAT (' TEST W3FLDH : NEW TIME : ',i8,i7.6)
2477 9052 FORMAT (' TEST W3FLDH : NEW TIME : ',i8,i7.6, &
2478  ' LAST FIELD (IERR =',i3,')')
2479 9060 FORMAT (' TEST W3FLDH : FILLING IN FIRST FIELD')
2480 9061 FORMAT (' TEST W3FLDH : FINAL TIMES : ',i8,i7.6/ &
2481  ' ',i8,i7.6)
2482 9062 FORMAT (' TEST W3FLDH : FINAL TIME : ',i8,i7.6)
2483 #endif
2484  !/
2485  !/ End of W3FLDH ----------------------------------------------------- /
2486  !/
2487  END SUBROUTINE w3fldh
2488  !/ ------------------------------------------------------------------- /
2489  SUBROUTINE w3fldm (J, NDST, NDSE, T0, TN, NH, NHM, THO, HA, HD, &
2490  TF0, A0, D0, TFN, AN, DN, IERR)
2491  !/
2492  !/ +-----------------------------------+
2493  !/ | WAVEWATCH III NOAA/NCEP |
2494  !/ | H. L. Tolman |
2495  !/ | FORTRAN 90 |
2496  !/ | Last update : 26-Dec-2002 |
2497  !/ +-----------------------------------+
2498  !/
2499  !/ 26-Dec-2002 : Origination. ( version 3.02 )
2500  !/
2501  ! 1. Purpose :
2502  !
2503  ! Update moving grid info for the WAVEWATCH III generic
2504  ! shell.
2505  !
2506  ! 2. Method :
2507  !
2508  ! Variables defining the homogeneous fields are transfered through
2509  ! the parameter list (see section 3).
2510  !
2511  ! 3. Parameters :
2512  !
2513  ! Parameter list
2514  ! ----------------------------------------------------------------
2515  ! J Int I Field number, should be 4.
2516  ! NDST Int. I Unit number test output.
2517  ! NDSE Int. I Unit number error messages.
2518  ! (No output if NDSE < 0).
2519  ! T0-N I.A. I Time interval considered.
2520  ! NH Int. I/O Number of homogeneous fields J.
2521  ! NHM Int. I Array dimension corresponding to NH.
2522  ! THO I.A. I/O Times for all homogeneous fields left.
2523  ! HA R.A. I/O Id. amplitude.
2524  ! HD R.A. I/O Id. direction (degr., Naut.).
2525  ! TF0-N I.A. I/O Times of input fields
2526  ! A/D0/N R.A. I/O Input data.
2527  ! IERR Int. O Error indicator,
2528  ! 0 OK,
2529  ! 1 Illegal field number
2530  ! -1 Past last data
2531  ! ----------------------------------------------------------------
2532  !
2533  ! 4. Subroutines used :
2534  !
2535  ! Name Type Module Description
2536  ! ----------------------------------------------------------------
2537  ! STRACE Subr. Id. Subroutine tracing.
2538  ! TICK21 Subr. W3TIMEMD Advance time.
2539  ! DSEC21 Func. Id. Difference between times.
2540  ! ----------------------------------------------------------------
2541  !
2542  ! 5. Called by :
2543  !
2544  ! Name Type Module Description
2545  ! ----------------------------------------------------------------
2546  ! WW3_SHEL Prog. N/A Basic wave model driver.
2547  ! ----------------------------------------------------------------
2548  !
2549  ! 6. Error messages :
2550  !
2551  ! - See end of subroutine.
2552  ! - Array dimensions not checked.
2553  !
2554  ! 7. Remarks :
2555  !
2556  ! 8. Structure :
2557  !
2558  ! See source code.
2559  !
2560  ! 9. Switches :
2561  !
2562  ! !/S Enable subroutine tracing.
2563  ! !/T Enable test output.
2564  !
2565  ! 10. Source code :
2566  !
2567  !/ ------------------------------------------------------------------- /
2568  !/
2569 #ifdef W3_S
2570  USE w3servmd, ONLY: strace
2571 #endif
2572  USE w3timemd
2573  !
2574  IMPLICIT NONE
2575  !/
2576  !/ ------------------------------------------------------------------- /
2577  !/ Parameter list
2578  !/
2579  INTEGER, INTENT(IN) :: J, NDST, NDSE, T0(2), TN(2), NHM
2580  INTEGER, INTENT(INOUT) :: NH, THO(2,-7:10,NHM), TF0(2), TFN(2)
2581  INTEGER, INTENT(OUT) :: IERR
2582  REAL, INTENT(INOUT) :: HA(NHM,-7:10), HD(NHM,-7:10), A0, AN, D0, DN
2583  !/
2584  !/ ------------------------------------------------------------------- /
2585  !/ Local parameters
2586  !/
2587  INTEGER :: I
2588 #ifdef W3_S
2589  INTEGER, SAVE :: IENT = 0
2590 #endif
2591  REAL :: DTTST, DERA
2592  LOGICAL :: FLFRST
2593  !/
2594  !/ ------------------------------------------------------------------- /
2595  !/
2596 #ifdef W3_S
2597  CALL strace (ient, 'W3FLDM')
2598 #endif
2599  !
2600  ierr = 0
2601  dera = atan(1.)/45.
2602  !
2603 #ifdef W3_T
2604  WRITE (ndst,9000) j, ndst, ndse, t0, tn, nh, nhm, tf0, tfn, ierr
2605 #endif
2606  !
2607  ! Test field ID number for validity
2608  !
2609  IF ( j .NE. 4 ) GOTO 801
2610  flfrst = tfn(1) .EQ. -1
2611  !
2612 #ifdef W3_T
2613  WRITE (ndst,9001) flfrst
2614 #endif
2615  !
2616  ! Backward branch point ============================================= *
2617  !
2618 100 CONTINUE
2619  !
2620  ! Shift data
2621  !
2622  tf0(1) = tfn(1)
2623  tf0(2) = tfn(2)
2624  IF ( tfn(1) .NE. -1 ) THEN
2625  a0 = an
2626  d0 = dn
2627 #ifdef W3_T
2628  WRITE (ndst,9020)
2629  ELSE
2630  WRITE (ndst,9021)
2631 #endif
2632  END IF
2633  !
2634  ! New field
2635  !
2636  IF ( nh .NE. 0. ) THEN
2637  tfn(1) = tho(1,j,1)
2638  tfn(2) = tho(2,j,1)
2639  an = ha(1,j)
2640  dn = ( 90. - hd(1,j) ) * dera
2641 #ifdef W3_T
2642  WRITE (ndst,9050) an, dn
2643 #endif
2644  !
2645  ! Shift data arrays
2646  !
2647  DO i=1, nh-1
2648  tho(1,j,i) = tho(1,j,i+1)
2649  tho(2,j,i) = tho(2,j,i+1)
2650  ha(i,j) = ha(i+1,j)
2651  hd(i,j) = hd(i+1,j)
2652  END DO
2653  nh = nh - 1
2654 #ifdef W3_T
2655  WRITE (ndst,9051) tfn
2656 #endif
2657  !
2658  ELSE
2659  !
2660  tfn(1) = tn(1)
2661  tfn(2) = tn(2)
2662  CALL tick21 ( tfn , 1. )
2663  ierr = -1
2664 #ifdef W3_T
2665  WRITE (ndst,9052) tfn, ierr
2666 #endif
2667  !
2668  END IF
2669  !
2670  ! Check time
2671  !
2672  dttst = dsec21( t0 , tfn )
2673  IF ( dttst .LE. 0. ) GOTO 100
2674  !
2675  ! Check if first field
2676  !
2677  IF ( tf0(1).EQ.-1 ) THEN
2678 #ifdef W3_T
2679  WRITE (ndst,9060)
2680 #endif
2681  tf0(1) = t0(1)
2682  tf0(2) = t0(2)
2683  a0 = an
2684  d0 = dn
2685  END IF
2686  !
2687 #ifdef W3_T
2688  WRITE (ndst,9061) tf0, tfn
2689 #endif
2690  !
2691  RETURN
2692  !
2693  ! Error escape locations
2694  !
2695 801 CONTINUE
2696  IF ( ndse .GE. 0 ) WRITE (ndse,1001) j
2697  ierr = 1
2698  RETURN
2699  !
2700  ! Formats
2701  !
2702 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3FLDM : '/ &
2703  ' ILLEGAL FIELD ID NR : ',i4/)
2704  !
2705 #ifdef W3_T
2706 9000 FORMAT (' TEST W3FLDM : J, NDST/E : ',3i4/ &
2707  ' T0 : ',i8,i7.6/ &
2708  ' TN : ',i8,i7.6/ &
2709  ' NH(M) : ',2i4/ &
2710  ' TF0 : ',i8,i7.6/ &
2711  ' TFN, IERR : ',i8,i7.6,i4)
2712 9001 FORMAT (' TEST W3FLDM : FIRST FIELD : ',l2)
2713 9020 FORMAT (' TEST W3FLDM : FIELD SHIFTED')
2714 9021 FORMAT (' NO FIELD TO SHIFT')
2715 9050 FORMAT (' TEST W3FLDM : NEW VALUE(S) : ',2f8.2)
2716 9051 FORMAT (' TEST W3FLDM : NEW TIME : ',i8,i7.6)
2717 9052 FORMAT (' TEST W3FLDM : NEW TIME : ',i8,i7.6, &
2718  ' LAST FIELD (IERR =',i3,')')
2719 9060 FORMAT (' TEST W3FLDM : FILLING IN FIRST FIELD')
2720 9061 FORMAT (' TEST W3FLDM : FINAL TIMES : ',i8,i7.6/ &
2721  ' ',i8,i7.6)
2722 #endif
2723  !/
2724  !/ End of W3FLDM ----------------------------------------------------- /
2725  !/
2726  END SUBROUTINE w3fldm
2727  !/
2728  !/ End of module W3FLDSMD -------------------------------------------- /
2729  !/
2730 END MODULE w3fldsmd
w3timemd::dsec21
real function dsec21(TIME1, TIME2)
Definition: w3timemd.F90:333
w3tidemd::tidecon_namei
character(len=5), dimension(:), allocatable tidecon_namei
Definition: w3tidemd.F90:111
w3fldsmd::w3fldd
subroutine w3fldd(INXOUT, IDFLD, NDS, NDST, NDSE, TIME, TD, NR, ND, NDOUT, DATA, IERR)
Definition: w3fldsmd.F90:1474
w3agcmmd
Module used for coupling applications between atmospheric model and WW3 with OASIS3-MCT.
Definition: w3agcmmd.F90:23
w3fldsmd::w3fldtide1
subroutine w3fldtide1(INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IERR)
Definition: w3fldsmd.F90:531
w3tidemd
Definition: w3tidemd.F90:3
w3fldsmd::w3fldh
subroutine w3fldh(J, NDST, NDSE, MX, MY, NX, NY, T0, TN, NH, NHM, THO, HA, HD, HS, TF0, FX0, FY0, FS0, TFN, FXN, FYN, FSN, IERR)
Definition: w3fldsmd.F90:2141
w3tidemd::tidal_const
real, dimension(:,:,:,:,:), allocatable tidal_const
Definition: w3tidemd.F90:117
w3odatmd::dtout
real, dimension(:), pointer dtout
Definition: w3odatmd.F90:467
w3gsrumd
Definition: w3gsrumd.F90:17
w3gsrumd::iclo_smpl
integer, parameter, public iclo_smpl
Definition: w3gsrumd.F90:315
w3odatmd::iaproc
integer, pointer iaproc
Definition: w3odatmd.F90:457
w3igcmmd::rcv_fields_from_ice
subroutine, public rcv_fields_from_ice(ID_LCOMM, IDFLD, FXN, FYN, FAN)
Receive coupling fields from ice model.
Definition: w3igcmmd.F90:181
w3agcmmd::rcv_fields_from_atmos
subroutine, public rcv_fields_from_atmos(ID_LCOMM, IDFLD, FXN, FYN, FAN)
Receive coupling fields from atmospheric model.
Definition: w3agcmmd.F90:235
w3fldsmd::w3fldm
subroutine w3fldm(J, NDST, NDSE, T0, TN, NH, NHM, THO, HA, HD, TF0, A0, D0, TFN, AN, DN, IERR)
Definition: w3fldsmd.F90:2491
w3gsrumd::iclo_none
integer, parameter, public iclo_none
Definition: w3gsrumd.F90:314
w3servmd
Definition: w3servmd.F90:3
w3timemd::tick21
subroutine tick21(TIME, DTIME)
Definition: w3timemd.F90:84
w3ogcmmd
Definition: w3ogcmmd.F90:3
w3odatmd
Definition: w3odatmd.F90:3
w3oacpmd
Definition: w3oacpmd.F90:3
w3gsrumd::w3gsud
subroutine, public w3gsud(GSU)
Definition: w3gsrumd.F90:790
w3gsrumd::mskc_none
integer, parameter, public mskc_none
Definition: w3gsrumd.F90:281
file
file(STRINGS ${CMAKE_BINARY_DIR}/switch switch_strings) separate_arguments(switches UNIX_COMMAND $
Definition: CMakeLists.txt:3
w3igcmmd
Module used for coupling applications between ice model and WW3 with OASIS3-MCT.
Definition: w3igcmmd.F90:15
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3oacpmd::id_oasis_time
integer, public id_oasis_time
Definition: w3oacpmd.F90:78
w3idatmd
Define data structures to set up wave model input data for several models simultaneously.
Definition: w3idatmd.F90:16
w3tidemd::tidecon_name
character(len=5), dimension(:), allocatable tidecon_name
Definition: w3tidemd.F90:112
w3oacpmd::cplt0
logical, public cplt0
Definition: w3oacpmd.F90:80
w3tidemd::tide_mf
integer tide_mf
Definition: w3tidemd.F90:109
w3gsrumd::mskc_part
integer, parameter, public mskc_part
Definition: w3gsrumd.F90:282
constants
Define some much-used constants for global use (all defined as PARAMETER).
Definition: constants.F90:20
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
w3tidemd::tide_freqc
real, dimension(:), allocatable tide_freqc
Definition: w3tidemd.F90:110
w3fldsmd::w3fldtide2
subroutine w3fldtide2(INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IDAT, IERR)
Definition: w3fldsmd.F90:722
w3gsrumd::w3gsup
subroutine, public w3gsup(GSU, IUNIT, LFULL)
Definition: w3gsrumd.F90:885
w3fldsmd::w3fldo
subroutine w3fldo(INXOUT, IDFLD, NDS, NDST, NDSE, NX, NY, GTYPE, IERR, FEXT, FPRE, FHDR, TIDEFLAGIN)
Definition: w3fldsmd.F90:90
w3ogcmmd::rcv_fields_from_ocean
subroutine, public rcv_fields_from_ocean(ID_LCOMM, IDFLD, FXN, FYN, FAN)
Definition: w3ogcmmd.F90:407
w3timemd
Definition: w3timemd.F90:3
w3gsrumd::t_gsu
Definition: w3gsrumd.F90:325
w3fldsmd
Definition: w3fldsmd.F90:3