WAVEWATCH III  beta 0.0.1
ww3_prnc.F90
Go to the documentation of this file.
1 
7 
8 #include "w3macros.h"
9 #define CHECK_ERR(I) CHECK_ERROR(I, __LINE__)
10 !/ ------------------------------------------------------------------- /
11 
22 PROGRAM w3prnc
23  !/
24  !/ +-----------------------------------+
25  !/ | WAVEWATCH III NOAA/NCEP |
26  !/ | M. Accensi |
27  !/ | F. Ardhuin |
28  !/ | FORTRAN 90 |
29  !/ | Last update : 22-Mar-2021 |
30  !/ +-----------------------------------+
31  !/
32  !/ 01-Jan-2011 : Creation ( version 4.01 )
33  !/ 17-Nov-2011 : Fix bug on latitudes ( version 4.04 )
34  !/ 30-Sep-2012 : Implement tidal analysis ( version 4.08 )
35  !/ 29-Oct-2012 : Parallelization of tidal analysis ( version 4.08 )
36  !/ 4-Mar-2012 : allows any NetCDF dimensions names ( version 4.09 )
37  !/ 13-Mar-2012 : Makes compatible with NC3 ( version 4.10 )
38  !/ 18-Oct-2013 : Debug compile issue with TIDE switch( version 4.12 )
39  !/ 18-Oct-2013 : Initialize interpolation weights ( version 4.12 )
40  !/ 20-Dec-2013 : Allow scale factor and offset in ( version 4.16 )
41  !/ NetCDF variables (S. Zieger)
42  !/ 24-Oct-2014 : Allows "As Is" curvilinear grids ( version 5.02 )
43  !/ 14-Oct-2015 : Add a check for latitude reversed ( version 5.11 )
44  !/ 20-Jan-2017 : Update to new W3GSRUMD APIs ( version 6.02 )
45  !/ 04-Jan-2018 : Add namelist feature ( version 6.04 )
46  !/ 21-Apr-2020 : Correction in MPI for tide ( version 7.13 )
47  !/ 21-Apr-2020 : Correction in scale factor ( version 7.13 )
48  !/ 22-Mar-2021 : Add momentum and air density ( version 7.13 )
49  !/
50  !/ Copyright 2009 National Weather Service (NWS),
51  !/ National Oceanic and Atmospheric Administration. All rights
52  !/ reserved. WAVEWATCH III is a trademark of the NWS.
53  !/ No unauthorized use without permission.
54  !/
55  ! 1. Purpose :
56  !
57  ! Pre-processing of the input water level, current, wind, ice
58  ! fields, momentum and air density, as well as assimilation data
59  ! ... from NetCDF input
60  !
61  ! 2. Method :
62  !
63  ! See documented input file.
64  !
65  ! 3. Parameters :
66  !
67  ! Local parameters.
68  ! ----------------------------------------------------------------
69  ! NDSI Int. Input unit number ("ww3_prnc.inp").
70  ! NDSLL Int. Unit number(s) of long-lat file(s)
71  ! NDSF I.A. Unit number(s) of input file(s).
72  ! NDSDAT Int. Unit number for output data file.
73  ! IFLD Int. Integer input type.
74  ! ITYPE Int. Integer input 'format' type.
75  ! NFCOMP Int. Number of partial input to be processed.
76  ! FLTIME Log. Time flag for input fields, if false, single
77  ! field, time read from NDSI.
78  ! IDLALL Int. Layout indicator used by INA2R. +
79  ! IDFMLL Int. Id. FORMAT indicator. |
80  ! FORMLL C*16 Id. FORMAT. | Long-lat
81  ! FROMLL C*4 'UNIT' / 'NAME' indicator | file(s)
82  ! NAMELL C*20 Name of long-lat file(s) +
83  ! IDLAF I.A. +
84  ! IDFMF I.A. |
85  ! FORMF C.A. | Idem. fields file(s)
86  ! NAMEF C*20 +
87  ! FORMT C.A. Format or time in field.
88  ! XC R.A. Components of input vector field or first
89  ! input scalar field
90  ! XCFAC Real Scale factor for input scalar field
91  ! XCOFF Real Offset for input scalar field
92  ! YC R.A. Components of input vector field or second
93  ! input scalar field
94  ! YCFAC Real Scale factor for input scalar field
95  ! YCOFF Real Offset for input scalar field
96  ! FX,FY R.A. Output fields.
97  ! ACC Real Required interpolation accuracy.
98  ! XTEMP R.A. Temporal array
99  ! ----------------------------------------------------------------
100  !
101  ! 4. Subroutines used :
102  !
103  ! Name Type Module Description
104  ! ----------------------------------------------------------------
105  ! W3NMOD Subr. W3GDATMD Set number of model.
106  ! W3SETG Subr. Id. Point to selected model.
107  ! W3NDAT Subr. W3WDATMD Set number of model for wave data.
108  ! W3SETW Subr. Id. Point to selected model for wave data.
109  ! W3NOUT Subr. W3ODATMD Set number of model for output.
110  ! W3SETO Subr. Id. Point to selected model for output.
111  ! ITRACE Subr. W3SERVMD Subroutine tracing initialization.
112  ! STRACE Subr. Id. Subroutine tracing.
113  ! NEXTLN Subr. Id. Get next line from input filw
114  ! EXTCDE Subr. Id. Abort program as graceful as possible.
115  ! STME21 Subr. W3TIMEMD Convert time to string.
116  ! INAR2R Subr. W3ARRYMD Read in an REAL array.
117  ! INAR2I Subr. Id. Read in an INTEGER array.
118  ! PRTBLK Subr. Id. Print plot of array.
119  ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file.
120  ! W3FLDO Subr. W3FLDSMD Opening of WAVEWATCH III generic shell
121  ! data file.
122  ! W3FLDP Subr. Id. Prepare interp. from arbitrary grid.
123  ! W3FLDG Subr. Id. Reading/writing shell input data.
124  ! W3FLDD Subr. Id. Reading/writing shell assim. data.
125  ! W3GSUC Func. W3GSRUMD Create grid-search-utility object
126  ! W3GSUD Subr. W3GSRUMD Destroy grid-search-utility object
127  ! W3GRMP Func. W3GSRUMD Compute interpolation weights
128  ! ----------------------------------------------------------------
129  !
130  ! 5. Called by :
131  !
132  ! None, stand-alone program.
133  !
134  ! 6. Error messages :
135  !
136  ! - Checks on files and reading from file.
137  ! - Checks on validity of input parameters.
138  !
139  ! 7. Remarks :
140  !
141  ! - Input fields need to be continuous in longitude and latitude.
142  ! - Program attempts to detect closure type using longitudes of the
143  ! grid. Thus, it does not allow the user to specify the closure
144  ! type, and so tripole closure is not supported.
145  !
146  ! 8. Structure :
147  !
148  ! ----------------------------------------------------
149  ! 1.a Number of models.
150  ! ( W3NMOD , W3NOUT , W3SETG , W3SETO )
151  ! b I-O setup.
152  ! c Print heading(s).
153  ! 2. Read model definition file. ( W3IOGR )
154  ! 3.a Read major types from input file.
155  ! b Check major types.
156  ! c Additional input format types and time.
157  ! 4. Prepare interpolation.
158  ! a Longitude - latitude grid
159  ! b Grid(s) from file. ( W3FLDP )
160  ! c Initialize fields.
161  ! d Input location and format.
162  ! 5 Prepare input and output files.
163  ! a Open input file
164  ! b Open and prepare output file ( W3FLDO )
165  ! 6 Until end of file
166  ! a Read new time and fields
167  ! b Interpolate fields
168  ! c Write fields ( W3FLDG )
169  ! ----------------------------------------------------
170  !
171  ! 9. Switches :
172  !
173  ! !/WNT0 = !/WNT1
174  ! !/WNT1 Correct wind speeds to (approximately) conserve the wind
175  ! speed over the interpolation box.
176  ! !/WNT2 Id. energy (USE ONLY ONE !)
177  ! !/CRT1 Like !/WNT1 for currents.
178  ! !/CRT2 Like !/WNT2 for currents.
179  ! !/MPI Parallel processing is used for tidal analysis.
180  !
181  ! !/O3 Additional output in fields processing loop.
182  ! !/O15 Generate file with the times of the processed fields.
183  !
184  ! !/S Enable subroutine tracing.
185  ! !/T Enable test output,
186  ! !/T1 Full interpolation data.
187  ! !/T1a Echo of lat-long data in type Fn
188  ! !/T2 Full input data.
189  ! !/T3 Print-plot of output data.
190  !
191  ! !/NCO NCEP NCO modifications for operational implementation.
192  !
193  ! 10. Source code :
194  !
195  !/ ------------------------------------------------------------------- /
196  USE constants
197  !/
198  ! USE W3GDATMD, ONLY: W3NMOD, W3SETG
199 #ifdef W3_NL1
200  USE w3adatmd,ONLY: w3naux, w3seta
201 #endif
202  USE w3odatmd, ONLY: w3nout, w3seto
203  USE w3odatmd, ONLY: iaproc, naproc, naperr, napout
204  USE w3servmd, ONLY : itrace, nextln, extcde, strsplit
205 #ifdef W3_S
206  USE w3servmd, ONLY : strace
207 #endif
208  USE w3arrymd, ONLY : ina2r, ina2i
209 #ifdef W3_T2
210  USE w3arrymd, ONLY : prtblk
211 #endif
212 #ifdef W3_T3
213  USE w3arrymd, ONLY : prtblk
214 #endif
215  USE w3iogrmd, ONLY: w3iogr
216  USE w3fldsmd, ONLY: w3fldo, w3fldp, w3fldg, w3fldd, &
217  w3fldtide1, w3fldtide2
218  !/
219  USE w3gdatmd
220  USE w3gsrumd
221  USE w3odatmd, ONLY: ndse, ndst, ndso, fnmpre
222 
223  USE w3tidemd
224  USE w3timemd
225  USE w3nmlprncmd
226  USE netcdf
227  !
228  IMPLICIT NONE
229  !
230 #ifdef W3_MPI
231  include "mpif.h"
232 #endif
233  !/
234  !/ ------------------------------------------------------------------- /
235  !/ Local parameters
236  !/
237  TYPE(nml_forcing_t) :: nml_forcing
238  TYPE(nml_file_t) :: nml_file
239  TYPE(t_gsu) :: gsi
240  !
241  INTEGER :: nti, ndsen, nidims, nfields, iclo, &
242  ndsi, ndsm, ndsdat, ndstrc, ntrace, &
243  ierr, ifld, itype, j, nfcomp, &
244  ix, iy, jx, nxi, nyi, ndat, jj, &
245  ndsll, idlall, idfmll, ncid, iret, &
246  mxm, mym, dattyp, recldt, idat, &
247  ndimsgrid, ndimsvar, varidtmp, &
248  numdims, i, itime
249  INTEGER :: iland = -999
250  INTEGER :: gtypedum = 0
251 
252  !
253  INTEGER :: time(2), timestart(2), timestop(2), &
254  timeshift(2), nxj(2), nyj(2), &
255  ndsf(2), idlaf(2), idfmf(2), &
256  is(4), js(4), varidf(50), dimsvar(4),&
257  dimln(5), refdate(8),curdate(8), &
258  startdate(8),stpdate(8)
259 #ifdef W3_MPI
260  INTEGER :: ierr_mpi, ind, rest, slice
261 #endif
262 #ifdef W3_O15
263  INTEGER :: ndstime
264 #endif
265 #ifdef W3_S
266  INTEGER, SAVE :: ient = 0
267 #endif
268 #ifdef W3_T2
269  INTEGER :: ixp0, ixpn, ixpwdt = 60
270 #endif
271 #ifdef W3_T3
272  INTEGER :: ix0, ixn, ixwdt = 60
273 #endif
274  !
275  INTEGER, ALLOCATABLE :: ix21(:,:), ix22(:,:), &
276  iy21(:,:), iy22(:,:), &
277  jx21(:,:), jx22(:,:), &
278  jy21(:,:), jy22(:,:), &
279  mapovr(:,:), mask(:,:), &
280  nelem(:), cumul(:)
281 #ifdef W3_T3
282  INTEGER, ALLOCATABLE :: mapout(:,:)
283 #endif
284  !
285  REAL :: x0i, xni, y0i, yni, sxi, syi, &
286  x, y, factor, efac, nodata, &
287  xcfac, xcoff, ycfac, ycoff, &
288  fillvalue, timedelay
289  REAL :: acc = 0.05
290  !
291  REAL :: scfac(2), addoff(2), rw(4)
292  !
293  REAL, ALLOCATABLE :: rd11(:,:), rd21(:,:), &
294  rd12(:,:), rd22(:,:), &
295  xd11(:,:), xd21(:,:), &
296  xd12(:,:), xd22(:,:), &
297  fx(:,:), fy(:,:), fa(:,:), &
298  a1(:,:), a2(:,:), a3(:,:)
299  REAL, ALLOCATABLE :: xc(:,:), yc(:,:), ac(:,:), &
300  data(:,:), xtemp(:,:)
301  !
302  REAL, ALLOCATABLE, TARGET :: ala(:,:), alo(:,:)
303  REAL, POINTER :: ptr_ala(:,:), ptr_alo(:,:)
304  !
305  DOUBLE PRECISION :: refjulday, curjulday, startjulday, stpjulday
306  !
307  CHARACTER*1024 :: strfieldsname
308  CHARACTER*100 :: fieldsname(4)
309  CHARACTER*1024 :: strdimsname
310  CHARACTER*100 :: dimsname(2)
311  CHARACTER :: comstr*1, idfld*3, idtype*2, &
312  idtime*23, fromll*4, formll*16, &
313  namell*80, namef*80, idtime2*23
314  CHARACTER*14 :: idstr1(-7:7)
315  CHARACTER*15 :: idstr3(3)
316  CHARACTER*32 :: formt(2), formf(2)
317  CHARACTER*20 :: idstr2(6)
318  CHARACTER*20 :: dimname(5)
319  CHARACTER*50 :: timeunits, calendar
320  !
321  LOGICAL :: ingrid, flgnml
322  LOGICAL :: flstab, flberg, clo(2), fltime, flhdr
323 #ifdef W3_T
324  LOGICAL :: flmod
325 #endif
326 
327 
328 
329  !
330  ! Variables used in tidal analysis
331  !
332  INTEGER :: k, l, tideflag, &
333  tide_ndef, tide_itrend
334 #ifdef W3_T
335  INTEGER, PARAMETER :: lrb = 4
336  INTEGER(KIND=8) :: rpos
337  INTEGER :: lrecl, nrec
338 #endif
339  !
340  INTEGER, ALLOCATABLE :: imax(:)
341  !
342  REAL :: tide_lat
343  !
344  REAL, ALLOCATABLE :: tide_data_all(:,:,:), &
345  ssq(:), res(:)
346 #ifdef W3_MPI
347  REAL, ALLOCATABLE :: tide1dl(:), tide1d(:)
348 #endif
349 #ifdef W3_T
350  REAL(kind=lrb), ALLOCATABLE :: nullbuff(:)
351 #endif
352  !
353  DOUBLE PRECISION, ALLOCATABLE :: alltimes(:), &
354  sdev0(:), sdev(:), rmsr(:), &
355  rmsr0(:), rmsrp(:), resmax(:)
356  !
357  CHARACTER*256 :: tideconstnames
358  CHARACTER*100 :: list(70)
359  !
360  LOGICAL, ALLOCATABLE :: tidalcomp(:,:)
361  !
362 #ifdef W3_T
363  CHARACTER*21 :: fnametxt
364 #endif
365  !
366  equivalence( nxi , nxj(1) ) , ( nyi , nyj(1) )
367  !/
368  !/ ------------------------------------------------------------------- /
369  !/
370  DATA idstr1 / 'ice thickness ' , 'ice viscosity' , &
371  'ice density ' , 'ice modulus ' , &
372  'ice flow diam.' , 'mud density ' , &
373  'mud thickness ' , 'mud viscosity ', &
374  'ice conc. ' , 'water levels ' , &
375  'winds ' , 'currents ' , &
376  'data ' , 'momentum ' , &
377  'air density ' /
378  DATA idstr2 / 'pre-processed file ' , 'long.-lat. grid ' , &
379  'grid from file (1) ' , 'grid from file (2) ' , &
380  'data (assimilation) ' , 'pre-pro. file + tide' /
381  DATA idstr3 / 'mean parameters', '1D spectra ', &
382  '2D spectra ' /
383  !
384 #ifdef W3_NCO
385  ! CALL W3TAGB('WAVEPREP',1998,0007,0050,'NP21 ')
386 #endif
387  !
388  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
389  ! 1.a Set number of models
390  !
391  CALL w3nmod ( 1, 6, 6 )
392  CALL w3setg ( 1, 6, 6 )
393 #ifdef W3_NL1
394  CALL w3naux ( 6, 6 )
395  CALL w3seta ( 1, 6, 6 )
396 #endif
397  CALL w3nout ( 6, 6 )
398  CALL w3seto ( 1, 6, 6 )
399  !
400  ! 1.b IO set-up.
401  !
402  ndsi = 10
403  ndso = 6
404  ndse = 6
405  ndst = 6
406  ndsm = 11
407  ndsdat = 12
408 #ifdef W3_O15
409  ndstime = 13
410 #endif
411  !
412  ndstrc = 6
413  ntrace = 10
414  CALL itrace ( ndstrc, ntrace )
415  !
416 #ifdef W3_NCO
417  !
418  ! Redo according to NCO
419  !
420  ndsi = 11
421  ndso = 6
422  ndse = ndso
423  ndst = ndso
424  ndsm = 12
425  ndsdat = 51
426  ndstrc = ndso
427 #endif
428  !
429 #ifdef W3_S
430  CALL strace (ient, 'W3PRNC')
431 #endif
432  !
433  !
434  ! 1.c MPP initializations
435  !
436 #ifdef W3_SHRD
437  naproc = 1
438  iaproc = 1
439 #endif
440  !
441 #ifdef W3_MPI
442  CALL mpi_init ( ierr_mpi )
443  CALL mpi_comm_size ( mpi_comm_world, naproc, ierr_mpi )
444  CALL mpi_comm_rank ( mpi_comm_world, iaproc, ierr_mpi )
445  iaproc = iaproc + 1 ! this is to have IAPROC between 1 and NAPROC
446 #endif
447  !
448  IF ( iaproc .EQ. naperr ) THEN
449  ndsen = ndse
450  ELSE
451  ndsen = -1
452  END IF
453  !
454  IF ( iaproc .EQ. napout ) WRITE (ndso,900)
455  !
456 
457  !
458  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
459  ! 2. Read model definition file.
460  !
461  CALL w3iogr ( 'READ', ndsm )
462  IF ( iaproc .EQ. napout ) WRITE (ndso,902) gname
463  ALLOCATE ( ix21(nx,ny), ix22(nx,ny), iy21(nx,ny), iy22(nx,ny), &
464  jx21(nx,ny), jx22(nx,ny), jy21(nx,ny), jy22(nx,ny), &
465  mapovr(nx,ny) )
466  ALLOCATE ( rd11(nx,ny), rd21(nx,ny), rd12(nx,ny), rd22(nx,ny), &
467  xd11(nx,ny), xd21(nx,ny), xd12(nx,ny), xd22(nx,ny), &
468  fx(nx,ny), fy(nx,ny), fa(nx,ny), &
469  a1(nx,ny), a2(nx,ny), a3(nx,ny) )
470  !
471  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
472  ! 3. Read types and variables from input file.
473  !
474 
475  flberg = .false.
476  flstab = .false.
477  !
478  ! process ww3_prnc namelist
479  !
480  INQUIRE(file=trim(fnmpre)//"ww3_prnc.nml", exist=flgnml)
481  IF (flgnml) THEN
482  ! Read namelist
483  CALL w3nmlprnc (ndsi, trim(fnmpre)//'ww3_prnc.nml', nml_forcing, nml_file, ierr)
484  ! Check field
485  IF (nml_forcing%FIELD%ICE_PARAM1) THEN
486  idfld = 'IC1'
487  ifld = -7
488  nfields = 1
489  ELSE IF (nml_forcing%FIELD%ICE_PARAM2) THEN
490  idfld = 'IC2'
491  ifld = -6
492  nfields = 1
493  ELSE IF (nml_forcing%FIELD%ICE_PARAM3) THEN
494  idfld = 'IC3'
495  ifld = -5
496  nfields = 1
497  ELSE IF (nml_forcing%FIELD%ICE_PARAM4) THEN
498  idfld = 'IC4'
499  ifld = -4
500  nfields = 1
501  ELSE IF (nml_forcing%FIELD%ICE_PARAM5) THEN
502  idfld = 'IC5'
503  ifld = -3
504  nfields = 1
505  ELSE IF (nml_forcing%FIELD%MUD_DENSITY) THEN
506  idfld = 'MDN'
507  ifld = -2
508  nfields = 1
509  ELSE IF (nml_forcing%FIELD%MUD_THICKNESS) THEN
510  idfld = 'MTH'
511  ifld = -1
512  nfields = 1
513  ELSE IF (nml_forcing%FIELD%MUD_VISCOSITY) THEN
514  idfld = 'MVS'
515  ifld = 0
516  nfields = 1
517  ELSE IF (nml_forcing%FIELD%ICE_CONC) THEN
518  idfld = 'ICE'
519  ifld = 1
520  nfields = 1
521  ELSE IF (nml_forcing%FIELD%ICE_BERG) THEN
522  idfld = 'ISI'
523  ifld = 1
524  flberg = .true.
525  nfields = 2
526  ELSE IF (nml_forcing%FIELD%WATER_LEVELS) THEN
527  idfld = 'LEV'
528  ifld = 2
529  nfields = 1
530  ELSE IF (nml_forcing%FIELD%WINDS) THEN
531  idfld = 'WND'
532  ifld = 3
533  nfields = 2
534  ELSE IF (nml_forcing%FIELD%WINDS_AST) THEN
535  idfld = 'WNS'
536  ifld = 3
537  flstab = .true.
538  nfields = 3
539  ELSE IF (nml_forcing%FIELD%CURRENTS) THEN
540  idfld = 'CUR'
541  ifld = 4
542  nfields = 2
543  ELSE IF (nml_forcing%FIELD%DATA_ASSIM) THEN
544  idfld = 'DAT'
545  ifld = 5
546  itype = 5
547  nfields = 1
548  ELSE IF (nml_forcing%FIELD%ATM_MOMENTUM) THEN
549  idfld = 'TAU'
550  ifld = 6
551  nfields = 2
552  ELSE IF (nml_forcing%FIELD%AIR_DENSITY) THEN
553  idfld = 'RHO'
554  ifld = 7
555  nfields = 1
556  ELSE
557  GOTO 810
558  END IF ! NML_FORCING
559 
560  ! Check grid asis/latlon
561  IF (nml_forcing%GRID%ASIS) THEN
562  itype = 1
563  ELSE IF (nml_forcing%GRID%LATLON) THEN
564  itype = 2
565  ELSE
566  GOTO 811
567  END IF
568 
569  ! Check tidal component
570  tideflag = 0
571  IF (trim(nml_forcing%TIDAL).NE.'unset' .AND. &
572  trim(nml_forcing%TIDAL).NE.'UNSET') THEN
573  tideflag = 1
574  itype = 6
575  list(:)=''
576  CALL strsplit(trim(nml_forcing%TIDAL),list)
577  END IF
578 
579  ! Check file name, dimensions, variables
580  nfcomp = 1 ! not anymore used 'F1' 'F2' ?
581  namef=trim(nml_file%FILENAME)
582  dimsname(1)=nml_file%LONGITUDE
583  dimsname(2)=nml_file%LATITUDE
584  DO i=1,nfields
585  fieldsname(i)=nml_file%VAR(i)
586  END DO
587  ! Counts the number of dimensions
588  nidims=0
589  DO i=1,2
590  IF (len_trim(dimsname(i)).NE.0) nidims=nidims+1
591  END DO
592 
593 
594  ! Check time start and stop
595  READ(nml_forcing%TIMESTART,*) timestart
596  CALL t2d(timestart,startdate,ierr)
597  CALL d2j(startdate,startjulday,ierr)
598  READ(nml_forcing%TIMESTOP,*) timestop
599  CALL t2d(timestop,stpdate,ierr)
600  CALL d2j(stpdate,stpjulday,ierr)
601 
602  ! Check time shift
603  flhdr = .true.
604  fltime = .true.
605  READ(nml_file%TIMESHIFT,*) timeshift
606  IF(timeshift(1).NE.0 .OR. timeshift(2).NE.0) fltime = .false.
607 
608  END IF ! FLGNML
609 
610  !
611  ! process old ww3_prnc.inp format
612  !
613  IF (.NOT. flgnml) THEN
614  OPEN (ndsi,file=trim(fnmpre)//'ww3_prnc.inp',status='OLD',err=800,iostat=ierr)
615  rewind(ndsi)
616 
617  READ (ndsi,'(A)',END=801,ERR=802,IOSTAT=IERR) comstr
618  IF (comstr.EQ.' ') comstr = '$'
619  IF ( iaproc .EQ. napout ) WRITE (ndso,901) comstr
620  CALL nextln ( comstr , ndsi , ndse )
621  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) IDFLD, IDTYPE, FLTIME, flhdr
622 
623  ! Check field
624  flstab = idfld .EQ. 'WNS'
625  flberg = idfld .EQ. 'ISI'
626  IF ( idfld.EQ.'IC1' ) THEN
627  ifld = -7
628  ELSE IF ( idfld.EQ.'IC2' ) THEN
629  ifld = -6
630  ELSE IF ( idfld.EQ.'IC3' ) THEN
631  ifld = -5
632  ELSE IF ( idfld.EQ.'IC4' ) THEN
633  ifld = -4
634  ELSE IF ( idfld.EQ.'IC5' ) THEN
635  ifld = -3
636  ELSE IF ( idfld.EQ.'MDN' ) THEN
637  ifld = -2
638  ELSE IF ( idfld.EQ.'MTH' ) THEN
639  ifld = -1
640  ELSE IF ( idfld.EQ.'MVS' ) THEN
641  ifld = 0
642  ELSE IF ( idfld.EQ.'ICE' .OR. flberg ) THEN
643  ifld = 1
644  ELSE IF ( idfld.EQ.'LEV' ) THEN
645  ifld = 2
646  ELSE IF ( idfld.EQ.'WND' .OR. flstab ) THEN
647  ifld = 3
648  ELSE IF ( idfld.EQ.'CUR' ) THEN
649  ifld = 4
650  ELSE IF ( idfld.EQ.'DAT' ) THEN
651  ifld = 5
652  ELSE IF ( idfld.EQ.'TAU' ) THEN
653  ifld = 6
654  ELSE IF ( idfld.EQ.'RHO' ) THEN
655  ifld = 7
656  ELSE
657  WRITE (ndse,1030) idfld
658  CALL extcde ( 30 )
659  END IF
660 
661  ! Check grid and tidal component
662  nfcomp = 1
663  tideflag = 0
664  IF (idfld.EQ.'DAT') THEN
665  itype = 5
666  ELSE IF (idtype.EQ.'AI') THEN
667  itype = 1
668  ELSE IF (idtype.EQ.'AT') THEN
669  itype = 6
670  tideflag= 1
671  CALL nextln ( comstr , ndsi , ndse )
672  READ (ndsi,'(A)',END=801,ERR=803,IOSTAT=IERR) tideconstnames
673  list(:)=''
674  CALL strsplit(tideconstnames,list)
675  ELSE IF (idtype.EQ.'LL') THEN
676  itype = 2
677  ELSE IF (idtype.EQ.'F1') THEN
678  itype = 3
679  ELSE IF (idtype.EQ.'F2') THEN
680  itype = 4
681  nfcomp = 2
682  ELSE
683  WRITE (ndse,1031) idtype
684  CALL extcde ( 31 )
685  END IF
686  !
687  CALL nextln ( comstr , ndsi , ndse )
688  READ (ndsi,'(A)',END=801,ERR=802,IOSTAT=IERR) strdimsname
689  !
690  fieldsname(:)=''
691  dimsname(:)=''
692  CALL strsplit(strdimsname,dimsname)
693  ! Counts the number of dimensions
694  nidims=0
695  DO i=1,2
696  IF (len_trim(dimsname(i)).NE.0) nidims=nidims+1
697  END DO
698  !
699  CALL nextln ( comstr , ndsi , ndse )
700  READ (ndsi,'(A)',END=801,ERR=802,IOSTAT=IERR) strfieldsname
701  !
702  fieldsname(:)=''
703  CALL strsplit(strfieldsname,fieldsname)
704  ! Counts the number of variables
705  nfields=0
706  DO WHILE (len_trim(fieldsname(nfields+1)).NE.0)
707  nfields=nfields+1
708  END DO
709  ! time flag and start date
710  IF (.NOT. fltime) THEN
711  CALL nextln ( comstr , ndsi , ndse )
712  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) timeshift
713  IF (timeshift(1).LT.10000000) THEN
714  WRITE (ndse,1035) time
715  CALL extcde ( 35 )
716  END IF
717  END IF
718  ! Read netcdf filename
719  CALL nextln ( comstr , ndsi , ndse )
720  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) namef
721 
722  ! initialize timestart and timestop
723  startjulday=0
724  stpjulday=100000000
725 
726  END IF ! .NOT. FLGNML
727 
728 
729  !
730  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
731  ! 4. Print logs
732  !
733  IF ( iaproc .EQ. napout ) WRITE (ndso,930) idstr1(ifld), idstr2(itype)
734  IF ( itype.NE.1 .AND. itype.NE.6 ) THEN
735 #ifdef W3_WNT0
736  IF ( iaproc .EQ. napout .AND.ifld.EQ.3) WRITE (ndso,1930)
737 #endif
738 #ifdef W3_WNT1
739  IF ( iaproc .EQ. napout .AND.ifld.EQ.3) WRITE (ndso,1930)
740 #endif
741 #ifdef W3_WNT2
742  IF ( iaproc .EQ. napout .AND.ifld.EQ.3) WRITE (ndso,2930)
743 #endif
744 #ifdef W3_CRT1
745  IF ( iaproc .EQ. napout .AND.ifld.EQ.4) WRITE (ndso,1930)
746 #endif
747 #ifdef W3_CRT2
748  IF ( iaproc .EQ. napout .AND.ifld.EQ.4) WRITE (ndso,2930)
749 #endif
750 #ifdef W3_WNT0
751  IF ( iaproc .EQ. napout .AND.ifld.EQ.6) WRITE (ndso,1930)
752 #endif
753 #ifdef W3_WNT1
754  IF ( iaproc .EQ. napout .AND.ifld.EQ.6) WRITE (ndso,1930)
755 #endif
756 #ifdef W3_WNT2
757  IF ( iaproc .EQ. napout .AND.ifld.EQ.6) WRITE (ndso,2930)
758 #endif
759  END IF
760  IF (flgnml) THEN
761  IF(timestart(1).NE.19000101 .OR. timestart(2).NE.0) THEN
762  CALL stme21 ( timestart , idtime )
763  IF ( iaproc .EQ. napout ) WRITE (ndso,1931) idtime
764  END IF
765  IF(timestop(1).NE.29001231 .OR. timestop(2).NE.0) THEN
766  CALL stme21 ( timestop , idtime )
767  IF ( iaproc .EQ. napout ) WRITE (ndso,2931) idtime
768  END IF
769  IF(caltype .NE. 'standard') THEN
770  IF ( iaproc .EQ. napout ) WRITE (ndso,2932) caltype
771  ENDIF
772  END IF
773  IF (.NOT. fltime) THEN
774  CALL stme21 ( timeshift , idtime )
775  IF ( iaproc .EQ. napout ) WRITE (ndso,3931) idtime
776  END IF
777  IF ( iaproc .EQ. napout .AND.flberg ) WRITE (ndso,938)
778  IF ( iaproc .EQ. napout .AND.flstab ) WRITE (ndso,939)
779 
780  IF ( iaproc .EQ. napout ) WRITE (ndso,967) namef
781  IF ( iaproc .EQ. napout ) WRITE (ndso,968) trim(dimsname(1)), trim(dimsname(2))
782  DO i=1,nfields
783  IF ( iaproc .EQ. napout ) WRITE (ndso,969) i, trim(fieldsname(i))
784  END DO
785 
786 
787  !
788  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
789  ! 5. Read Input netcdf file
790  !
791 
792  ! open input file
793  iret=nf90_open(path=trim(fnmpre)//namef,mode=nf90_nowrite,ncid=ncid)
794  CALL check_err(iret)
795 
796  ! instanciates time
797  refdate(:)=0.
798  iret=nf90_inq_varid(ncid,"time",varidtmp)
799  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"MT",varidtmp)
800  CALL check_err(iret)
801  iret=nf90_get_att(ncid,varidtmp,"calendar",calendar)
802  IF ( iret/=nf90_noerr ) THEN
803  ! No calendar attribute - default to "standard"
804  WRITE(ndse,1028)
805  calendar = "standard"
806  ELSE IF ((index(calendar, "standard") .GT. 0) .OR. &
807  (index(calendar, "gregorian") .GT. 0)) THEN
808  calendar = "standard"
809  ELSE IF (index(calendar, "360_day") .GT. 0) THEN
810  calendar = "360_day"
811  ELSE
812  ! Calendar attribute set, but not a recognised calendar.
813  WRITE(ndse,1029) calendar
814  CALL extcde( 25 )
815  END IF
816 
817  ! Check input calendar compatible with expected calendar
818  IF(calendar .NE. caltype) THEN
819  WRITE(ndse,1027) caltype, calendar
820  CALL extcde( 26 )
821  ENDIF
822 
823  iret=nf90_get_att(ncid,varidtmp,"units",timeunits)
824  CALL check_err(iret)
825  CALL u2d(timeunits,refdate,ierr)
826  CALL d2j(refdate,refjulday,ierr)
827 
828  ! gets variables ids, dimensions and fillvalue
829  DO i=1,nfields
830  iret = nf90_inq_varid(ncid,trim(fieldsname(i)),varidf(i))
831  CALL check_err(iret)
832  iret = nf90_inquire_variable(ncid, varidf(i), ndims=ndimsvar)
833  CALL check_err(iret)
834  iret = nf90_inquire_variable(ncid, varidf(i), dimids=dimsvar(:ndimsvar))
835  CALL check_err(iret)
836  DO j=1,ndimsvar
837  iret=nf90_inquire_dimension(ncid,dimsvar(j),name=dimname(j), len=dimln(j))
838  CALL check_err(iret)
839  END DO
840  iret=nf90_get_att(ncid,varidf(i),"_FillValue", fillvalue)
841  IF ( iret/=nf90_noerr ) THEN
842  WRITE(ndse,1026) trim(fieldsname(i))
843  CALL extcde ( 27 )
844  END IF
845  END DO
846 
847  ! instanciates generic variables dimensions
848  nxi=0
849  nyi=0
850  ndimsgrid=2
851  DO i=1,ndimsvar
852  IF (dimname(i) .EQ. "time".OR.dimname(i) .EQ."MT") nti = dimln(i)
853  IF (dimname(i) .EQ. dimsname(1)) nxi = dimln(i)
854  IF (dimname(i) .EQ. dimsname(1).AND.nidims.EQ.1) THEN
855  ndimsgrid=1
856  nyi = 1
857  END IF
858  IF (nidims.GE.2) THEN
859  IF (dimname(i) .EQ. dimsname(2)) nyi = dimln(i)
860  END IF
861  END DO
862  IF (nxi*nyi.EQ.0) GOTO 864
863 
864  ! Set factor for deg/km
865  IF ( flagll ) THEN
866  factor = 1.
867  ELSE
868  factor = 1.e-3
869  END IF
870 
871  ! Get longitude and latitude
872  IF (itype.NE.1.AND.itype.NE.6) THEN
873  ALLOCATE (ala(nxi,nyi))
874  ALLOCATE (alo(nxi,nyi))
875  ! get longitude
876  iret=nf90_inq_varid(ncid,"longitude",varidtmp)
877  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"lon",varidtmp)
878  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"Longitude",varidtmp)
879  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"x",varidtmp)
880  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"X",varidtmp)
881  iret = nf90_inquire_variable(ncid, varidtmp, ndims = numdims)
882  call check_err(iret)
883  IF (numdims.EQ.1) THEN
884  iret=nf90_get_var(ncid,varidtmp,x0i,start=(/1/))
885  call check_err(iret)
886  iret=nf90_get_var(ncid,varidtmp,xni,start=(/nxi/))
887  call check_err(iret)
888  iret=nf90_get_var(ncid,varidtmp,alo(:,1))
889  call check_err(iret)
890  DO i=1,nyi
891  alo(:,i)=alo(:,1)
892  END DO
893  ELSE
894  iret=nf90_get_var(ncid,varidtmp,x0i,start=(/1,1/))
895  call check_err(iret)
896  iret=nf90_get_var(ncid,varidtmp,xni,start=(/nxi,1/))
897  call check_err(iret)
898  iret=nf90_get_var(ncid,varidtmp,alo(:,:))
899  call check_err(iret)
900  END IF
901  ! get latitude
902  iret=nf90_inq_varid(ncid,"latitude",varidtmp)
903  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"lat",varidtmp)
904  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"Latitude",varidtmp)
905  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"y",varidtmp)
906  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"Y",varidtmp)
907  iret = nf90_inquire_variable(ncid, varidtmp, ndims = numdims)
908  CALL check_err(iret)
909  iret=nf90_get_var(ncid,varidtmp,y0i, start=(/1/))
910  CALL check_err(iret)
911  IF (numdims.EQ.1) THEN
912  iret=nf90_get_var(ncid,varidtmp,ala(1,:))
913  CALL check_err(iret)
914  yni=ala(1,nyi)
915  DO i=1,nxi
916  ala(i,:)=ala(1,:)
917  END DO
918  ELSE
919  iret=nf90_get_var(ncid,varidtmp,ala(:,:))
920  CALL check_err(iret)
921  yni=ala(1,nyi)
922  END IF
923  END IF
924 
925 
926 
927  !
928  ! ... type 1 or 6 : "As Is" (AI) or "As Is with tide" (AT)
929  !
930  IF (itype.EQ.1.OR.itype.EQ.6) THEN
931  !
932  nxi = nx
933  nyi = ny
934  ALLOCATE ( mask(nxi,nyi) )
935  mask = 1
936  IF(gtype .EQ. ungtype) THEN
937  !
938  ! X0, Y0 are the coordinates of the lower-left point in mesh
939  !
940  rw(1) = factor*x0 ; rw(2) = factor*maxx
941  rw(3) = factor*y0 ; rw(4) = factor*maxy
942  ELSE
943  rw(1) = factor*xgrd(1,1) ; rw(2) = factor*xgrd(ny,nx)
944  rw(3) = factor*ygrd(1,1) ; rw(4) = factor*ygrd(ny,nx)
945  END IF
946  IF ( iaproc .EQ. napout ) WRITE (ndso,932) nxi, nyi
947  IF ( flagll ) THEN
948  IF ( iaproc .EQ. napout ) WRITE (ndso,1933) rw(1),rw(2),rw(3),rw(4)
949  ELSE
950  IF ( iaproc .EQ. napout ) WRITE (ndso,2933) rw(1),rw(2),rw(3),rw(4)
951  END IF
952  !
953  ! ... type 2 : "Lat/Lon" (LL)
954  !
955  ELSE IF (itype.EQ.2) THEN
956  !
957  ! check latitude values order
958  IF ((gtype .EQ. rlgtype) .AND. (y0i.GT.yni)) THEN
959  WRITE (ndse,1032)
960  CALL extcde ( 32 )
961  END IF
962 
963  IF (nxi.LT.2 .OR. nyi.LT.2) THEN
964  WRITE (ndse,1036) nxi, nyi
965  CALL extcde ( 36 )
966  END IF
967  ALLOCATE ( mask(nxi,nyi) )
968  mask = 1
969  IF ( iaproc .EQ. napout ) WRITE (ndso,932) nxi, nyi
970 
971  IF ( flagll ) THEN
972  IF ( iaproc .EQ. napout ) WRITE (ndso,1933) factor*x0i, factor*xni, &
973  factor*y0i, factor*yni
974  ELSE
975  IF ( iaproc .EQ. napout ) WRITE (ndso,2933) factor*x0i, factor*xni, &
976  factor*y0i, factor*yni
977  END IF
978  !
979  ! ... type 5 : "Data" (DAT)
980  !
981  ELSE IF (itype.EQ.5) THEN
982  CALL nextln ( comstr , ndsi , ndse )
983  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
984  dattyp, recldt, nodata
985  IF (dattyp.LT.0 .OR. dattyp.GT.2) THEN
986  WRITE (ndse,1033) dattyp
987  CALL extcde ( 33 )
988  END IF
989  IF (recldt.LE.0) THEN
990  WRITE (ndse,1034) recldt
991  CALL extcde ( 34 )
992  END IF
993  IF ( iaproc .EQ. napout ) WRITE (ndso,934) idstr3(dattyp+1), recldt, nodata
994  WRITE (idfld,935) dattyp
995  DEALLOCATE ( ix21, ix22, iy21, iy22, jx21, jx22, jy21, jy22, &
996  mapovr )
997  DEALLOCATE ( rd11, rd21, rd12, rd22, xd11, xd21, xd12, xd22, &
998  fx, fy, fa, a1, a2, a3 )
999  !
1000  ! ... types 3 and 4 ... in preprocessing loop ....
1001  !
1002  END IF
1003  !
1004  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1005  ! 6 Prepare interpolation.
1006  !
1007  IF ( iaproc .EQ. napout ) WRITE (ndso,940)
1008  !
1009  IF (itype.NE.1 .AND. itype.NE.5 .AND. itype.NE.6 ) THEN
1010  !
1011  ! 6.a Longitude - latitude grid
1012  !
1013  IF (itype.EQ.2) THEN
1014  IF ( iaproc .EQ. napout ) WRITE (ndso,941)
1015  !
1016  ! ... setup coordinates
1017  !
1018  sxi = (xni-x0i)/real(nxi-1)
1019  syi = (yni-y0i)/real(nyi-1)
1020  iclo = iclose_none
1021  IF ( flagll ) THEN
1022  IF ( abs(abs(real(nxi)*sxi)-360.) .LT. 0.1*abs(sxi) ) THEN
1023  iclo = iclose_smpl
1024  END IF
1025  END IF
1026  !
1027  ! ... create grid search utility
1028  !
1029  ptr_ala => ala
1030  ptr_alo => alo
1031  gsi = w3gsuc( .true., flagll, iclo, ptr_alo, ptr_ala )
1032  !
1033  ! ... construct Interpolation data
1034  !
1035 #ifdef W3_T1
1036  WRITE (ndst,9045)
1037 #endif
1038  IF (gtype .NE. ungtype) THEN
1039  DO iy=1,ny
1040  DO ix=1,nx
1041  ingrid = w3grmp( gsi, real(xgrd(iy,ix)), real(ygrd(iy,ix)), &
1042  is, js, rw )
1043  IF ( .NOT.ingrid ) THEN
1044  IF ( iaproc .EQ. napout ) WRITE(ndso,1042) ix, iy, xgrd(iy,ix), ygrd(iy,ix)
1045  ix21(ix,iy) = 1
1046  ix22(ix,iy) = 1
1047  iy21(ix,iy) = 1
1048  iy22(ix,iy) = 1
1049  rd11(ix,iy) = 0.
1050  rd21(ix,iy) = 0.
1051  rd12(ix,iy) = 0.
1052  rd22(ix,iy) = 0.
1053 
1054  cycle
1055  END IF
1056  ix21(ix,iy) = is(1)
1057  ix22(ix,iy) = is(2)
1058  iy21(ix,iy) = js(1)
1059  iy22(ix,iy) = js(4)
1060  rd11(ix,iy) = rw(1)
1061  rd21(ix,iy) = rw(2)
1062  rd12(ix,iy) = rw(4)
1063  rd22(ix,iy) = rw(3)
1064 #ifdef W3_T1
1065  WRITE (ndst,9046) ix, iy, &
1066  ix21(ix,iy),ix22(ix,iy),iy21(ix,iy),iy22(ix,iy), &
1067  rd11(ix,iy),rd12(ix,iy),rd21(ix,iy),rd22(ix,iy)
1068 #endif
1069  END DO
1070  END DO
1071  ELSE ! GTYPE .NE. UNGTYPE
1072  DO ix=1, nx
1073  x = xgrd(1,ix)
1074  y = ygrd(1,ix)
1075  ix21(ix,1) = 1 + int(mod(360.+(x-x0i),360.)/sxi)
1076  !
1077  ! Manages the simple closure of the grid
1078  !
1079  IF (iclo.EQ.iclose_none) THEN
1080  IF (ix21(ix,1).LT.1.OR.ix21(ix,1).GT.nxi-1) WRITE(ndso,1041) ix, x, y
1081  ix21(ix,1) = max( 1 , min(ix21(ix,1),nxi-1) )
1082  ix22(ix,1) = ix21(ix,1) + 1
1083  ELSE
1084  ix21(ix,1) = max( 1 , min(ix21(ix,1),nxi) )
1085  ix22(ix,1) = mod(ix21(ix,1),nxi)+1
1086  END IF
1087  iy21(ix,1) = 1 + int((y-y0i)/syi)
1088  IF (iy21(ix,1).LT.1.OR.iy21(ix,1).GT.nyi-1) WRITE(ndso,1041) ix, x, y
1089  iy21(ix,1) = max( 1 , min(iy21(ix,1),nyi-1) )
1090  iy22(ix,1) = iy21(ix,1) + 1
1091  !
1092  rw(1) = mod(360.+(x-x0i),360.)/sxi - real(ix21(ix,1)-1)
1093  rw(2) = (y-y0i)/syi - real(iy21(ix,1)-1)
1094  !
1095  IF (ix21(ix,1).LE.1 .AND. rw(1).LT.acc) THEN
1096  IF (rw(1).LT.0.) THEN
1097  rw(1) = 0.
1098  IF ( iaproc .EQ. napout ) WRITE (ndso,1043) x
1099 #ifdef W3_T
1100  flmod = .true.
1101 #endif
1102  END IF
1103  END IF
1104  !
1105  IF (ix21(ix,1).GE.(nxi-1) .AND. rw(1).GT.1.-acc) THEN
1106  IF (rw(1).GT.1.) THEN
1107  IF ( iaproc .EQ. napout ) WRITE (ndso,1043) x
1108  rw(1) = 1.
1109 #ifdef W3_T
1110  flmod = .true.
1111 #endif
1112  END IF
1113  END IF
1114  !
1115  IF (iy21(ix,1).LE.1 .AND. rw(2).LT.acc) THEN
1116  IF (rw(2).LT.0.) THEN
1117  IF ( iaproc .EQ. napout ) WRITE (ndso,1044) y
1118  rw(2) = 0.
1119 #ifdef W3_T
1120  flmod = .true.
1121 #endif
1122  END IF
1123  END IF
1124  !
1125  IF (iy21(ix,1).GE.nyi .AND. rw(2).GT.1.-acc) THEN
1126  IF (rw(2).GT.1) THEN
1127  IF ( iaproc .EQ. napout ) WRITE (ndso,1044) y
1128  rw(2) = 1.
1129 #ifdef W3_T
1130  flmod = .true.
1131 #endif
1132  END IF
1133  END IF
1134  !
1135  efac = sqrt( max(0.,abs(rw(1)-0.5)-0.5)**2 + &
1136  max(0.,abs(rw(2)-0.5)-0.5)**2 )
1137  efac = 1. / ( 1. + 0.25*efac**2 )
1138 
1139  rd11(ix,1) = efac * (1.-rw(1)) * (1.-rw(2))
1140  rd21(ix,1) = efac * rw(1) * (1.-rw(2))
1141  rd12(ix,1) = efac * (1.-rw(1)) * rw(2)
1142  rd22(ix,1) = efac * rw(1) * rw(2)
1143 
1144  END DO ! IX=1, NX
1145  END IF ! GTYPE .NE. UNGTYPE
1146  !
1147  CALL w3gsud( gsi )
1148 
1149  !
1150  ! 6.b Grid(s) from file
1151  !
1152  ELSE ! ITYPE.EQ.2
1153  IF ( iaproc .EQ. napout ) WRITE (ndso,942)
1154  !
1155  ! ... prepare overlay map
1156  !
1157  DO iy=1, ny
1158  DO ix=1, nx
1159  IF ( mapsta(iy,ix) .EQ. 0 ) THEN
1160  mapovr(ix,iy) = iland
1161  ELSE
1162  mapovr(ix,iy) = 0
1163  END IF
1164  END DO
1165  END DO
1166  !
1167  ! ... loop over fields
1168  !
1169  DO j=1, nfcomp
1170  !
1171  IF ( iaproc .EQ. napout ) WRITE (ndso,943) j
1172  !
1173  ! ... file info lat-long file
1174  !
1175  CALL nextln ( comstr , ndsi , ndse )
1176  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
1177  nxj(j), nyj(j), clo(j)
1178  IF (nxj(j).LT.2 .OR. nyj(j).LT.2) THEN
1179  WRITE (ndse,1036) nxj(j), nyj(j)
1180  CALL extcde ( 36 )
1181  END IF
1182  IF ( ALLOCATED(mask) ) DEALLOCATE (mask)
1183  ALLOCATE ( mask(nxj(j),nyj(j)) )
1184  mask = 1
1185  IF ( iaproc .EQ. napout ) WRITE (ndso,944) nxj(j), nyj(j), clo(j)
1186  !
1187  CALL nextln ( comstr , ndsi , ndse )
1188  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
1189  fromll, idlall, idfmll, formll
1190  IF (idlall.LT.1 .OR. idlall.GT.4) idlall = 1
1191  IF (idfmll.LT.1 .OR. idfmll.GT.3) idfmll = 1
1192  IF ( iaproc .EQ. napout ) WRITE (ndso,945) idlall, idfmll
1193  IF (idfmll.EQ.2) WRITE (ndso,946) formll
1194  !
1195  CALL nextln ( comstr , ndsi , ndse )
1196  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, namell
1197 #ifdef W3_NCO
1198  ndsll = 20 + nfcomp
1199 #endif
1200  IF ( iaproc .EQ. napout ) WRITE (ndso,947) ndsll
1201  IF ( iaproc .EQ. napout.AND.fromll.EQ.'NAME') WRITE (ndso,948) namell
1202  IF (ndsll.EQ.ndsi) THEN
1203  WRITE (ndse,1038)
1204  CALL nextln ( comstr , ndsi , ndse )
1205  ELSE
1206  !
1207  ! ... open lat-long file
1208  !
1209  IF ( idfmll .EQ. 3 ) THEN
1210  IF (fromll.EQ.'NAME') THEN
1211  jj = len_trim(fnmpre)
1212  OPEN (ndsll,file=fnmpre(:jj)//namell, &
1213  form='UNFORMATTED', convert=file_endian,status='OLD', &
1214  err=845,iostat=ierr)
1215  ELSE
1216  OPEN (ndsll, form='UNFORMATTED', convert=file_endian, &
1217  status='OLD',err=845,iostat=ierr)
1218  END IF
1219  ELSE
1220  IF (fromll.EQ.'NAME') THEN
1221  jj = len_trim(fnmpre)
1222  OPEN (ndsll,file=fnmpre(:jj)//namell, &
1223  status='OLD',err=845,iostat=ierr)
1224  ELSE
1225  OPEN (ndsll, &
1226  status='OLD',err=845,iostat=ierr)
1227  END IF
1228  END IF
1229  !
1230  END IF
1231  !
1232  ! ... read lat-lon data
1233  !
1234  IF ( ALLOCATED(ala) ) THEN
1235  DEALLOCATE ( ala, alo )
1236  NULLIFY ( ptr_ala, ptr_alo )
1237  END IF
1238  ALLOCATE ( ala(nxj(j),nyj(j)), alo(nxj(j),nyj(j)) )
1239  CALL ina2r (ala, nxj(j), nyj(j), 1, nxj(j), 1, nyj(j),&
1240  ndsll, ndst, ndse, idfmll, formll, idlall, 1., 0.)
1241  CALL ina2r (alo, nxj(j), nyj(j), 1, nxj(j), 1, nyj(j),&
1242  ndsll, ndst, ndse, idfmll, formll, idlall, 1., 0.)
1243  !
1244  IF ( ndsll .NE. ndsi ) CLOSE (ndsll)
1245  !
1246  ! ... file info mask file
1247  !
1248  IF ( iaproc .EQ. napout ) WRITE (ndso,949)
1249  !
1250  CALL nextln ( comstr , ndsi , ndse )
1251  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) &
1252  fromll, idlall, idfmll, formll
1253  IF (idlall.LT.1 .OR. idlall.GT.4) idlall = 1
1254  IF (idfmll.LT.1 .OR. idfmll.GT.3) idfmll = 1
1255  IF ( iaproc .EQ. napout ) WRITE (ndso,945) idlall, idfmll
1256  IF (idfmll.EQ.2) WRITE (ndso,946) formll
1257  !
1258  CALL nextln ( comstr , ndsi , ndse )
1259  READ (ndsi,*,END=801,ERR=802,IOSTAT=IERR) NDSLL, namell
1260 #ifdef W3_NCO
1261  ndsll = 22 + nfcomp
1262 #endif
1263  IF ( iaproc .EQ. napout ) WRITE (ndso,947) ndsll
1264  IF (fromll.EQ.'NAME') WRITE (ndso,948) namell
1265  IF ( iaproc .EQ. napout ) WRITE (ndso,*) ' '
1266  IF (ndsll.EQ.ndsi) THEN
1267  WRITE (ndse,1038)
1268  CALL nextln ( comstr , ndsi , ndse )
1269  ELSE
1270  !
1271  ! ... open mask file
1272  !
1273  IF ( idfmll .EQ. 3 ) THEN
1274  IF (fromll.EQ.'NAME') THEN
1275  jj = len_trim(fnmpre)
1276  OPEN (ndsll,file=fnmpre(:jj)//namell, &
1277  form='UNFORMATTED', convert=file_endian,status='OLD', &
1278  err=846,iostat=ierr)
1279  ELSE
1280  OPEN (ndsll,form='UNFORMATTED', convert=file_endian, &
1281  status='OLD',err=846,iostat=ierr)
1282  END IF
1283  ELSE
1284  IF (fromll.EQ.'NAME') THEN
1285  jj = len_trim(fnmpre)
1286  OPEN (ndsll,file=fnmpre(:jj)//namell, &
1287  status='OLD',err=846,iostat=ierr)
1288  ELSE
1289  OPEN (ndsll, &
1290  status='OLD',err=846,iostat=ierr)
1291  END IF
1292  END IF
1293  !
1294  END IF
1295  !
1296  ! ... read mask data
1297  !
1298  CALL ina2i (mask, nxj(j), nyj(j), 1,nxj(j), 1,nyj(j), &
1299  ndsll, ndst, ndse, idfmll, formll, idlall, 1, 0)
1300  IF ( ndsll .NE. ndsi ) CLOSE (ndsll)
1301  !
1302 #ifdef W3_T1a
1303  WRITE (ndst,9050)
1304  DO iy=1, nyj(j)
1305  DO ix=1,nxj(j)
1306  WRITE (ndst,9051) ix, iy, ala(ix,iy), &
1307  alo(ix,iy), mask(ix,iy)
1308  END DO
1309  END DO
1310 #endif
1311  !
1312  ! ... generate interpolation data
1313  !
1314  IF ( j .EQ. 1 ) THEN
1315  CALL w3fldp ( ndso, ndst, ndse, ierr, flagll, &
1316  nx, ny, nx, ny, real(ygrd), real(xgrd), mapovr, iland, &
1317  nxj(j), nyj(j), nxj(j), nyj(j), clo(j), ala, alo, &
1318  mask, rd11, rd21, rd12, rd22, ix21, ix22, iy21, &
1319  iy22 )
1320  ELSE
1321  CALL w3fldp ( ndso, ndst, ndse, ierr, flagll, &
1322  nx, ny, nx, ny, real(ygrd), real(xgrd), mapovr, iland, &
1323  nxj(j), nyj(j), nxj(j), nyj(j), clo(j), ala, alo, &
1324  mask, xd11, xd21, xd12, xd22, jx21, jx22, jy21, &
1325  jy22 )
1326  END IF ! J .EQ. 1
1327  !
1328  END DO ! J=1, NFCOMP
1329  !
1330  ! ... average two fields !
1331  !
1332  IF ( nfcomp .EQ. 2) THEN
1333  DO ix=1, nx
1334  DO iy=1, ny
1335  IF ( mapovr(ix,iy) .GE. 2) THEN
1336  factor = 1. / real(mapovr(ix,iy))
1337  rd11(ix,iy) = factor * rd11(ix,iy)
1338  rd12(ix,iy) = factor * rd12(ix,iy)
1339  rd21(ix,iy) = factor * rd21(ix,iy)
1340  rd22(ix,iy) = factor * rd22(ix,iy)
1341  xd11(ix,iy) = factor * xd11(ix,iy)
1342  xd12(ix,iy) = factor * xd12(ix,iy)
1343  xd21(ix,iy) = factor * xd21(ix,iy)
1344  xd22(ix,iy) = factor * xd22(ix,iy)
1345  END IF
1346  END DO
1347  END DO
1348  END IF ! NFCOMP .EQ. 2
1349  !
1350  END IF ! ITYPE.EQ.2
1351  END IF ! ITYPE.NE.1 .AND. ITYPE.NE.5
1352  !
1353  ! 6.c Input location and format
1354  !
1355  DO j=1, nfcomp
1356  !
1357  IF ( itype .EQ. 5 ) THEN
1358  IF ( iaproc .EQ. napout ) WRITE (ndso,960)
1359  ELSE
1360  IF (itype.LE.3) THEN
1361  IF ( iaproc .EQ. napout ) WRITE (ndso,961) nxj(j), nyj(j)
1362  ELSE
1363  IF ( iaproc .EQ. napout ) WRITE (ndso,962) j, nxj(j), nyj(j)
1364  END IF
1365  END IF ! ITYPE .EQ. 5
1366  !
1367  END DO
1368  !
1369  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1370  ! 7 Prepare files
1371  !
1372  IF ( nfcomp .EQ. 1 ) THEN
1373  nxj(2) = nxj(1)
1374  nyj(2) = nyj(1)
1375  ndsf(2) = ndsf(1)
1376  idlaf(2) = idlaf(1)
1377  idfmf(2) = idfmf(1)
1378  formt(2) = formt(1)
1379  formf(2) = formf(1)
1380  END IF
1381 
1382  ! 7.b Open and prepare output file
1383  !
1384  IF ( iaproc .EQ. napout ) WRITE (ndso,971)
1385  j = len_trim(fnmpre)
1386 
1387  ! define tidal constituents for analysis
1388  IF (itype.EQ.6) THEN
1389  CALL vuf_set_parameters
1390  tide_ndef = nfields
1391  IF (trim(list(1)).EQ.'ALL') THEN
1392  WRITE(ndse,'(A)') 'Tidal constituent ALL not available anymore'
1393  CALL extcde(29)
1394  END IF
1395  CALL tide_find_indices_analysis(list)
1396  END IF
1397 
1398  ! Create output binary file
1399  IF ( itype .LE. 4 .OR. itype.EQ.6 ) THEN
1400  IF ( iaproc .EQ. napout ) &
1401  CALL w3fldo ( 'WRITE', idfld, ndsdat, ndst, ndse, &
1402  nx, ny, gtype, ierr, fpre=fnmpre(:j), &
1403  fhdr=flhdr, tideflagin=tideflag)
1404  ELSE
1405  IF ( iaproc .EQ. napout ) &
1406  CALL w3fldo ( 'WRITE', idfld, ndsdat, ndst, ndse, &
1407  recldt, 0, gtypedum, ierr, fpre=fnmpre(:j) )
1408  END IF
1409 
1410 #ifdef W3_T
1411  IF (tideflag.GT.0) THEN
1412  lrecl = tide_mf*lrb*nfields*2
1413  nrec = lrecl / lrb
1414  ALLOCATE(nullbuff(nrec))
1415  nullbuff(1:nrec) = 0.
1416  OPEN (990,file='tidana.dat',form='UNFORMATTED', convert=file_endian, access='STREAM')
1417  fnametxt = 'tidanaNNN.txt'
1418  WRITE (fnametxt(7:9),'(I3.3)') iaproc
1419  OPEN (989,file=fnametxt,status='unknown')
1420  ENDIF
1421 #endif
1422 
1423  !
1424  ! 7.c Initialize fields
1425  !
1426  IF ( itype .NE. 5 ) THEN
1427  fx = 0.
1428  fy = 0.
1429  fa = 0.
1430  mxm = max( nxj(1), nxj(2) )
1431  mym = max( nyj(1), nyj(2) )
1432  IF (itype.EQ.1.AND.gtype.EQ.ungtype) THEN
1433  ALLOCATE ( xc(mxm,1), yc(mxm,1), ac(mxm,1), xtemp(mxm,1) )
1434  ELSE
1435  ALLOCATE ( xc(mxm,mym), yc(mxm,mym), ac(mxm,mym), xtemp(mxm,mym) )
1436  END IF
1437  xc = 0.
1438  yc = 0.
1439  ac = 0.
1440  xtemp = 0.
1441  END IF
1442  !
1443  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1444  !
1445  ! Dedicated section to ITYPE.EQ.6
1446  !
1447  ! points are read one by one for tidal analysis
1448  ! For other ITYPE, time steps are read one by one.
1449  !
1450 
1451  IF (itype.GE.6.AND.tideflag.GT.0) THEN
1452  !
1453  ! Reads in the full time vector
1454  !
1455  IF (nx*ny.GT.4000) THEN
1456 #ifdef W3_MPI
1457  IF ((nx*ny)/naproc.LT.4000) THEN
1458  IF (iaproc.EQ.napout) WRITE(ndse,*) 'Starting tidal analysis ... '
1459  ELSE
1460  IF (iaproc.EQ.napout) WRITE(ndse,*) 'Starting tidal analysis for ',nx*ny, &
1461  ' points. This can take hours ...'
1462  ENDIF
1463  IF (nx*ny.LT.4000) THEN
1464 #endif
1465  WRITE(ndse,'(A,I8,A)') 'Starting tidal analysis for ',nx*ny, ' points.'
1466  IF (naproc.EQ.1) WRITE(ndse,'(A)') 'This can take hours ...Consider running this with MPI '
1467  END IF
1468 #ifdef W3_MPI
1469  END IF
1470 #endif
1471  iret=nf90_inq_varid(ncid,"time",varidtmp)
1472  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"MT",varidtmp)
1473  CALL check_err(iret)
1474  ALLOCATE(alltimes(nti))
1475  iret=nf90_get_var(ncid,varidtmp,alltimes,start=(/1/))
1476  CALL check_err(iret)
1477  IF (index(timeunits, "seconds").NE.0) alltimes=alltimes/86400.
1478  IF (index(timeunits, "minutes").NE.0) alltimes=alltimes/1440.
1479  IF (index(timeunits, "hours").NE.0) alltimes=alltimes/24.
1480  alltimes=refjulday+alltimes
1481 
1482  !
1483  ! Performs tidal analysis
1484  !
1485  tide_nti = nti
1486  tide_ndef = nfields
1487  ALLOCATE(sdev0(tide_ndef),sdev(tide_ndef), rmsr(tide_ndef), &
1488  res(tide_ndef), ssq(tide_ndef),rmsr0(tide_ndef), &
1489  rmsrp(tide_ndef), imax(tide_ndef), resmax(tide_ndef))
1490 
1491  ALLOCATE( tide_data(tide_nti,tide_ndef) )
1492  ALLOCATE( tide_days(tide_nti), tide_secs(tide_nti), tide_hours(tide_nti) )
1493  ALLOCATE(v_arg(170,tide_nti),f_arg(170,tide_nti),u_arg(170,tide_nti))
1494  tide_nx=nx
1495  tide_ny=ny
1496  ALLOCATE(tidal_const(nx,ny,tide_mf,2,2))
1497  tidal_const(:,:,:,:,:)=0.
1498  DO i=1,nfields
1499  iret=nf90_inq_varid(ncid,fieldsname(i),varidf(i))
1500  CALL check_err(iret)
1501  END DO
1502  iret=nf90_get_att(ncid,varidf(1),"_FillValue", fillvalue)
1503  CALL check_err(iret)
1504  iret = nf90_get_att(ncid,varidf(1),'scale_factor',scfac(1))
1505  IF (iret .NE. 0) scfac(1) = 1.0
1506  iret = nf90_get_att(ncid,varidf(1),'add_offset',addoff(1))
1507  IF (iret .NE. 0) addoff(1) = 0.0
1508  IF ( nfcomp.EQ.2 .OR. (ifld.GE.3 .AND. ifld.NE.7) .OR. flberg ) THEN
1509  iret = nf90_get_att(ncid,varidf(2),'scale_factor',scfac(2))
1510  IF (iret .NE. 0) scfac(2) = 1.0
1511  iret = nf90_get_att(ncid,varidf(2),'add_offset',addoff(2))
1512  IF (iret .NE. 0) addoff(2) = 0.0
1513  END IF
1514 
1515 
1516  !
1517  ! Set arrays for MPI exchanges
1518  !
1519  IF (nx .LT. naproc) THEN
1520  WRITE(ndse,'(A)') 'NUMBER OF NX POINTS LESS THAN NUMBER OF PROC'
1521  CALL extcde (30)
1522  END IF
1523 
1524 #ifdef W3_MPI
1525  slice=nx/naproc
1526  rest=mod(nx,naproc)
1527  IF(rest.GE.iaproc) slice=slice+1
1528 #endif
1529 
1530 #ifdef W3_MPI
1531  ! set total 1D array (nx)
1532  ALLOCATE (tide1d(nx * tide_mf * nfields * 2))
1533  tide1d(:)=0.
1534 #endif
1535 
1536 #ifdef W3_MPI
1537  ! set local 1D array (slice)
1538  ALLOCATE(tide1dl(slice * tide_mf * nfields * 2))
1539  tide1dl(:)=0.
1540 #endif
1541 
1542  ! set arrays for number of elements per MPI proc
1543  ALLOCATE(cumul(naproc))
1544  ALLOCATE(nelem(naproc))
1545  cumul(1) = 0
1546  nelem(1) = nx / naproc
1547 #ifdef W3_MPI
1548  IF (rest .GT. 0) nelem(1) = nelem(1) + 1
1549  DO i=2,naproc
1550  cumul(i)=cumul(i-1)+nelem(i-1)
1551  nelem(i) = nx / naproc
1552  IF (rest .GT. i-1) nelem(i) = nelem(i) + 1
1553  END DO
1554 #endif
1555 
1556 
1557 #ifdef W3_MPIT
1558  WRITE(100+iaproc,*) "Number of points for this processor ", iaproc, " : ", nelem(iaproc), ' / ', nx
1559  WRITE(100+iaproc,*) "Cumul of points for this processor ", iaproc, " : ", cumul(iaproc), ' / ', nx
1560  WRITE(100+iaproc,*) "Slice of values per processor ", slice
1561 #endif
1562 
1563  ALLOCATE(tide_data_all(nelem(iaproc),nti,nfields))
1564 
1565 
1566 
1567 
1568 
1569  !
1570  ! Loops on Y dimension
1571  !
1572  ALLOCATE(tidalcomp(nx,ny))
1573  tidalcomp=.true.
1574  !
1575  DO iy=1,ny
1576 #ifdef W3_MPI
1577  ind=0
1578 #endif
1579  !
1580  IF (ndimsgrid.EQ.1) THEN
1581  DO i=1,nfields
1582  iret=nf90_get_var(ncid,varidf(i),tide_data_all(:,:,i), &
1583  start=(/cumul(iaproc)+1,1/),count=(/nelem(iaproc),nti/))
1584  CALL check_err(iret)
1585  WHERE (tide_data_all(:,:,i).NE.fillvalue) tide_data_all(:,:,i)=tide_data_all(:,:,i)*scfac(i)+addoff(i)
1586  END DO
1587  ELSE IF (ndimsgrid.EQ.2) THEN
1588  IF (ndimsvar.EQ.3) THEN
1589  DO i=1,nfields
1590  iret=nf90_get_var(ncid,varidf(i),tide_data_all(:,:,i), &
1591  start=(/cumul(iaproc)+1,iy,1/),count=(/nelem(iaproc),1,nti/))
1592  CALL check_err(iret)
1593  WHERE (tide_data_all(:,:,i).NE.fillvalue) tide_data_all(:,:,i)=tide_data_all(:,:,i)*scfac(i)+addoff(i)
1594  END DO
1595  ELSE IF (ndimsvar.EQ.4) THEN
1596  DO i=1,nfields
1597  iret=nf90_get_var(ncid,varidf(i),tide_data_all(:,:,i), &
1598  start=(/cumul(iaproc)+1,iy,1,1/),count=(/nelem(iaproc),1,1,nti/))
1599  CALL check_err(iret)
1600  WHERE (tide_data_all(:,:,i).NE.fillvalue) tide_data_all(:,:,i)=tide_data_all(:,:,i)*scfac(i)+addoff(i)
1601  END DO
1602  END IF ! NDIMSVAR
1603  END IF ! NDIMSGRID
1604 
1605 
1606  !
1607  DO jx=1,nelem(iaproc)
1608 #ifdef W3_MPI
1609  ix=cumul(iaproc)+jx
1610 #endif
1611 #ifdef W3_SHRD
1612  ix=jx
1613 #endif
1614 
1615  !
1616  tide_nti=0
1617  DO i=1,nti
1618  !
1619  ! Defines usable timesteps ... criteria could be improved
1620  ! remove the times when the point IX,IY is dry ...
1621  ! and redefine TIDE_NTI based on wet times only
1622  !
1623  IF (tide_data_all(jx,i,1).NE.fillvalue &
1624  .AND.tide_data_all(jx,i,nfields).NE.fillvalue &
1625  .AND.tide_data_all(jx,i,1).NE.0.0) THEN
1626  tide_nti=tide_nti+1
1627  tide_data(tide_nti,:)=tide_data_all(jx,i,:)
1628  tide_days(tide_nti)=int(alltimes(i))
1629  tide_secs(tide_nti)=(alltimes(i)-tide_days(tide_nti))*86400
1630  END IF
1631  END DO ! NTI
1632  !
1633  tide_hours(1:tide_nti)=24.d0*dfloat(tide_days(1:tide_nti)) &
1634  +dfloat(tide_secs(1:tide_nti))/3600.d0
1635 
1636  !
1637  ! Compute amplitude and phase
1638  !
1639  IF (tide_nti.GT.(tide_mf*3)) THEN
1640  tide_lat= ygrd(iy,ix)
1641  IF (abs(tide_lat).LT.5.) tide_lat=sign(5.,tide_lat)
1642  DO i=1,tide_nti
1643  CALL setvuf(tide_hours(i),tide_lat,i)
1644  END DO
1645  tide_itrend=0
1646  CALL flex_tidana_webpage(ix,iy,real(xgrd(iy,ix)),tide_lat,tide_days(1),tide_days(tide_nti), &
1647  tide_ndef, tide_itrend, res, ssq, rmsr0, &
1648  sdev0, rmsr, resmax, imax, 0)
1649 
1650 #ifdef W3_T
1651  WRITE (989,'(2I10,X,176F10.3)'),ix,tide_nti,tide_ampc(1:tide_mf,1:nfields)
1652  WRITE (989,'(2I10,X,176F10.3)'),ix,tide_nti,tide_phg(1:tide_mf,1:nfields)
1653  rpos = 1_8 + lrecl*(ix-1_8)
1654  WRITE (990,pos=rpos),nullbuff(1:nrec)
1655  WRITE (990,pos=rpos),tide_ampc(1:tide_mf,1:nfields),tide_phg(1:tide_mf,1:nfields)
1656 #endif
1657 
1658  ELSE
1659  tidalcomp(ix,iy)=.false.
1660  tide_ampc(1:tide_mf,1:nfields)=0.
1661  tide_phg(1:tide_mf,1:nfields)=0.
1662  END IF ! end of test on TIDE_NTI
1663 
1664 
1665  !
1666  ! Save tidal amplitude and phase
1667  !
1668 
1669 #ifdef W3_MPIT
1670  IF (iaproc.EQ.napout) WRITE(ndso,'(A,I6,A,I6,A,I6)') 'IY, JX = ', &
1671  iy,',',jx, ' out of ', nelem(iaproc)
1672 #endif
1673 #ifdef W3_MPI
1674  DO j=1,tide_mf
1675  DO k=1,nfields
1676  ind=ind+1
1677  tide1dl(ind)=tide_ampc(j,k)
1678  ind=ind+1
1679  tide1dl(ind)=tide_phg(j,k)
1680  END DO
1681  END DO
1682 #endif
1683 
1684 #ifdef W3_SHRD
1685  tidal_const(ix,iy,1:tide_mf,1:nfields,1)=tide_ampc(1:tide_mf,1:nfields)
1686  tidal_const(ix,iy,1:tide_mf,1:nfields,2)=tide_phg(1:tide_mf,1:nfields)
1687 #endif
1688 
1689  END DO ! JX=1,NELEM(IAPROC)
1690 
1691  !
1692  ! Gather from other MPI tasks
1693  !
1694 
1695 #ifdef W3_MPI
1696  IF (naproc.GT.1) THEN
1697  CALL mpi_gatherv(tide1dl, slice * tide_mf * nfields * 2, mpi_real, &
1698  tide1d, nelem * tide_mf * nfields * 2, cumul * tide_mf * nfields * 2, &
1699  mpi_real, napout-1, mpi_comm_world, ierr_mpi)
1700 #endif
1701 
1702 #ifdef W3_MPI
1703  IF (iaproc.EQ.napout) THEN
1704  CALL mpi_gatherv(mpi_in_place,nelem(iaproc), &
1705  mpi_logical, tidalcomp(:,iy), nelem, cumul, mpi_logical, napout-1, &
1706  mpi_comm_world, ierr_mpi)
1707  ELSE
1708  CALL mpi_gatherv(tidalcomp(cumul(iaproc)+1:cumul(iaproc)+nelem(iaproc),iy),nelem(iaproc), &
1709  mpi_logical, tidalcomp(:,iy), nelem, cumul, mpi_logical, napout-1, &
1710  mpi_comm_world, ierr_mpi)
1711  END IF
1712 #endif
1713 
1714 #ifdef W3_MPI
1715  ELSE
1716  tide1d = tide1dl
1717  END IF
1718 #endif
1719 
1720  !
1721  ! Convert from 1D to 2D array
1722  !
1723 #ifdef W3_MPI
1724  IF (iaproc .EQ. napout) THEN
1725  ind=0
1726  DO ix=1,nx
1727  DO j=1,tide_mf
1728  DO k=1,nfields
1729  DO l=1,2
1730  ind=ind+1
1731  tidal_const(ix,iy,j,k,l)=tide1d(ind)
1732  END DO
1733  END DO
1734  END DO
1735  END DO
1736  END IF
1737 #endif
1738 
1739 
1740  END DO ! IY=1,NY
1741 
1742 #ifdef W3_T
1743  CLOSE (990)
1744  CLOSE (989)
1745  IF (idfld.EQ.'CUR') WRITE(986,'(F10.3,/)') tidal_const(:,1,15,1,1)
1746  IF (idfld.EQ.'CUR') WRITE(986,'(F10.3,/)') tidal_const(:,1,15,2,1)
1747 #endif
1748 
1749 #ifdef W3_MPI
1750  IF (iaproc .NE. napout ) THEN
1751  GOTO 888
1752 #endif
1753 #ifdef W3_MPIT
1754  ELSE
1755  WRITE(ndso,'(A)') "parallelization done"
1756 #endif
1757 #ifdef W3_MPI
1758  END IF
1759 #endif
1760 
1761 
1762  !
1763  ! Warn about not computed nodes for tidal constituents
1764  !
1765  IF ( iaproc .EQ. napout) THEN
1766  DO ix=1,nx
1767  DO iy=1,ny
1768  IF(tidalcomp(ix,iy).EQV..false.) THEN
1769  WRITE(ndso,1047) ix, iy
1770  END IF
1771  END DO
1772  END DO
1773  END IF
1774 
1775  !
1776  ! After loop on points, write tidal constituents to file.
1777  !
1778  IF ( iaproc .EQ. napout.AND.tideflag.GE.1) &
1779  CALL w3fldtide1 ( 'WRITE', ndsdat, ndst, ndse, nx, ny, idfld, ierr )
1780  CALL w3fldtide2 ( 'WRITE', ndsdat, ndst, ndse, nx, ny, idfld, 0, ierr )
1781  !
1782  GOTO 880
1783 
1784  END IF ! end of test IF (ITYPE.GE.6.AND.TIDEFLAG.GT.0)
1785 
1786  !
1787  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1788  ! 8 Begin loop over input fields
1789  !
1790  ! Read scale factor and offset for input fields
1791  xcfac = 1.0
1792  ycfac = 1.0
1793  xcoff = 0.0
1794  ycoff = 0.0
1795  !
1796  IF ( itype .LE. 4 .OR. itype.EQ.6 ) THEN
1797  iret = nf90_get_att(ncid,varidf(1),'scale_factor',xcfac)
1798  IF (iret.NE.0 ) xcfac = 1.0
1799  iret = nf90_get_att(ncid,varidf(1),'add_offset',xcoff)
1800  IF (iret.NE.0 ) xcoff = 0.0
1801  IF ( nfcomp.EQ.2 .OR. (ifld.GE.3 .AND. ifld.NE.7) .OR. flberg ) THEN
1802  iret = nf90_get_att(ncid,varidf(2),'scale_factor',ycfac)
1803  IF (iret.NE.0 ) ycfac = 1.0
1804  iret = nf90_get_att(ncid,varidf(2),'add_offset',ycoff)
1805  IF (iret.NE.0 ) ycoff = 0.0
1806  END IF
1807  END IF
1808  !
1809 #ifdef W3_O15
1810  j = len_trim(fnmpre)
1811  OPEN (ndstime,file=fnmpre(:j)//'times.'//idfld, &
1812  err=870,iostat=ierr )
1813 #endif
1814  !
1815  IF ( iaproc .EQ. napout ) WRITE (ndso,972)
1816  timedelay = 0
1817  DO itime=1,nti
1818  !
1819  ! 8.a Read new time and fields
1820  !
1821  iret=nf90_inq_varid(ncid,"time",varidtmp)
1822  IF ( iret/=nf90_noerr ) iret=nf90_inq_varid(ncid,"MT",varidtmp)
1823  CALL check_err(iret)
1824  iret=nf90_get_var(ncid,varidtmp,curjulday,start=(/itime/))
1825  call check_err(iret)
1826  IF (index(timeunits, "seconds").NE.0) curjulday=curjulday/86400.
1827  IF (index(timeunits, "minutes").NE.0) curjulday=curjulday/1440.
1828  IF (index(timeunits, "hours").NE.0) curjulday=curjulday/24.
1829  curjulday=refjulday+curjulday
1830 
1831  ! cycle until reaching the start time
1832  IF (startjulday.GT.curjulday) cycle
1833 
1834  ! exit when reaching the stop time
1835  IF (stpjulday.LT.curjulday) EXIT
1836 
1837  ! convert julday to date and time
1838  CALL j2d(curjulday,curdate,ierr)
1839  CALL d2t(curdate,time,ierr)
1840  CALL stme21 (time,idtime)
1841 
1842  ! define time delay
1843  IF (.NOT.fltime.AND.timedelay.EQ.0) THEN
1844  timedelay = dsec21(time,timeshift)
1845  END IF
1846 
1847  ! shift time
1848  IF (timedelay.NE.0) THEN
1849  CALL tick21 (time,timedelay)
1850  CALL stme21 (time,idtime2)
1851  IF ( iaproc .EQ. napout ) WRITE (ndso,1973) idtime2, idtime
1852  ELSE
1853  IF ( iaproc .EQ. napout ) WRITE (ndso,2973) idtime
1854  END IF
1855 #ifdef W3_O15
1856  WRITE (ndstime, 979, err=871,iostat=ierr) time
1857 #endif
1858 #ifdef W3_O3
1859  IF ( iaproc .EQ. napout ) WRITE (ndso,974)
1860 #endif
1861  !
1862  ! ... Input
1863  !
1864  IF ( itype .LE. 4 .OR. itype.EQ.6 ) THEN
1865  IF (ndimsgrid.EQ.1) THEN
1866  iret=nf90_get_var(ncid,varidf(1),xc(:,1),start=(/1,itime/),count=(/mxm,1/))
1867  ELSE
1868  IF (ndimsvar.EQ.3) THEN
1869  iret=nf90_get_var(ncid,varidf(1),xc,start=(/1,1,itime/),count=(/mxm,mym,1/))
1870  ELSE
1871  iret=nf90_get_var(ncid,varidf(1),xc,start=(/1,1,1,itime/),count=(/mxm,mym,1,1/))
1872  END IF
1873  END IF
1874  CALL check_err(iret)
1875  ! forces undefined values to FILLVALUE
1876  WHERE(xc.NE.xc) xc = fillvalue
1877  WHERE (xc.NE.fillvalue) xc=xc*xcfac+xcoff
1878 
1879  !
1880 #ifdef W3_T2
1881  WRITE (ndst,9060) 1
1882  ixp0 = 1
1883  ixpn = min( ixp0+ixpwdt-1 , nxj(1) )
1884  DO
1885  CALL prtblk ( ndst, nxj(1), nyj(1), mxm, xc, mask, 0, 0.,&
1886  ixp0, ixpn, 1, 1, nyj(1), 1, 'Field 1', ' ')
1887  IF (ixpn.NE.nxj(1)) THEN
1888  ixp0 = ixp0 + ixpwdt
1889  ixpn = min( ixpn+ixpwdt , nxj(1) )
1890  ELSE
1891  EXIT
1892  END IF
1893  END DO
1894 #endif
1895  !
1896  IF (nfcomp.EQ.2 .OR. (ifld.GE.3 .AND. ifld.NE.7) .OR. flberg) THEN
1897 
1898  ! This is a quick fix that works if the lon,lat,level,time dimensions are in that order
1899  ! otherwise, one should check the length of each dimension ...
1900  IF (ndimsgrid.EQ.1) THEN
1901  iret=nf90_get_var(ncid,varidf(2),yc(:,1),start=(/1,itime/),count=(/mxm,1/))
1902  ELSE
1903  IF (ndimsvar.EQ.3) THEN
1904  iret=nf90_get_var(ncid,varidf(2),yc,start=(/1,1,itime/),count=(/mxm,mym,1/))
1905  ELSE
1906  iret=nf90_get_var(ncid,varidf(2),yc,start=(/1,1,1,itime/),count=(/mxm,mym,1,1/))
1907  END IF
1908  END IF
1909  ! The following line forces to 0 values that are undefine
1910  CALL check_err(iret)
1911  WHERE(yc.NE.yc) yc = fillvalue
1912  WHERE (yc.NE.fillvalue) yc=yc*ycfac+ycoff
1913  !
1914 #ifdef W3_T2
1915  WRITE (ndst,9060) 2
1916  ixp0 = 1
1917  ixpn = min( ixp0+ixpwdt-1 , nxj(2) )
1918  DO
1919  CALL prtblk ( ndst, nxj(2), nyj(2), mxm, yc, mask, 0, 0., &
1920  ixp0, ixpn, 1, 1, nyj(2), 1, 'Field 2', ' ')
1921  IF (ixpn.NE.nxj(2)) THEN
1922  ixp0 = ixp0 + ixpwdt
1923  ixpn = min( ixpn+ixpwdt , nxj(2) )
1924  ELSE
1925  EXIT
1926  END IF
1927  END DO
1928 #endif
1929  !
1930  IF (flstab) THEN
1931  ! This is a quick fix that works if the lon,lat,level,time dimensions are in that order
1932  ! otherwise, one should check the length of each dimension ...
1933  IF (ndimsgrid.EQ.1) THEN
1934  iret=nf90_get_var(ncid,varidf(3),ac(:,1),start=(/1,itime/),count=(/mxm,1/))
1935  ELSE
1936  IF (ndimsvar.EQ.3) THEN
1937  iret=nf90_get_var(ncid,varidf(3),ac,start=(/1,1,itime/),count=(/mxm,mym,1/))
1938  ELSE
1939  iret=nf90_get_var(ncid,varidf(3),ac,start=(/1,1,1,itime/),count=(/mxm,mym,1,1/))
1940  END IF
1941  END IF
1942  CALL check_err(iret)
1943  !AC(:,:)=AC(:,MYM:1:-1)
1944  !
1945 #ifdef W3_T2
1946  WRITE (ndst,9060) 3
1947  ixp0 = 1
1948  ixpn = min( ixp0+ixpwdt-1 , nxj(2) )
1949  DO
1950  CALL prtblk ( ndst, nxj(2), nyj(2), mxm, ac, mask, 0,&
1951  0., ixp0, ixpn, 1,1, nyj(2), 1, 'Field 3', ' ')
1952  IF (ixpn.NE.nxj(2)) THEN
1953  ixp0 = ixp0 + ixpwdt
1954  ixpn = min( ixpn+ixpwdt , nxj(2) )
1955  ELSE
1956  EXIT
1957  END IF
1958  END DO
1959 #endif
1960  !
1961  END IF
1962  !
1963  END IF
1964 
1965  ELSE ! ITYPE .NE. 5
1966  !
1967  IF ( iaproc .EQ. napout ) WRITE(ndso,*) "ITYPE5 TO DO"
1968  IF (idfmf(1).EQ.3) THEN
1969  READ (ndsf(1), END=862,ERR=862,IOSTAT=IERR) ndat
1970  ELSE
1971  READ (ndsf(1),*,END=862,ERR=862,IOSTAT=IERR) ndat
1972  END IF
1973 #ifdef W3_O3
1974  IF ( iaproc .EQ. napout ) WRITE (ndso,975) ndat
1975 #endif
1976  IF ( ndat.GT.0 ) THEN
1977  ALLOCATE ( DATA(recldt,ndat) )
1978  DO idat=1, ndat
1979  IF (idfmf(1).EQ.1) THEN
1980  READ (ndsf(1), * ,END=863,ERR=863, &
1981  iostat=ierr) DATA(:,idat)
1982  ELSE IF (idfmf(1).EQ.2) THEN
1983  READ (ndsf(1),formt(1),END=863,ERR=863, &
1984  iostat=ierr) DATA(:,idat)
1985  ELSE
1986  READ (ndsf(1), END=863,ERR=863, &
1987  iostat=ierr) DATA(:,idat)
1988  END IF
1989  END DO
1990  END IF
1991  !
1992 #ifdef W3_T2
1993  WRITE (ndst,9061)
1994  DO idat=1, ndat
1995  ix = min(6,recldt)
1996  WRITE (ndst,9062) idat, DATA(1:ix,idat)
1997  IF ( ix.LT.recldt ) WRITE (ndst,9063) DATA(ix+1:,:)
1998  END DO
1999 #endif
2000  !
2001  END IF
2002  !
2003  ! 8.b Interpolate fields
2004  ! ... No Interpolation, type AI (should not use array syntax !!!)
2005  !
2006  IF (itype.EQ.1.OR.itype.EQ.6) THEN
2007  !
2008  ! change fillvalue
2009  DO iy=1,ny
2010  DO ix=1,nx
2011  IF (xc(ix,iy) .EQ. fillvalue) xc(ix,iy)=0
2012  IF (yc(ix,iy) .EQ. fillvalue) yc(ix,iy)=0
2013  END DO
2014  END DO
2015 
2016  IF (( ifld.LE.2 .OR. ifld.EQ.7 ).AND.( .NOT. flberg )) THEN
2017  DO iy=1, ny
2018  DO ix=1, nx
2019  fa(ix,iy) = xc(ix,iy)
2020  END DO
2021  END DO
2022  ELSE
2023  DO iy=1, ny
2024  DO ix=1, nx
2025  fx(ix,iy) = xc(ix,iy)
2026  fy(ix,iy) = yc(ix,iy)
2027  fa(ix,iy) = ac(ix,iy)
2028  END DO
2029  END DO
2030  END IF
2031  !
2032  ELSE IF (itype.NE.5) THEN
2033  !
2034  ! ... One-component fields
2035  !
2036 #ifdef W3_O3
2037  IF ( iaproc .EQ. napout ) WRITE (ndso,976) ' '
2038 #endif
2039  IF (( ifld.LE.2 .OR. ifld.EQ.7 ).AND.( .NOT. flberg )) THEN
2040  !
2041  CALL interp(mxm, mym, xc, ix21, ix22, iy21, iy22, &
2042  rd11, rd12, rd21, rd22, fillvalue, fa)
2043  !
2044  IF (nfcomp.EQ.2) THEN
2045 #ifdef W3_O3
2046  IF ( iaproc .EQ. napout ) WRITE (ndso,976) ' (2) '
2047 #endif
2048  CALL interp(mxm, mym, yc, jx21, jx22, jy21, jy22, &
2049  xd11, xd12, xd21, xd22, fillvalue, fa)
2050  END IF
2051  !
2052  ! ... Two-component fields
2053  !
2054  ELSE !so if IFLD.GT.2
2055  !
2056  CALL interp(mxm, mym, xc, ix21, ix22, iy21, iy22, &
2057  rd11, rd12, rd21, rd22, fillvalue, fx)
2058 
2059  CALL interp(mxm, mym, yc, ix21, ix22, iy21, iy22, &
2060  rd11, rd12, rd21, rd22, fillvalue, fy)
2061 
2062  IF(flstab) THEN
2063  ! AC only populated if FLSTAB is true
2064  CALL interp(mxm, mym, ac, ix21, ix22, iy21, iy22, &
2065  rd11, rd12, rd21, rd22, fillvalue, fa)
2066  ENDIF
2067 
2068  WHERE ( xc.NE.fillvalue .AND. yc.NE.fillvalue)
2069  xtemp = xc*xc + yc*yc
2070  ELSEWHERE
2071  xtemp = fillvalue
2072  ENDWHERE
2073  CALL interp(mxm, mym, xtemp, ix21, ix22, iy21, iy22, &
2074  rd11, rd12, rd21, rd22, fillvalue, a3)
2075 
2076  WHERE ( xtemp.NE.fillvalue )
2077  xtemp = sqrt(xtemp)
2078  ENDWHERE
2079  CALL interp(mxm, mym, xtemp, ix21, ix22, iy21, iy22, &
2080  rd11, rd12, rd21, rd22, fillvalue, a2)
2081 
2082  DO iy=1,ny
2083  DO ix=1,nx
2084  a1(ix,iy) = max( 1.e-10 , &
2085  sqrt( fx(ix,iy)**2 + fy(ix,iy)**2 ) )
2086 
2087  a3(ix,iy) = sqrt( a3(ix,iy) )
2088  END DO
2089  END DO
2090  !
2091  ! ... Winds, correct for velocity or energy conservation
2092  !
2093 #ifdef W3_WNT1
2094  IF (ifld.EQ.3) THEN
2095  DO iy=1,ny
2096  DO ix=1,nx
2097  factor = min( 1.5 , a2(ix,iy)/a1(ix,iy) )
2098  fx(ix,iy) = factor * fx(ix,iy)
2099  fy(ix,iy) = factor * fy(ix,iy)
2100  END DO
2101  END DO
2102  END IF
2103 #endif
2104  !
2105 #ifdef W3_WNT2
2106  IF (ifld.EQ.3) THEN
2107  DO iy=1,ny
2108  DO ix=1,nx
2109  factor = min( 1.5 , a3(ix,iy)/a1(ix,iy) )
2110  fx(ix,iy) = factor * fx(ix,iy)
2111  fy(ix,iy) = factor * fy(ix,iy)
2112  END DO
2113  END DO
2114  END IF
2115 #endif
2116  !
2117  ! ... Currents, correct for velocity or energy conservation
2118  !
2119 #ifdef W3_CRT1
2120  IF (ifld.EQ.4) THEN
2121  DO iy=1,ny
2122  DO ix=1,nx
2123  factor = min( 1.5 , a2(ix,iy)/a1(ix,iy) )
2124  fx(ix,iy) = factor * fx(ix,iy)
2125  fy(ix,iy) = factor * fy(ix,iy)
2126  END DO
2127  END DO
2128  END IF
2129 #endif
2130  !
2131 #ifdef W3_CRT2
2132  IF (ifld.EQ.4) THEN
2133  DO iy=1,ny
2134  DO ix=1,nx
2135  factor = min( 1.5 , a3(ix,iy)/a1(ix,iy) )
2136  fx(ix,iy) = factor * fx(ix,iy)
2137  fy(ix,iy) = factor * fy(ix,iy)
2138  END DO
2139  END DO
2140  END IF
2141 #endif
2142  !
2143  ! ... Momentum, correct for velocity or energy conservation
2144  !
2145 #ifdef W3_WNT1
2146  IF (ifld.EQ.6) THEN
2147  DO iy=1,ny
2148  DO ix=1,nx
2149  factor = min( 1.5 , a2(ix,iy)/a1(ix,iy) )
2150  fx(ix,iy) = factor * fx(ix,iy)
2151  fy(ix,iy) = factor * fy(ix,iy)
2152  END DO
2153  END DO
2154  END IF
2155 #endif
2156  !
2157 #ifdef W3_WNT2
2158  IF (ifld.EQ.6) THEN
2159  DO iy=1,ny
2160  DO ix=1,nx
2161  factor = min( 1.5 , a3(ix,iy)/a1(ix,iy) )
2162  fx(ix,iy) = factor * fx(ix,iy)
2163  fy(ix,iy) = factor * fy(ix,iy)
2164  END DO
2165  END DO
2166  END IF
2167 #endif
2168  !
2169  END IF
2170  !
2171  END IF
2172  !
2173  ! ... Test output
2174  !
2175 #ifdef W3_T3
2176  IF ( .NOT. ALLOCATED(mapout) ) ALLOCATE ( mapout(nx,ny) )
2177  WRITE (ndst,9065)
2178  DO ix=1, nx
2179  DO iy=1, ny
2180  mapout(ix,iy) = mapsta(iy,ix)
2181  END DO
2182  END DO
2183  ix0 = 1
2184  ixn = min( ix0+ixwdt-1 , nx )
2185  DO
2186  IF (ifld.EQ.1) THEN
2187  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
2188  ix0, ixn, 1, 1, ny, 1, 'Fraction ice', '(-)')
2189  IF ( flberg ) &
2190  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
2191  ix0, ixn, 1, 1, ny, 1, 'Iceberg a', '0.1/km')
2192  ELSE IF (ifld.EQ.2) THEN
2193  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
2194  ix0, ixn, 1, 1, ny, 1, 'Water level', 'm')
2195  ELSE IF (ifld.EQ.7) THEN
2196  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
2197  ix0, ixn, 1, 1, ny, 1, 'Air density', 'kg/m3')
2198  ELSE
2199  CALL prtblk (ndso, nx, ny, nx, fx, mapout, 0, 0., &
2200  ix0, ixn, 1, 1, ny, 1, 'Cart. X-comp', 'm/s')
2201  CALL prtblk (ndso, nx, ny, nx, fy, mapout, 0, 0., &
2202  ix0, ixn, 1, 1, ny, 1, 'Cart. Y-comp', 'm/s')
2203  IF ( flstab ) &
2204  CALL prtblk (ndso, nx, ny, nx, fa, mapout, 0, 0., &
2205  ix0, ixn, 1, 1, ny, 1, 'Tair-Tsea', 'degr')
2206  END IF
2207  IF (ixn.NE.nx) THEN
2208  ix0 = ix0 + ixwdt
2209  ixn = min( ixn+ixwdt , nx )
2210  ELSE
2211  EXIT
2212  END IF
2213  END DO
2214 #endif
2215  !
2216  ! 8.c Write fields
2217  !
2218  IF ( itype .LE. 4 .OR. itype.EQ.6 ) THEN
2219 #ifdef W3_O3
2220  IF ( iaproc .EQ. napout ) WRITE (ndso,977)
2221 #endif
2222  IF ( iaproc .EQ. napout ) CALL w3fldg ('WRITE', idfld, ndsdat, ndst, ndse, nx, ny, &
2223  nx, ny, time, time, time, fx, fy, fa, time, &
2224  fx, fy, fa, ierr)
2225 
2226  ELSE IF ( itype .EQ. 5 ) THEN
2227  IF ( ndat .EQ. 0 ) THEN
2228 #ifdef W3_O3
2229  IF ( iaproc .EQ. napout ) WRITE (ndso,978)
2230 #endif
2231  ELSE
2232 #ifdef W3_O3
2233  IF ( iaproc .EQ. napout ) WRITE (ndso,977)
2234 #endif
2235  IF ( iaproc .EQ. napout ) CALL w3fldd ('WRITE', idfld, ndsdat, ndst, ndse, time,&
2236  time, recldt, ndat, idat, DATA, ierr )
2237  DEALLOCATE ( DATA )
2238  END IF
2239  END IF
2240  IF (ierr.NE.0) CALL extcde ( 30 )
2241  !
2242  END DO ! NTI
2243  !
2244  DEALLOCATE(xc,yc,ac,xtemp)
2245  IF (ALLOCATED(ala)) DEALLOCATE(ala,alo)
2246  !
2247  ! End loop over input fields
2248  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2249  !
2250 880 CONTINUE
2251  GOTO 888
2252  !
2253  ! Error escape locations
2254  !
2255 800 CONTINUE
2256  WRITE (ndse,1000) ierr
2257  CALL extcde ( 40 )
2258  !
2259 801 CONTINUE
2260  WRITE (ndse,1001)
2261  CALL extcde ( 41 )
2262  !
2263 802 CONTINUE
2264  WRITE (ndse,1002) ierr
2265  CALL extcde ( 42 )
2266  !
2267 803 CONTINUE
2268  WRITE (ndse,1003) ierr
2269  CALL extcde ( 43 )
2270  !
2271 810 CONTINUE
2272  WRITE (ndse,1010)
2273  CALL extcde ( 1010 )
2274  !
2275 811 CONTINUE
2276  WRITE (ndse,1011)
2277  CALL extcde ( 1011 )
2278  !
2279 845 CONTINUE
2280  WRITE (ndse,1045) ierr
2281  CALL extcde ( 49 )
2282  !
2283 846 CONTINUE
2284  WRITE (ndse,1046) ierr
2285  CALL extcde ( 50 )
2286  !
2287 862 CONTINUE
2288  WRITE (ndse,1062) ierr
2289  CALL extcde ( 54 )
2290  !
2291 863 CONTINUE
2292  WRITE (ndse,1063) idat, ierr
2293  CALL extcde ( 55 )
2294 864 CONTINUE
2295  WRITE (ndse,1064) trim(strdimsname)
2296  CALL extcde ( 56 )
2297  !
2298 #ifdef W3_O15
2299 870 CONTINUE
2300  WRITE (ndse,1070) idfld, ierr
2301  CALL extcde ( 57 )
2302 #endif
2303  !
2304 #ifdef W3_O15
2305 871 CONTINUE
2306  WRITE (ndse,1071) idtime, ierr
2307  CALL extcde ( 58 )
2308 #endif
2309  !
2310 888 CONTINUE
2311  IF ( iaproc .EQ. napout ) WRITE (ndso,999)
2312 #ifdef W3_MPI
2313  CALL mpi_finalize ( ierr_mpi )
2314 #endif
2315 
2316  !
2317 #ifdef W3_NCO
2318  ! CALL W3TAGE('WAVEPREP')
2319 #endif
2320 
2321 
2322  !
2323  ! Formats
2324  !
2325 900 FORMAT (/15x,' *** WAVEWATCH III Input pre-processing *** '/ &
2326  15x,'==============================================='/)
2327 901 FORMAT ( ' Comment character is ''',a,''''/)
2328 902 FORMAT ( ' Grid name : ',a/)
2329  !
2330 930 FORMAT (/' Description of inputs'/ &
2331  ' --------------------------------------------------'/ &
2332  ' Input type : ',a/ &
2333  ' Format type : ',a)
2334 1930 FORMAT ( ' Field conserves velocity.')
2335 2930 FORMAT ( ' Field corrected for energy conservation.')
2336 1931 FORMAT ( ' Start time : ',a)
2337 2931 FORMAT ( ' Stop time : ',a)
2338 2932 FORMAT ( ' Calendar : ',a)
2339 3931 FORMAT ( ' Shifted time : ',a)
2340 932 FORMAT (/' Input grid dim. :',i9,3x,i5)
2341 1933 FORMAT ( ' Longitude range :',2f8.2,' (deg)'/ &
2342  ' Latitude range :',2f8.2,' (deg)')
2343 2933 FORMAT ( ' X range :',2f8.2,' (km)'/ &
2344  ' Y range :',2f8.2,' (km)')
2345 934 FORMAT (/' Data type : ',a/ &
2346  ' Data record length:',i5/ &
2347  ' Missing values :',f8.2)
2348 935 FORMAT ( 'DT',i1 )
2349 938 FORMAT ( ' Icebergs included.')
2350 939 FORMAT ( ' Air-sea temperature differences included.')
2351  !
2352 940 FORMAT (//' Preprocessing data'/ &
2353  ' --------------------------------------------------')
2354 941 FORMAT ( ' Interpolation factors ..... '/ &
2355  ' (longitude-latitude grid)')
2356 942 FORMAT ( ' Interpolation factors ..... '/ &
2357  ' (grid from file)')
2358 943 FORMAT (/' Longitude-latitude file ',i1,' :'/ &
2359  ' ---------------------------------------')
2360 944 FORMAT ( ' Input grid dim. :',i9,3x,i5/ &
2361  ' Closed longitudes :',l5)
2362 945 FORMAT ( ' Layout indicator :',i5/ &
2363  ' Format indicator :',i5)
2364 946 FORMAT ( ' Format : ',a)
2365 947 FORMAT ( ' Unit number :',i5)
2366 948 FORMAT ( ' File name : ',a)
2367 949 FORMAT (/' Corresponding map file '/ &
2368  ' ---------------------------------------')
2369  !
2370 960 FORMAT (/' Data file :'/ &
2371  ' ---------------------------------------')
2372 961 FORMAT (/' Data file :'/ &
2373  ' ---------------------------------------'/ &
2374  ' Input grid dim. :',i9,3x,i5)
2375 962 FORMAT (/' Data file (',i1,') :'/ &
2376  ' ---------------------------------------'/ &
2377  ' Input grid dim. :',i9,3x,i5)
2378 967 FORMAT (/' File name : ',a)
2379 968 FORMAT ( ' Dimension along x : ',a/ &
2380  ' Dimension along y : ',a)
2381 969 FORMAT ( ' Field component ',i1,' : ',a)
2382  !
2383 971 FORMAT (/' Opening output data file .....')
2384 972 FORMAT (//' Processing data'/ &
2385  ' --------------------------------------------------')
2386 1973 FORMAT ( ' Shifted Time : ',a,' (File time : ',a,')')
2387 2973 FORMAT ( ' Time : ',a)
2388 
2389 #ifdef W3_O3
2390 974 FORMAT ( ' reading ....')
2391 975 FORMAT ( ' number of data records :',i6)
2392 976 FORMAT ( ' interpolating',a,'....')
2393 977 FORMAT ( ' writing ....')
2394 978 FORMAT ( ' skipping ....')
2395 #endif
2396  !
2397 #ifdef W3_O15
2398 979 FORMAT (1x,i8.8,1x,i6.6)
2399 #endif
2400  !
2401 999 FORMAT(//' End of program '/ &
2402  ' ========================================='/ &
2403  ' WAVEWATCH III Input preprocessing '/)
2404  !
2405 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2406  ' ERROR IN OPENING INPUT FILE'/ &
2407  ' IOSTAT =',i5/)
2408  !
2409 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2410  ' PREMATURE END OF INPUT FILE'/)
2411  !
2412 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2413  ' ERROR IN READING FROM INPUT FILE'/ &
2414  ' IOSTAT =',i5/)
2415  !
2416 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2417  ' ERROR IN READING FROM INPUT FILE'/ &
2418  ' EXPECTING LIST OF TIDAL CONST. OR FAST OR VFAST'/&
2419  ' IOSTAT =',i5/)
2420  !
2421 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2422  ' NO FIELD SELECTED'/)
2423 1011 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2424  ' NO GRID SELECTED'/)
2425  !
2426 1026 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2427  ' _FillValue ATTRIBUTE NOT DEFINED FOR : ',a/)
2428  !
2429 1027 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2430  ' INCOMPATIBLE CALENDARS:' / &
2431  ' MODEL CALENDAR : ', a / &
2432  ' INPUT FILE CALENDAR : ', a /)
2433 1028 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ &
2434  ' calendar ATTRIBUTE NOT DEFINED'/ &
2435  ' DEFAULTING TO "standard" CALENDAR'/ &
2436  ' INPUT FILE MUST RESPECT STANDARD/GREGORIAN CALENDAR')
2437 1029 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2438  ' UNKNOWN CALENDAR TYPE: ', a / &
2439  ' "calendar" ATTRIBUTE MUST BE ONE OF: '/ &
2440  ' - standard'/ &
2441  ' - gregorian'/ &
2442  ' - 360_day'/ )
2443 1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2444  ' ILLEGAL FIELD ID -->',a,'<--'/)
2445 1031 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2446  ' ILLEGAL FORMAT ID -->',a,'<--'/)
2447 1032 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2448  ' LATITUDE VALUES MUST BE REVERSED'/ &
2449  ' EXAMPLE: ncpdq -h -O -a -lat file.nc'/ )
2450  !
2451 1033 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2452  ' ILLEGAL DATA RECORD LENGTH : ',i6/)
2453 1034 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2454  ' ILLEGAL DATA TYPE : ',i2/)
2455  !
2456 1035 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2457  ' ILLEGAL TIME : ',i8.8,i7.6/)
2458 1036 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2459  ' ILLEGAL SIZE OF INPUT GRID : ',i5,1x,i5/)
2460 1038 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ &
2461  ' DATA READ FROM INPUT FILE')
2462 1039 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ &
2463  ' NAN VALUES IN HARMONICS '/ &
2464  ' REMOVE NON-LINEAR TIDAL COMPONENTS '/ &
2465  ' 2MS2 2MN2 2NK2 MNS2 MSN2 2SM2 3MSN2 ' &
2466  ' M4 MS4 MN4 M6 2MS6 2MN6'/)
2467  !
2468 1041 FORMAT (/' *** WAVEWATCH-III WARNING W3PRNC : '/ &
2469  ' GRID POINT ',i6,2f7.2,/ &
2470  ' NOT COVERED BY INPUT GRID.'/)
2471 1042 FORMAT (/' *** WAVEWATCH-III WARNING W3PRNC : '/ &
2472  ' GRID POINT ',2i6,2f7.2,/ &
2473  ' NOT COVERED BY INPUT GRID.'/)
2474 1043 FORMAT (/' *** WAVEWATCH III WARNING W3PRNC : '/ &
2475  ' X = ',f10.1,' NOT COVERED BY INPUT GRID.'/)
2476 1044 FORMAT (/' *** WAVEWATCH III WARNING W3PRNC : '/ &
2477  ' Y = ',f10.1,' NOT COVERED BY INPUT GRID.'/)
2478  !
2479 
2480  !
2481 1045 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2482  ' ERROR IN OPENING LAT-LONG DATA FILE'/ &
2483  ' IOSTAT =',i5/)
2484  !
2485 1046 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2486  ' ERROR IN OPENING MASK FILE'/ &
2487  ' IOSTAT =',i5/)
2488  !
2489 1047 FORMAT (/' *** WAVEWATCH III WARNING IN W3PRNC : '/ &
2490  ' NO TIDAL COMPUTATION AT NODE [',i8,',',i8,']'/)
2491  !
2492 1062 FORMAT (/' *** WAVEWATCH III ERROR IN W3PREP : '/ &
2493  ' ERROR IN READING NDAT FROM FILE'/ &
2494  ' IOSTAT =',i5/)
2495 1063 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2496  ' ERROR IN READING DATA RECORD',i6,' FROM FILE'/ &
2497  ' IOSTAT =',i5/)
2498 1064 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2499  ' GRID DIMENSIONS ', a,' NOT FOUND... CHECK DIMENSION NAMES')
2500  !
2501 #ifdef W3_O15
2502 1070 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2503  ' ERROR IN CREATING A TIMES FILE FOR ',a/ &
2504  ' IOSTAT =',i5/)
2505 1071 FORMAT (/' *** WAVEWATCH III ERROR IN W3PRNC : '/ &
2506  ' ERROR IN WRITING TIME OUTPUT ',a/ &
2507  ' IOSTAT =',i5/)
2508 #endif
2509  !
2510 #ifdef W3_T
2511 9040 FORMAT (' TEST W3PRNC : INPUT GRID RANGES AND INCR. AFTER CORR.'/ &
2512  ' LON / X : ',3f10.2, &
2513  ' (GLOBAL=',l1,')'/ &
2514  ' LAT / Y : ',3f10.2)
2515 9041 FORMAT (' TEST W3PRNC : INTERPOLATION DATA FOR ',a)
2516 9042 FORMAT (' ',i4,f8.2,2i4,2f8.2,1x,f6.3,1x,a)
2517 9043 FORMAT (' TEST W3PRNC : GRID SHIFTED BY ',f5.0,' DEGREES / M')
2518 #endif
2519 #ifdef W3_T1
2520 9045 FORMAT (' TEST W3PRNC : IX, IY, IXI(2), IYI(2), RD(4)')
2521 9046 FORMAT (' ',2i4,2x,4i4,2x,4f6.2)
2522 #endif
2523  !
2524 #ifdef W3_T1a
2525 9050 FORMAT (' TEST W3PRNC : LAT-LONG OF INPUT FILE ')
2526 9051 FORMAT (' ',2i4,2f8.2,i4)
2527 #endif
2528  !
2529 #ifdef W3_T2
2530 9060 FORMAT (' TEST W3PRNC : INPUT FIELD (',i1,') :'/)
2531 9061 FORMAT (' TEST W3PRNC : INPUT DATA RECORDS :')
2532 9062 FORMAT (' ',i6,' : ',6e11.3)
2533 9063 FORMAT (' ',6e11.3)
2534 #endif
2535 #ifdef W3_T3
2536 9065 FORMAT (' TEST W3PRNC : OUTPUT FIELD(S) :'/)
2537 #endif
2538  !/
2539  !/ End of W3PRNC ----------------------------------------------------- /
2540  !/
2541 
2542 END PROGRAM w3prnc
2543 
2544 !==============================================================================
2578 SUBROUTINE interp(MXM, MYM, XC, IX21, IX22, IY21, IY22, &
2579  RD11, RD12, RD21, RD22, FILLVALUE, FA)
2580  !/
2581  !/ +-----------------------------------+
2582  !/ | WAVEWATCH III NOAA/NCEP |
2583  !/ | J. M. Castillo |
2584  !/ | FORTRAN 90 |
2585  !/ | Last update : 23-Feb-2021 |
2586  !/ +-----------------------------------+
2587  !/
2588  !/ 23-Feb-2021 : First version ( version 7.12 )
2589  !/
2590  ! 1. Purpose :
2591  !
2592  ! Interpolate from a field read from file to the wave grid
2593  !
2594  ! 2. Method :
2595  !
2596  ! Invalid points are identified by the fill value read from the
2597  ! netcdf input, and interpolation does not take into account
2598  ! these points. The valid interpolation coefficients are scaled
2599  ! so that the sum is one, otherwise unphysical values can be
2600  ! generated.
2601  !
2602  ! When one point is on the boundary but is not an ocean grid point,
2603  ! the interpolation coefficients are zero, and in this case we
2604  ! provide a sensible value - the value as read, not interpolated
2605  !
2606  ! 3. Parameters :
2607  !
2608  ! Parameter list
2609  ! ----------------------------------------------------------------
2610  ! MxM I I Dimensions of the XC variable
2611  ! XC R.A. I Field to be interpolated, as read from the
2612  ! input netcdf
2613  ! IXxx I.A. I List of x-index to convert from the original
2614  ! field to the model grid
2615  ! IYxx I.A. I List of y-index to convert from the original
2616  ! field to the model grid
2617  ! RDxx R.A. I Interpolation factors
2618  ! FILLVALUE R I Fill value identifying non valid input
2619  ! FA F O Result of the interpolation
2620  ! ----------------------------------------------------------------
2621  !
2622  ! 4. Subroutines used :
2623  !
2624  ! None
2625  !
2626  ! 5. Called by :
2627  !
2628  ! Name Type Module Description
2629  ! ----------------------------------------------------------------
2630  ! WW3_PRNC Prog. N/A Input data preprocessor.
2631  ! ----------------------------------------------------------------
2632  !
2633  ! 6. Error messages :
2634  !
2635  ! None
2636  !
2637  ! 7. Remarks :
2638  !
2639  ! 8. Structure :
2640  !
2641  ! See source code.
2642  !
2643  ! 9. Switches :
2644  !
2645  ! 10. Source code :
2646  !
2647  !/ ------------------------------------------------------------------- /
2648  USE w3gdatmd, ONLY: nx, ny
2649 
2650  IMPLICIT NONE
2651  !/
2652  !/ ------------------------------------------------------------------- /
2653  !/ Parameter list
2654  !/
2655  INTEGER, INTENT(IN) :: MXM, MYM
2656  REAL, DIMENSION(MXM,MYM), INTENT(IN) :: XC
2657  INTEGER, DIMENSION(NX,NY), INTENT(IN) :: IX21, IX22, IY21, IY22
2658  REAL, DIMENSION(NX,NY), INTENT(IN) :: RD11, RD12, RD21, RD22
2659  REAL, INTENT(IN) :: FILLVALUE
2660  REAL, DIMENSION(NX,NY), INTENT(OUT) :: FA
2661  !/
2662  !/ ------------------------------------------------------------------- /
2663  !/ Local variables
2664  !/
2665  INTEGER :: IX, IY
2666  REAL :: FACTOR
2667  !/ ------------------------------------------------------------------- /
2668 
2669  DO iy=1,ny
2670  DO ix=1,nx
2671  factor = 0.0
2672  fa(ix,iy) = 0.0
2673 
2674  IF(xc(ix21(ix,iy),iy21(ix,iy)).NE.fillvalue) THEN
2675  factor = factor + rd11(ix,iy)
2676  fa(ix,iy) = rd11(ix,iy) * xc(ix21(ix,iy),iy21(ix,iy))
2677  ENDIF
2678  IF(xc(ix22(ix,iy),iy21(ix,iy)).NE.fillvalue) THEN
2679  factor = factor + rd21(ix,iy)
2680  fa(ix,iy) = fa(ix,iy) + rd21(ix,iy) * xc(ix22(ix,iy),iy21(ix,iy))
2681  ENDIF
2682  IF(xc(ix21(ix,iy),iy22(ix,iy)).NE.fillvalue) THEN
2683  factor = factor + rd12(ix,iy)
2684  fa(ix,iy) = fa(ix,iy) + rd12(ix,iy) * xc(ix21(ix,iy),iy22(ix,iy))
2685  ENDIF
2686  IF(xc(ix22(ix,iy),iy22(ix,iy)).NE.fillvalue) THEN
2687  factor = factor + rd22(ix,iy)
2688  fa(ix,iy) = fa(ix,iy) + rd22(ix,iy) * xc(ix22(ix,iy),iy22(ix,iy))
2689  ENDIF
2690 
2691  IF(factor.GT.0.0) THEN
2692  fa(ix,iy) = fa(ix,iy) / factor
2693  ELSE
2694  ! Interpolation coefficients sum to zero - could be on a boundary
2695  ! (see note in "method" above). If any surrounding points have a
2696  ! valid value then use one of them, otherwise set to zero.
2697  IF( xc(ix21(ix,iy),iy21(ix,iy)) .NE. fillvalue) THEN
2698  fa(ix,iy) = xc(ix21(ix,iy),iy21(ix,iy))
2699  ELSE IF( xc(ix22(ix,iy),iy21(ix,iy)) .NE. fillvalue) THEN
2700  fa(ix,iy) = xc(ix22(ix,iy),iy21(ix,iy))
2701  ELSE IF( xc(ix21(ix,iy),iy22(ix,iy)) .NE. fillvalue) THEN
2702  fa(ix,iy) = xc(ix21(ix,iy),iy22(ix,iy))
2703  ELSE IF( xc(ix22(ix,iy),iy22(ix,iy)) .NE. fillvalue) THEN
2704  fa(ix,iy) = xc(ix22(ix,iy),iy22(ix,iy))
2705  ELSE
2706  ! All surrounding points are FILLVALUE - set to zero.
2707  fa(ix,iy) = 0.0
2708  END IF
2709  END IF
2710  END DO
2711  END DO
2712 
2713 END SUBROUTINE interp
2714 
2715 !==============================================================================
2721 SUBROUTINE check_error(IRET, ILINE)
2722 
2723  USE netcdf
2724  USE w3odatmd, ONLY: ndse
2725  USE w3servmd, ONLY: extcde
2726 
2727  IMPLICIT NONE
2728 
2729  INTEGER IRET, ILINE
2730 
2731  IF (iret .NE. nf90_noerr) THEN
2732  WRITE(ndse,*) ' *** WAVEWATCH III ERROR IN PRNC :'
2733  WRITE(ndse,*) ' LINE NUMBER ', iline
2734  WRITE(ndse,*) ' NETCDF ERROR MESSAGE: '
2735  WRITE(ndse,*) nf90_strerror(iret)
2736  CALL extcde ( 59 )
2737  END IF
2738  RETURN
2739 
2740 END SUBROUTINE check_error
2741 
2742 !==============================================================================
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
include
cmake src_list cmake include(${CMAKE_CURRENT_SOURCE_DIR}/cmake/check_switches.cmake) check_switches("$
Definition: CMakeLists.txt:15
w3nmlprncmd::nml_file_t
Definition: w3nmlprncmd.F90:63
w3adatmd
Define data structures to set up wave model auxiliary data for several models simultaneously.
Definition: w3adatmd.F90:26
w3timemd::t2d
subroutine t2d(TIME, DAT, IERR)
Definition: w3timemd.F90:1072
w3fldsmd::w3fldtide1
subroutine w3fldtide1(INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IERR)
Definition: w3fldsmd.F90:531
w3tidemd
Definition: w3tidemd.F90:3
w3gsrumd
Definition: w3gsrumd.F90:17
w3odatmd::iaproc
integer, pointer iaproc
Definition: w3odatmd.F90:457
w3gdatmd::gname
character(len=30), pointer gname
Definition: w3gdatmd.F90:1223
w3gdatmd::ny
integer, pointer ny
Definition: w3gdatmd.F90:1097
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
w3servmd::strsplit
subroutine strsplit(STRING, TAB)
Definition: w3servmd.F90:1440
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
w3timemd::d2j
subroutine d2j(DAT, JULIAN, IERR)
Definition: w3timemd.F90:1227
w3odatmd::naperr
integer, pointer naperr
Definition: w3odatmd.F90:457
w3servmd
Definition: w3servmd.F90:3
w3nmlprncmd::nml_forcing_t
Definition: w3nmlprncmd.F90:54
w3odatmd::w3seto
subroutine w3seto(IMOD, NDSERR, NDSTST)
Definition: w3odatmd.F90:1523
w3odatmd
Definition: w3odatmd.F90:3
w3adatmd::w3naux
subroutine w3naux(NDSE, NDST)
Set up the number of grids to be used.
Definition: w3adatmd.F90:704
w3prnc
program w3prnc
Pre-processing of input fields.
Definition: ww3_prnc.F90:22
w3odatmd::naproc
integer, pointer naproc
Definition: w3odatmd.F90:457
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
w3nmlprncmd::w3nmlprnc
subroutine w3nmlprnc(NDSI, INFILE, NML_FORCING, NML_FILE, IERR)
Definition: w3nmlprncmd.F90:82
check_err
subroutine check_err(IRET)
Check input return status for error value.
Definition: ww3_bounc.F90:856
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::napout
integer, pointer napout
Definition: w3odatmd.F90:457
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
w3fldsmd::w3fldtide2
subroutine w3fldtide2(INXOUT, NDS, NDST, NDSE, NX, NY, IDFLD, IDAT, IERR)
Definition: w3fldsmd.F90:722
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
interp
subroutine interp(MXM, MYM, XC, IX21, IX22, IY21, IY22, RD11, RD12, RD21, RD22, FILLVALUE, FA)
Interpolate from a field read from file to the wave grid.
Definition: ww3_prnc.F90:2580
w3nmlprncmd
Definition: w3nmlprncmd.F90:3
check_error
subroutine check_error(IRET, ILINE)
Desc not available.
Definition: ww3_ounf.F90:3904
w3gdatmd::nx
integer, pointer nx
Definition: w3gdatmd.F90:1097
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
w3gsrumd::t_gsu
Definition: w3gsrumd.F90:325
w3fldsmd
Definition: w3fldsmd.F90:3