WAVEWATCH III  beta 0.0.1
ww3_ounf.F90
Go to the documentation of this file.
1 
6 
7 #include "w3macros.h"
8 #define CHECK_ERR(I) CHECK_ERROR(I, __LINE__)
9 !/ ------------------------------------------------------------------- /
10 
21 PROGRAM w3ounf
22  !/
23  !/ +-----------------------------------+
24  !/ | WAVEWATCH III NOAA/NCEP |
25  !/ | F. Ardhuin |
26  !/ | M. Accensi |
27  !/ | FORTRAN 90 |
28  !/ | Last update : 02-Sep-2021 |
29  !/ +-----------------------------------+
30  !/
31  !/ 17-Mar-2010 : Creation ( version 3.14_SHOM )
32  !/ 07-Nov-2011 : Debug for spectral output on UNST ( version 4.04 )
33  !/ 13-Mar-2012 : Update of NC attributes ( version 4.04 )
34  !/ 02-Apr-2013 : New structure of output fields. ( version 4.10 )
35  !/ 02-Jul-2013 : Bug correction for lat in unst grid ( version 4.11 )
36  !/ 02-Nov-2013 : Removes unnecessary IDFM ( version 4.12 )
37  !/ 30-Apr-2014 : Correct group3 freq dim. ( version 5.00 )
38  !/ 23-May-2014 : Adding ice fluxes to W3SRCE ( version 5.01 )
39  !/ 14-Oct-2014 : Keep the output files opened ( version 5.01 )
40  !/ 27-Aug-2015 : ICEH and ICEF added as output ( version 5.10 )
41  !/ 10-Jan-2017 : Changes for US3D and USSP output ( version 6.01 )
42  !/ 01-May-2017 : Adds directional MSS parameters ( version 6.04 )
43  !/ 01-Mar-2018 : RTD option add variable de-rotation,( version 6.02 )
44  !/ standard lat-lons and rotated grid
45  !/ metadata
46  !/ 15-May-2018 : Add namelist feature ( version 6.05 )
47  !/ 06-Jun-2018 : Add DEBUG/SETUP ( version 6.04 )
48  !/ 27-Jun-2018 : Updated to handle SMC output. ( version 6.05 )
49  !/ 26-Jul-2018 : Changed reading of TABIPART ( version 6.05 )
50  !/ 12-Sep-2018 : Added extra partitioned fields ( version 6.06 )
51  !/ 25-Sep-2018 : Add WBT parameter ( version 6.06 )
52  !/ 28-Mar-2019 : Bugfix to NBIPART check. ( version 6.07 )
53  !/ 18-Jun-2020 : Support for 360-day calendar. ( version 7.08 )
54  !/ 07-Oct-2019 : RTD option with standard lat-lon
55  !/ grid when nesting to rotated grid ( version 7.11 )
56  !/ 03-Nov-2020 : Moved NetCDF metadata to separate ( version 7.12 )
57  !/ module.
58  !/ 09-Dec-2020 : Set fixed values for VARID indices ( version 7.12 )
59  !/ 06-Jan-2021 : Added forecast_period and ( version 7.12 )
60  !/ forecast_reference_time variables.
61  !/ 12-Jan-2021 : Alternative vartype and units for ( version 7.12 )
62  !/ time variables.
63  !/ 26-Jan-2021 : Added TP output (derived from fp) ( version 7.12 )
64  !/ and alternative dir/mag output.
65  !/ 02-Feb-2021 : Make default global meta optional ( version 7.12 )
66  !/ 22-Mar-2021 : New coupling fields output ( version 7.12 )
67  !/ 02-Sep-2021 : Added coordinates attribute ( version 7.12 )
68  !/ 14-Feb-2023 : Added QKK output ( version 7.12 )
69  !/ 03-Mar-2024 : Added SKEW & EMBIAS output ( version 7.xx )
70  !/
71  !/ Copyright 2009-2013 National Weather Service (NWS),
72  !/ National Oceanic and Atmospheric Administration. All rights
73  !/ reserved. WAVEWATCH III is a trademark of the NWS.
74  !/ No unauthorized use without permission.
75  !/
76  ! 1. Purpose :
77  !
78  ! Post-processing of grid output to NetCDF files
79  !
80  ! 2. Method :
81  !
82  ! Data is read from the grid output file out_grd.ww3 (raw data)
83  ! and from the file ww3_ounf.nml or ww3_ounf.inp (NDSI)
84  ! Model definition and raw data files are read using WAVEWATCH III
85  ! subroutines. Extra global NetCDF attributes may be read from
86  ! ASCII file NC_globatt.inp.
87  !
88  ! Output types :
89  ! 4 : NetCDF files
90  !
91  ! 3. Parameters :
92  !
93  ! 4. Subroutines used :
94  !
95  ! Name Type Module Description
96  ! ----------------------------------------------------------------
97  ! W3NMOD Subr. W3GDATMD Set number of model.
98  ! W3SETG Subr. Id. Point to selected model.
99  ! W3NDAT Subr. W3WDATMD Set number of model for wave data.
100  ! W3SETW Subr. Id. Point to selected model for wave data.
101  ! W2NAUX Subr. W3ADATMD Set number of model for aux data.
102  ! W3SETA Subr. Id. Point to selected model for aux data.
103  ! ITRACE Subr. W3SERVMD Subroutine tracing initialization.
104  ! STRACE Subr. Id. Subroutine tracing.
105  ! NEXTLN Subr. Id. Get next line from input filw
106  ! EXTCDE Subr. Id. Abort program as graceful as possible.
107  ! STME21 Subr. W3TIMEMD Convert time to string.
108  ! TICK21 Subr. Id. Advance time.
109  ! DSEC21 Func. Id. Difference between times.
110  ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file.
111  ! W3IOGO Subr. W3IOGOMD Reading/writing raw gridded data file.
112  ! W3EXNC Subr. Internal Execute grid netcdf output.
113  ! ----------------------------------------------------------------
114  !
115  ! 5. Called by :
116  !
117  ! None, stand-alone program.
118  !
119  ! 6. Error messages :
120  !
121  ! Checks on input, checks in W3IOxx.
122  !
123  ! 7. Remarks :
124  !
125  ! The VARID array stores netCDF variable IDs for all variables in
126  ! file. The first 20 elements are reserved for dimension/auxiliary
127  ! variables as defined below:
128  !
129  ! Index Variable
130  ! ===== ========
131  ! 1 Lon
132  ! 2 Lat
133  ! 3 Time
134  ! 4 Tri (UGRD)
135  ! 5 SMC CX (SMC)
136  ! 6 SMC CY (SMC)
137  ! 7 Standard longitude (SMC/RTD)
138  ! 8 Standard latitude (SMC/RTD)
139  ! 9 Coordinate reference system (upcoming feature / RTD)
140  ! 10 Freq (extradim)
141  ! 11 Forecast period (upcoming feature)
142  ! 12 Forecast reference time (upcoming feature)
143  ! 13-19 [Reserved for future use]
144  ! 20 MAPSTA
145  !
146  ! Indices 21 - 300 are for storage of field output variable IDs.
147  !
148  ! 8. Structure :
149  !
150  ! See source code.
151  !
152  ! 9. Switches :
153  !
154  ! !/S Enable subroutine tracing.
155  !
156  ! 10. Source code :
157  !
158  !/ ------------------------------------------------------------------- /
159  USE constants
160 
161  !/
162  USE w3wdatmd, ONLY: w3ndat, w3setw
163  USE w3adatmd, ONLY: w3naux, w3seta
164  USE w3odatmd, ONLY: w3nout, w3seto
165  USE w3servmd, ONLY : itrace, nextln, extcde, str_to_upper
166 #ifdef W3_S
167  USE w3servmd, ONLY : strace
168 #endif
169  USE w3timemd
170  USE w3iogrmd, ONLY: w3iogr
171  USE w3iogomd, ONLY: w3iogo, w3readflgrd, w3flgrdflag
172  USE w3initmd, ONLY: wwver, switches
173  USE w3odatmd, ONLY: naproc, noswll, ptmeth, ptfcut
174  USE w3odatmd, only : iaproc
175  !/
176  USE w3gdatmd
177  USE w3wdatmd, ONLY: time, wlv, ice, iceh, icef, berg, &
178  ust, ustdir, rhoair
179 #ifdef W3_SETUP
180  USE w3wdatmd, ONLY: zeta_setup
181 #endif
182  USE w3adatmd, ONLY: dw, ua, ud, as, cx, cy, hs, wlm, t0m1, thm, &
183  ths, fp0, thp0, dtdyn, fcut, &
184  aba, abd, uba, ubd, sxx, syy, sxy, usero, &
185  phs, ptp, plp, pdir, psi, pws, pwst, pnr, &
186  ptm1, pt1, pt2, pep, tauocx, tauocy, &
187  pthp0, pqp, psw, ppe, pgw, qp, &
188  tauox, tauoy, tauwix, &
189  tauwiy, phiaw, phioc, tusx, tusy, prms, tpms,&
190  ussx, ussy, mssx, mssy, mssd, mscx, mscy, &
191  mscd, charn, tws, taua, tauadir, &
192  tauwnx, tauwny, bhd, t02, hsig, cge, &
193  t01, bedforms, whitecap, taubbl, phibbl, &
194  cflthmax, cflxymax, cflkmax, tauice, phice, &
195  stmaxe, stmaxd, hmaxe, hcmaxe, hmaxd, hcmaxd,&
196  p2sms, ef, us3d, th1m, sth1m, th2m, sth2m, &
197  wn, ussp, wbt, wnmean, qkk, skew, embia1, embia2
198  USE w3odatmd, ONLY: ndso, ndse, screen, nogrp, ngrpp, idout, &
199  undef, flogrd, fnmpre, noswll, noge
200  !
201  USE w3nmlounfmd
202  !
203  USE w3ounfmetamd, ONLY: init_meta, teardown_meta, getmeta, &
204  write_meta, write_global_meta, &
205  write_freeform_meta_list, &
206  meta_t, ncvartype, crs_meta, crs_name, &
207  fl_default_gbl_meta, coords_attr
208  !
209  USE netcdf
210 
211 #ifdef W3_SMC
212  USE w3smcomd, smcnoval=>noval
213 #endif
214 
215  IMPLICIT NONE
216 
217  !/
218  !/ ------------------------------------------------------------------- /
219  !/ Local parameters
220  !/
221  TYPE(nml_field_t) :: nml_field
222  TYPE(nml_file_t) :: nml_file
223  TYPE(nml_smc_t) :: nml_smc
224  !
225  INTEGER :: ndsi, ndsm, ndsog, &
226  ndstrc, ntrace, ierr, i, i1f, i2f, &
227  iotest, nout, &
228  ifi, ifj, nctype, ix1, ixn, iy1, iyn, &
229  iout, s3, iret, &
230  nbipart, cntipart, ncvartypei, ipart, &
231  rtdnx, rtdny
232  INTEGER :: tout(2), tdum(2), tref(2), tepoch(2), &
233  stopdate(8), refdate(8)
234  !
235  INTEGER, ALLOCATABLE :: tabipart(:), ncids(:,:,:)
236  !
237 #ifdef W3_S
238  INTEGER, SAVE :: ient = 0
239 #endif
240  !
241  REAL :: dtreq, dtest
242  !
243  CHARACTER*30 :: strstopdate, fileprefix, stringipart
244  CHARACTER*1024 :: fldout
245  CHARACTER :: comstr*1, idtime*23, iddday*11, ttype*1
246  !
247  LOGICAL :: flg2d(nogrp,ngrpp), flg1d(nogrp), &
248  vector, together, flgnml, flgfc
249  LOGICAL :: mapstaout = .true.
250  LOGICAL :: smcgrd = .false.
251 #ifdef W3_RTD
252  LOGICAL :: rtdl = .false.
253 #endif
254 
255  INTEGER :: tvartype = nf90_double
256  CHARACTER(LEN=32) :: epoch_iso
257  CHARACTER(LEN=64) :: epoch
258  CHARACTER :: timeunit*1 ! 'D' = days, or 'S' for seconds
259  !
260  REAL :: noval ! Fill value for seapoints with no value
261  !/
262  !/ ------------------------------------------------------------------- /
263  !/
264  ! 1. IO set-up.
265  !
266  CALL w3nmod ( 1, 6, 6 )
267  CALL w3setg ( 1, 6, 6 )
268  CALL w3ndat ( 6, 6 )
269  CALL w3setw ( 1, 6, 6 )
270  CALL w3naux ( 6, 6 )
271  CALL w3seta ( 1, 6, 6 )
272  CALL w3nout ( 6, 6 )
273  CALL w3seto ( 1, 6, 6 )
274  !
275  ndsi = 10
276  ndsm = 20
277  ndsog = 20
278  !
279  ndstrc = 6
280  ntrace = 10
281  CALL itrace ( ndstrc, ntrace )
282  !
283 #ifdef W3_S
284  CALL strace (ient, 'W3OUNF')
285 #endif
286  !
287  WRITE (ndso,900)
288  !
289  ! Default epoch time:
290  tepoch(1) = 19900101
291  tepoch(2) = 0
292  !
293  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
294  ! 2. Read model definition file.
295  !
296  CALL w3iogr ( 'READ', ndsm )
297  WRITE (ndso,920) gname
298  !
299 #ifdef W3_RTD
300  ! Is the grid really rotated?
301  IF ( polat < 90. ) rtdl = .true.
302  !
303 #endif
304  !
305  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
306  ! 3. Read general data and first fields from file
307  !
308  CALL w3iogo ( 'READ', ndsog, iotest )
309  !
310  WRITE (ndso,930)
311  DO ifi=1, nogrp
312  DO ifj=1, ngrpp
313  IF ( flogrd(ifi,ifj) ) WRITE (ndso,931) idout(ifi,ifj)
314  END DO
315  END DO
316  !
317 #ifdef W3_SMC
318  IF( gtype .EQ. smctype ) THEN
319  smcgrd = .true.
320  WRITE (ndso, *) " Conversion for SMCTYPE:", gtype
321  ENDIF
322 #endif
323  !
324  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
325  ! 4. Read requests from input file.
326  !
327  ! process ww3_ounf namelist
328  !
329  INQUIRE(file=trim(fnmpre)//"ww3_ounf.nml", exist=flgnml)
330  IF (flgnml) THEN
331  ! Read namelist
332  CALL w3nmlounf (ndsi, trim(fnmpre)//'ww3_ounf.nml', nml_field, &
333  nml_file, nml_smc, ierr)
334 
335  ! 4.1 Time setup
336  READ(nml_field%TIMESTRIDE, *) dtreq
337  READ(nml_field%TIMECOUNT, *) nout
338  READ(nml_field%TIMESTART, *) tout(1), tout(2)
339  READ(nml_field%TIMEREF, *) tref(1), tref(2)
340  READ(nml_field%TIMEEPOCH, *) tepoch(1), tepoch(2)
341 
342  ! 4.2 Output fields
343  fldout = nml_field%LIST
344  CALL w3flgrdflag ( ndso, screen, ndse, fldout, flg1d, &
345  flg2d, 1, 1, ierr )
346  IF (ierr.NE.0) GOTO 800
347 
348  ! 4.3 Output type
349  nctype = nml_file%NETCDF
350  ncvartype = nml_field%TYPE
351  stringipart = nml_field%PARTITION
352  together = nml_field%SAMEFILE
353  vector = nml_field%VECTOR
354  fileprefix = nml_file%PREFIX
355  flgfc = nml_field%FCVARS
356  s3 = nml_field%TIMESPLIT
357  ttype = nml_field%TIMEVAR
358  timeunit = nml_field%TIMEUNIT
359  noval = nml_field%NOVAL
360  mapstaout = nml_field%MAPSTA
361  IF(smcgrd) THEN
362 #ifdef W3_SMC
363  smcotype = nml_smc%TYPE
364  sxo = nml_smc%SXO
365  syo = nml_smc%SYO
366  exo = nml_smc%EXO
367  eyo = nml_smc%EYO
368  celfac = nml_smc%CELFAC
369  smcnoval = noval
370 #endif
371  ELSE
372  ix1 = nml_file%IX0
373  ixn = nml_file%IXN
374  iy1 = nml_file%IY0
375  iyn = nml_file%IYN
376  ENDIF ! SMCGRD
377  END IF ! FLGNML
378  !
379  ! process old ww3_ounf.inp format
380  !
381  IF (.NOT. flgnml) THEN
382  OPEN (ndsi,file=trim(fnmpre)//'ww3_ounf.inp',status='OLD',err=800,iostat=ierr)
383  rewind(ndsi)
384 
385  READ (ndsi,'(A)',END=801,ERR=802,IOSTAT=IERR) comstr
386  IF (comstr.EQ.' ') comstr = '$'
387  WRITE (ndso,901) comstr
388  CALL nextln ( comstr , ndsi , ndse )
389 
390  ! 4.1 Time setup
391  READ (ndsi,*,END=801,ERR=802) TOUT, DTREQ, nout
392 
393  ! 4.1.1 Forecast period and forecast reference time
394  ! CALL NEXTLN ( COMSTR , NDSI , NDSE )
395  ! READ (NDSI,*,END=801,ERR=802) FLGFC
396  ! IF( FLGFC ) READ(NDSI,*,END=801,ERR=802) TREF
397  !
398  ! ChrisB: Forecast variables flag and reference time
399  ! only configurable via namelist input. Set forecast
400  ! reference time to first time here:
401  tref = tout
402 
403  ! 4.2 Output fields
404  CALL w3readflgrd ( ndsi, ndso, screen, ndse, comstr, flg1d, &
405  flg2d, 1, 1, ierr )
406  IF (ierr.NE.0) GOTO 800
407 
408  ! 4.3 Output type
409  CALL nextln ( comstr , ndsi , ndse )
410  READ (ndsi,*,END=801,ERR=802) NCTYPE, ncvartype
411  CALL nextln ( comstr , ndsi , ndse )
412  READ (ndsi,'(A)',END=801,ERR=802) stringipart
413  CALL nextln ( comstr , ndsi , ndse )
414  READ (ndsi,*,END=801,ERR=802) together
415 
416  ! The following are only configurable via the namelist input
417  ! and are hardcoded for .inp files:
418  ttype = "D"
419  timeunit = "D"
420  noval = undef
421  vector = .true.
422 
423  CALL nextln ( comstr , ndsi , ndse )
424  fileprefix= 'ww3.'
425  READ (ndsi,*,END=801,ERR=802) fileprefix
426  CALL nextln ( comstr , ndsi , ndse )
427  READ (ndsi,*,END=801,ERR=802) s3
428  CALL nextln ( comstr , ndsi , ndse )
429 
430  IF(smcgrd) THEN
431 #ifdef W3_SMC
432  ! SMC output type (1 or 2)
433  READ (ndsi,*,END=801,ERR=802) smcotype
434  IF(smcotype .EQ. 1) THEN ! Flat sea point output
435  CALL nextln ( comstr , ndsi , ndse )
436  READ (ndsi,*,END=801,ERR=802) SXO, SYO, EXO, eyo
437  ELSE IF(smcotype .EQ. 2) THEN ! Regular grid output
438  CALL nextln ( comstr , ndsi , ndse )
439  READ (ndsi,*,END=801,ERR=802) SXO, SYO, EXO, EYO, celfac
440  ENDIF
441  smcnoval = noval
442 #endif
443  ELSE
444  READ (ndsi,*,END=801,ERR=802) IX1, IXN, IY1, iyn
445  ENDIF
446 
447  CLOSE(ndsi,err=800,iostat=ierr)
448  END IF ! .NOT. FLGNML
449 
450  CALL str_to_upper(ttype)
451  CALL str_to_upper(timeunit)
452 
453  IF(timeunit /= 'S' .AND. timeunit /= 'D') THEN
454  WRITE(ndse, 1013) timeunit
455  CALL extcde(14)
456  ENDIF
457 
458  SELECT CASE(ttype)
459  CASE('D')
460  tvartype = nf90_double
461  CASE('I')
462  tvartype = nf90_int64
463  CASE DEFAULT
464  WRITE(ndse, 1014) ttype
465  CALL extcde(14)
466  END SELECT
467 
468  IF(ttype .EQ. 'I' .AND. timeunit .EQ. 'D') THEN
469  WRITE(ndse, 1015)
470  CALL extcde(14)
471  ENDIF
472 
473  ! If TVARTPE is INT64 check that we are using netCDF4:
474  IF(tvartype .EQ. nf90_int64 .AND. nctype .LT. 4) THEN
475  WRITE(ndse, 1016)
476  CALL extcde(14)
477  ENDIF
478 
479  ! Keep track of original NCVARTYPE, as it may change
480  ncvartypei = ncvartype
481 
482  ! Get forecast reference time from TREF
483  CALL t2d(tref, refdate, ierr)
484  !
485 
486  ! 4.1 Time setup
487  dtreq = max( 0. , dtreq )
488  IF ( dtreq.EQ.0. ) nout = 1
489  nout = max( 1 , nout )
490  CALL stme21 ( tout , idtime )
491  WRITE (ndso,940) idtime
492  tdum = 0
493  CALL tick21 ( tdum , dtreq )
494  CALL stme21 ( tdum , idtime )
495  IF ( dtreq .GE. 86400. ) THEN
496  WRITE (iddday,'(I10,1X)') int(dtreq/86400.)
497  ELSE
498  iddday = ' '
499  END IF
500  idtime(1:11) = iddday
501  idtime(21:23) = ' '
502  WRITE (ndso,941) idtime, nout
503 
504  IF(flgfc) THEN
505  CALL stme21 ( tref , idtime )
506  WRITE(ndso,942) idtime
507  ENDIF
508 
509  ! 4.2 Output fields
510  DO ifi=1, nogrp
511  DO ifj=1, ngrpp
512  IF ( flg2d(ifi,ifj) ) THEN
513  IF ( flogrd(ifi,ifj) ) THEN
514  WRITE (ndso,946) idout(ifi,ifj), ' '
515  ELSE
516  WRITE (ndso,946) idout(ifi,ifj), '*** NOT AVAILABLE ***'
517  flg2d(ifi,ifj) = .false.
518  END IF
519  END IF
520  END DO
521  END DO
522 
523 
524  ! 4.3 Output type
525  ALLOCATE(tabipart(noswll + 1))
526  ALLOCATE(ncids(nogrp,ngrpp,noswll + 1))
527  nbipart=0
528  DO i=1,30
529  IF(stringipart(i:i) .EQ. ' ') cycle
530  READ(stringipart(i:i),'(I1)') ipart
531  IF(ipart .GT. noswll) THEN
532  WRITE(ndso, 1500) ipart, noswll
533  cycle
534  ENDIF
535  nbipart = nbipart + 1
536  IF(nbipart .GT. noswll + 1) THEN
537  GOTO 803
538  ENDIF
539  tabipart(nbipart) = ipart
540  ENDDO
541  !
542  IF ( nctype.LT.3 .OR. nctype.GT.4 ) THEN
543  WRITE (ndse,1010) nctype
544  CALL extcde ( 1 )
545  END IF
546 
547  IF(smcgrd) THEN
548 #ifdef W3_SMC
549  WRITE(ndso, 4100)
550  IF(smcotype .EQ. 1) THEN ! Flat sea point output
551  ALLOCATE(smcmask(nsea))
552  ALLOCATE(smcidx(nsea))
553  smcmask(:) = .false.
554  CALL smc_interp()
555  smcnout = count(smcmask)
556  nxo = smcnout
557  nyo = 1
558  WRITE(ndso, 4120) smcnout
559  ELSE IF(smcotype .EQ. 2) THEN ! Regular grid output
560  ! Calculate regridding weights:
561  ALLOCATE(xidx(nsea), yidx(nsea), xspan(nsea), &
562  yspan(nsea), wts(nsea), smcidx(nsea))
563  CALL smc_interp()
564  WRITE(ndso, 4110) nxo, nyo, sxo, syo, dxo, dyo
565 
566  ! Allocate space for coverage array and new MAPSTA array
567  ALLOCATE(cov(nxo,nyo), mapsmc(nxo,nyo))
568  ELSE IF(smcotype .EQ. 3 .OR. smcotype .EQ. 4) THEN ! Nearest neighbour interpolation
569  CALL read_smcint()
570  ENDIF
571 
572  ! CB: IXN and IXY are calculated by SMC_INTERP for SMC GRID
573  ix1 = 1
574  ixn = nxo
575  iy1 = 1
576  iyn = nyo
577 
578  ! Also store NXO and NYO in __local__ RTDNX and RTDNY variables.
579  ! This avoids compilation errors when the RTD switch is enabled
580  ! but the SMC switch is not. TODO: Remove this when C-preprocessor
581  ! is used in preference to switches.
582  rtdnx = nxo
583  rtdny = nyo
584 
585 #ifdef W3_RTD
586  ! SMC type 3/4 outputs are currently on standard pole grid only
587  IF(smcotype .EQ. 3 .OR. smcotype .EQ. 4) rtdl = .false.
588 #endif
589 #endif
590  ELSE
591  ix1 = max( ix1 , 1 )
592  ixn = min( ixn , nx )
593  iy1 = max( iy1 , 1 )
594  iyn = min( iyn , ny )
595  WRITE (ndso,3940) ix1, ixn, iy1, iyn
596  ENDIF ! SMCGRD
597  !
598  ! 4.4 Initialise meta-data
599  CALL init_meta(vector)
600  !
601  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
602  ! 5. Time management.
603  !
604  iout = 0
605  ncids(:,:,:) = 0
606  WRITE (ndso,970)
607 
608  ! 5.1 Loops on out_grd.ww3 to read the time and data
609  DO
610  dtest = dsec21( time , tout )
611  IF ( dtest .GT. 0. ) THEN
612  CALL w3iogo ( 'READ', ndsog, iotest )
613  IF ( iotest .EQ. -1 ) THEN
614  WRITE (ndso,944)
615  EXIT
616  END IF
617  cycle
618  END IF
619  IF ( dtest .LT. 0. ) THEN
620  CALL tick21 ( tout , dtreq )
621  cycle
622  END IF
623 
624 
625  ! 5.1.1 Increments the time counter IOUT
626  iout = iout + 1
627  CALL stme21 ( tout , idtime )
628  WRITE (ndso,971) idtime
629 
630 
631  ! 5.1.2 Processes the variable value for the time step IOUT
632  CALL w3exnc ( nx, ny, ix1, ixn, iy1, iyn, nsea, fileprefix, &
633  e3df, p2msf, us3df, usspf, nctype, together, ncvartypei,&
634  flg2d, ncids, s3, strstopdate )
635 
636  ! 5.1.3 Defines the stop date
637  CALL t2d(tout,stopdate,ierr)
638  WRITE(strstopdate,'(I4.4,A,4(I2.2,A),I2.2)') stopdate(1),'-',stopdate(2), &
639  '-',stopdate(3),' ',stopdate(5),':',stopdate(6),':',stopdate(7)
640 
641  CALL tick21 ( tout , dtreq )
642  IF ( iout .GE. nout ) EXIT
643  END DO
644 
645  CALL teardown_meta()
646 
647 
648  ! 5.2 Closes the netCDF file
649  IF (together .AND. ncids(1,1,1).NE.0) THEN
650  iret = nf90_redef(ncids(1,1,1))
651  CALL check_err(iret)
652  IF(fl_default_gbl_meta) THEN
653  iret=nf90_put_att(ncids(1,1,1),nf90_global,'stop_date',strstopdate)
654  CALL check_err(iret)
655  ENDIF
656  iret=nf90_close(ncids(1,1,1))
657  CALL check_err(iret)
658  END IF
659  !
660  DO ifi=1, nogrp
661  DO ifj=1, ngrpp
662  IF ( flg2d(ifi,ifj) ) THEN
663  IF ( flogrd(ifi,ifj) ) THEN
664  IF (.NOT. together) THEN
665  IF (ncids(ifi,ifj,1).NE.0) THEN
666  iret = nf90_redef(ncids(ifi,ifj,1))
667  CALL check_err(iret)
668  IF(fl_default_gbl_meta) THEN
669  iret=nf90_put_att(ncids(ifi,ifj,1),nf90_global,'stop_date',strstopdate)
670  CALL check_err(iret)
671  ENDIF
672  iret=nf90_close(ncids(ifi,ifj,1))
673  CALL check_err(iret)
674  END IF ! NCIDS
675  ! close partition files (except part 0 which is already closed by (IFI,IFJ,1)
676  IF ((ifi.EQ.4).AND.(ifj.LE.noge(ifi))) THEN
677  DO ipart=1,noswll
678  IF (ncids(ifi,ifj,ipart+1).NE.0) THEN
679  iret = nf90_redef(ncids(ifi,ifj,ipart+1))
680  CALL check_err(iret)
681  IF(fl_default_gbl_meta) THEN
682  iret=nf90_put_att(ncids(ifi,ifj,ipart+1),nf90_global,'stop_date',strstopdate)
683  CALL check_err(iret)
684  ENDIF
685  iret=nf90_close(ncids(ifi,ifj,ipart+1))
686  CALL check_err(iret)
687  END IF ! NCIDS
688  END DO ! IPART
689  END IF ! partition
690  ! else if together
691  ELSE
692  ! close frequency file
693  IF ( ((ifi.EQ.6).AND.(ifj.EQ.8)) .OR. &
694  ((ifi.EQ.6).AND.(ifj.EQ.9)) .OR. &
695  (ifi.EQ.3) ) THEN
696  IF (ncids(ifi,ifj,1).NE.0) THEN
697  iret = nf90_redef(ncids(ifi,ifj,1))
698  CALL check_err(iret)
699  IF(fl_default_gbl_meta) THEN
700  iret=nf90_put_att(ncids(ifi,ifj,1),nf90_global,'stop_date',strstopdate)
701  CALL check_err(iret)
702  ENDIF
703  iret=nf90_close(ncids(ifi,ifj,1))
704  CALL check_err(iret)
705  END IF ! NCIDS
706  END IF ! IFI
707  END IF ! TOGETHER
708  END IF ! FLOGRD
709  END IF ! FLG2D
710  END DO ! IFJ
711  END DO ! IFI
712 
713  !
714  GOTO 888
715  !
716  ! Escape locations read errors :
717  !
718 800 CONTINUE
719  WRITE (ndse,1000) ierr
720  CALL extcde ( 10 )
721  !
722 801 CONTINUE
723  WRITE (ndse,1001)
724  CALL extcde ( 11 )
725  !
726 802 CONTINUE
727  WRITE (ndse,1002) ierr
728  CALL extcde ( 12 )
729  !
730 803 CONTINUE
731  WRITE (ndse,1003) nbipart, noswll
732  CALL extcde (13)
733  !
734 888 CONTINUE
735  WRITE (ndso,999)
736  !
737  ! Formats
738  !
739 900 FORMAT (/15x,' *** WAVEWATCH III Field output postp. *** '/ &
740  15x,'==============================================='/)
741 901 FORMAT ( ' Comment character is ''',a,''''/)
742  !
743 920 FORMAT ( ' Grid name : ',a/)
744  !
745 930 FORMAT ( ' Fields in file : '/ &
746  ' --------------------------')
747 931 FORMAT ( ' ',a)
748  !
749 940 FORMAT (/' Output time data : '/ &
750  ' --------------------------------------------------'/ &
751  ' First time : ',a)
752 941 FORMAT ( ' Interval : ',a/ &
753  ' Number of requests : ',i10)
754 942 FORMAT ( ' Reference time : ',a)
755 944 FORMAT (/' End of file reached '/)
756 946 FORMAT ( ' ',a,2x,a)
757  !
758 3940 FORMAT ( ' X range : ',2i7/ &
759  ' Y range : ',2i7)
760  !
761 #ifdef W3_SMC
762 4100 FORMAT (//' SMC grid output :' / &
763  ' --------------------------------------------------')
764 4110 FORMAT ( ' SMC to regular lat/lon grid using cell averaging' /&
765  ' Aligned output grid definition: ' / &
766  ' NX, NY : ', 2i8 / &
767  ' X0, Y0 : ', 2f8.3 / &
768  ' DX, DY : ', 2f8.5 )
769 4120 FORMAT ( ' Flat seapoint dimensioned SMC output file' / &
770  ' Num seapoints : ',i9 )
771  !
772 4130 FORMAT ( ' SMC regridding to regular lat/lon grid.' / &
773  ' Output grid definition: ' / &
774  ' NX, NY : ', 2i8 / &
775  ' X0, Y0 : ', 2f8.3 / &
776  ' DX, DY : ', 2f8.5 / &
777  ' Interpolate ? : ', l )
778 #endif
779  !
780 970 FORMAT (/' Generating files '/ &
781  ' --------------------------------------------------')
782 971 FORMAT ( ' Files for ',a)
783  !
784 999 FORMAT (/' End of program '/ &
785  ' ========================================='/ &
786  ' WAVEWATCH III Field output '/)
787  !
788  ! Error format strings
789  !
790 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
791  ' ERROR IN OPENING INPUT FILE'/ &
792  ' IOSTAT =',i5/)
793  !
794 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
795  ' PREMATURE END OF INPUT FILE'/)
796  !
797 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
798  ' ERROR IN READING FROM INPUT FILE'/ &
799  ' IOSTAT =',i5/)
800  !
801 1003 FORMAT (/' *** WAVEWATCH III WERROR IN W3OUNF : '/ &
802  ' OUT OF RANGE REQUEST FOR NBIPART =',i2, / &
803  ' MAX SWELL PARTITIONS (NOSW) =',i2 /)
804  !
805 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
806  ' ILLEGAL TYPE, NCTYPE =',i4/)
807  !
808 1013 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
809  ' TIMEUNITS MUST BE ONE OF "S" OR "D"' / &
810  ' GOT: ',a /)
811  !
812 1014 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
813  ' TIMEVAR TYPE MUST BE ONE OF "I" OR "D"' / &
814  ' GOT: ',a /)
815  !
816 1015 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
817  ' CANNONT HAVE TIME UNITS OF DAYS WITH'/ &
818  ' TIME VARYTPE OF INT64' /)
819  !
820 1016 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNF : '/ &
821  ' INT64 TIME ENCODING REQUIRES NETCDF4' / &
822  ' FILE FORMAT' /)
823  !
824  ! Warning format strings
825  !
826 1500 FORMAT (/' *** WAVEWATCH III WARNING IN W3OUNF : '/ &
827  ' IGNORING REQUEST FOR IPART =',i2, / &
828  ' MAX SWELL PARTITIONS (NOSW) =',i2 /)
829  !
830  !/
831  !/ Internal subroutine W3EXNC ---------------------------------------- /
832  !/
833 CONTAINS
834  !/ ------------------------------------------------------------------- /
860  SUBROUTINE w3exnc ( NX, NY, IX1, IXN, IY1, IYN, NSEA, &
861  FILEPREFIX, E3DF, P2MSF, US3DF, USSPF,NCTYPE, &
862  TOGETHER, NCVARTYPEI, FLG2D, NCIDS, S3, STRSTOPDATE )
863  !/
864  !/ +-----------------------------------+
865  !/ | F. Ardhuin |
866  !/ | M. Accensi |
867  !/ | FORTRAN 90 |
868  !/ | Last update : 22-Mar-2021 |
869  !/ +-----------------------------------+
870  !/
871  !/ 17-Mar-2010 : Creation ( version 3.14_SHOM )
872  !/ 28-Feb-2013 : New option for float output ( version 4.08 )
873  !/ 02-Apr-2013 : New structure of output fields. ( version 4.09 )
874  !/ 12-Apr-2013 : Allows curvilinear grids ( version 4.10 )
875  !/ 30-Apr-2014 : Correct group3 freq dim. ( version 5.00 )
876  !/ 23-May-2014 : Adding ice fluxes to W3SRCE ( version 5.01 )
877  !/ 14-Oct-2014 : Keep the output files opened ( version 5.01 )
878  !/ 03-Nov-2020 : NetCDF metadata moved to separate ( version 7.12 )
879  !/ module.
880  !/ 09-Dec-2020 : Set fixed values for VARID indices ( version 7.12 )
881  !/ 26-Jan-2021 : Added TP output (derived from fp) ( version 7.12 )
882  !/ and alternative dir/mag output.
883  !/ 02-Feb-2021 : Make default global meta optional ( version 7.12 )
884  !/ 22-Mar-2021 : New coupling fields output ( version 7.13 )
885  !/
886  ! 1. Purpose :
887  !
888  ! Perform actual grid output in NetCDF file.
889  !
890  ! 3. Parameters :
891  !
892  ! Parameter list
893  ! ----------------------------------------------------------------
894  ! NX/Y Int. I Grid dimensions.
895  ! IX1/IXN Int. I Grid indexes along X
896  ! IY1/IYN Int. I Grid indexes along Y
897  ! NSEA Int. I Number of sea points.
898  ! ----------------------------------------------------------------
899  !
900  ! Internal parameters
901  ! ----------------------------------------------------------------
902  ! FLTWO Log. Flags for two-dimensional field X Y.
903  ! FLDIR Log. Flags for two-dimensional, directional field.
904  ! FLFRQ Log. Flags for frequency array (3D field)
905  ! X1, X2, XX, XY
906  ! R.A. Output fields
907  ! ----------------------------------------------------------------
908  !
909  ! 4. Subroutines used :
910  !
911  ! Name Type Module Description
912  ! ----------------------------------------------------------------
913  ! STRACE Subr. W3SERVMD Subroutine tracing.
914  ! EXTCDE Subr. Id. Abort program as graceful as possible.
915  ! W3S2XY Subr. Id. Convert from storage to spatial grid.
916  ! PRTBLK Subr. W3ARRYMD Print plot of array.
917  ! OUTA2I Subr. Id. Print array of INTEGERS.
918  ! ----------------------------------------------------------------
919  !
920  ! 5. Called by :
921  !
922  ! Main program in which it is contained.
923  !
924  ! 6. Error messages :
925  !
926  ! None.
927  !
928  ! 7. Remarks :
929  !
930  ! - Note that arrays CX and CY of the main program now contain
931  ! the absolute current speed and direction respectively.
932  !
933  ! 8. Structure :
934  !
935  ! See source code.
936  !
937  ! 9. Switches :
938  !
939  ! !/S Enable subroutine tracing.
940  ! !/T Enable test output.
941  !
942  ! 10. Source code :
943  !
944  !/ ------------------------------------------------------------------- /
945  USE w3servmd, ONLY : w3s2xy, uv_to_mag_dir
946 #ifdef W3_RTD
947  USE w3servmd, ONLY : w3thrtn, w3xyrtn, w3eqtoll
948 #endif
949  USE w3arrymd, ONLY : outa2i, prtblk
950  USE w3gdatmd, ONLY : sig, gtype, flagll, mapsta, mapst2
951  USE w3gdatmd, ONLY : nk, ungtype, mapsf, ntri, clgtype, rlgtype, &
952  xgrd, ygrd, sx, sy, x0, y0, trigp, ussp_wn
953 #ifdef W3_RTD
954  ! Rotated pole data from the mod_def file
955  USE w3gdatmd, ONLY : polat, polon, flagunr, angld
956 #endif
957 #ifdef W3_T
958  USE w3odatmd, ONLY : ndst
959 #endif
960  USE netcdf
961  IMPLICIT NONE
962 
963  !/
964  !/ ------------------------------------------------------------------- /
965  !/ Parameter list
966  !/
967  INTEGER, INTENT(IN) :: NX, NY, IX1, IXN, IY1, IYN, NSEA, &
968  E3DF(3,5), P2MSF(3), US3DF(3), &
969  USSPF(2), NCTYPE, NCVARTYPEI
970  CHARACTER(30) :: FILEPREFIX
971  LOGICAL, INTENT(IN) :: TOGETHER
972  LOGICAL, INTENT(IN) :: FLG2D(NOGRP,NGRPP)
973  INTEGER, INTENT(INOUT) :: NCIDS(NOGRP,NGRPP,NOSWLL + 1), S3
974  CHARACTER*30,INTENT(IN) :: STRSTOPDATE
975  !/
976  !/ ------------------------------------------------------------------- /
977  !/ Local parameters
978  !/
979  INTEGER :: IFI, IFJ, MFILL, I, J, ISEA, IX, IY, &
980  I1, J1, IPART, INDEXIPART, COORDTYPE
981  INTEGER :: S1, S2, S4, S5, NCID, OLDNCID, NDSDAT,&
982  NFIELD, N, IRET, IK, EXTRADIM, IVAR, &
983  IVAR1
984  INTEGER :: DIMID(6), VARID(300), START(4), &
985  COUNT(4), DIMLN(6),START1D(2), &
986  COUNT1D(2), DIMFIELD(3), &
987  STARTDATE(8), CURDATE(8), &
988  EPOCHDATE(8), &
989  MAP(NX+1,NY), MP2(NX+1,NY)
990  !
991  INTEGER :: DEFLATE=1
992 #ifdef W3_S
993  INTEGER, SAVE :: IENT = 0
994 #endif
995  !
996  ! Make the below allocatable to avoid stack overflow on some machines
997  INTEGER(KIND=2), ALLOCATABLE :: MX1(:,:), MXX(:,:), MYY(:,:), &
998  MXY(:,:), MAPOUT(:,:)
999  !
1000  REAL :: CABS, UABS, MFILLR
1001 #ifdef W3_BT4
1002  REAL, PARAMETER :: LOG2=log(2.)
1003 #endif
1004  !
1005  REAL,DIMENSION(:), ALLOCATABLE :: LON, LAT, FREQ
1006  REAL,DIMENSION(:,:), ALLOCATABLE :: LON2D, LAT2D, ANGLD2D
1007 #ifdef W3_RTD
1008  REAL,DIMENSION(:,:), ALLOCATABLE :: LON2DEQ, LAT2DEQ
1009 #endif
1010  ! Make the below allocatable to avoid stack overflow on some machines
1011  REAL, ALLOCATABLE :: X1(:,:), X2(:,:), XX(:,:), XY(:,:), &
1012  XK(:,:,:), XXK(:,:,:), XYK(:,:,:), &
1013  MX1R(:,:), MXXR(:,:), MYYR(:,:), &
1014  MXYR(:,:), AUX1(:)
1015  !
1016  DOUBLE PRECISION :: OUTJULDAY
1017  INTEGER(KIND=8) :: OUTSECS
1018  DOUBLE PRECISION :: SXD, SYD, X0D, Y0D
1019  !
1020  CHARACTER*120 :: STR2
1021  CHARACTER*512 :: PARTCOM
1022  !CHARACTER*30 :: UNITVAR(3),FORMAT1
1023  CHARACTER*30 :: FORMAT1
1024  CHARACTER*30 :: STRSTARTDATE
1025  CHARACTER :: FNAMENC*128, &
1026  FORMF*11
1027  CHARACTER, SAVE :: OLDTIMEID*16 = '0000000000000000'
1028  CHARACTER, SAVE :: TIMEID*16 = '0000000000000000'
1029  !
1030  LOGICAL :: FLFRQ, FLDIR, FEXIST, FREMOVE
1031  LOGICAL :: CUSTOMFRQ=.false.
1032 #ifdef W3_T
1033  LOGICAL :: LTEMP(NGRPP)
1034 #endif
1035 
1036  TYPE(meta_t) :: META(3)
1037  !TYPE(META_T) :: META
1038  !/
1039  !/ ------------------------------------------------------------------- /
1040  !/
1041  !
1042 #ifdef W3_S
1043  CALL strace (ient, 'W3EXNC')
1044 #endif
1045  !
1046 #ifdef W3_T
1047  DO ifi=1, nogrp
1048  ltemp = flg2d(ifi,:)
1049  WRITE (ndst,9000) ifi, ltemp
1050  END DO
1051  WRITE (ndst,9001) nctype, ix1, ixn, iy1, iyn, vector
1052 #endif
1053  !
1054  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1055  ! 1. Preparations
1056  !
1057  ! Allocate output storage. This is required with the introduction
1058  ! of the SMC grid output as the regridded output grid dimensions could
1059  ! conceivably be larger than the NX and NY values. Making these (large)
1060  ! arrays allocatable also moves them to the heap and avoids stack
1061  ! overflow issues that can occur on some architectures. (Chris Bunney)
1062  IF(smcgrd) THEN
1063 #ifdef W3_SMC
1064  ALLOCATE(x1(nxo,nyo), x2(nxo,nyo), xx(nxo,nyo), xy(nxo,nyo))
1065  ALLOCATE(xk(nxo,nyo,nk), xxk(nxo,nyo,nk), xyk(nxo,nyo,nk))
1066 
1067  ALLOCATE(mx1(nxo,nyo), mxx(nxo,nyo), myy(nxo,nyo), &
1068  mxy(nxo,nyo), mapout(nxo,nyo))
1069  ALLOCATE(mx1r(nxo,nyo), mxxr(nxo,nyo), myyr(nxo,nyo), mxyr(nxo,nyo))
1070 #endif
1071  ELSE
1072  ALLOCATE(x1(nx+1,ny),x2(nx+1,ny),xx(nx+1,ny),xy(nx+1,ny))
1073  ALLOCATE(xk(nx+1,ny,nk), xxk(nx+1,ny,nk), xyk(nx+1,ny,nk))
1074  ALLOCATE(mx1(nx,ny), mxx(nx,ny), myy(nx,ny), mxy(nx,ny), mapout(nx,ny))
1075  ALLOCATE(mx1r(nx,ny), mxxr(nx,ny), myyr(nx,ny), mxyr(nx,ny))
1076  ENDIF ! SMCGRD
1077  ALLOCATE(aux1(nsea))
1078 
1079  x1 = undef
1080  x2 = undef
1081  xx = undef
1082  xy = undef
1083  ! CB: Dont output MAPSTA for SMC grid - it does not make sense
1084  IF( smcgrd .AND. mapstaout) THEN
1085  WRITE(ndso,*) "MAPSTA output disabled for SMC grids"
1086  mapstaout = .false.
1087  ENDIF
1088  ncvartype = ncvartypei
1089  ndsdat=30
1090  ncid = 0
1091  !
1092  !
1093  !CHRISB: Allow alternative time units:
1094  CALL t2iso(tepoch, epoch_iso)
1095  SELECT CASE(timeunit)
1096  CASE('D')
1097  epoch = 'days since ' // epoch_iso
1098  CASE('S')
1099  epoch = 'seconds since ' // epoch_iso
1100  CASE DEFAULT
1101  print*,'Unknown time units: ', timeunit
1102  CALL extcde(10)
1103  END SELECT
1104 
1105  CALL u2d(epoch, epochdate, ierr)
1106 
1107  ! 1.1 Set-up transfer files
1108  mfill = nf90_fill_short
1109  mfillr = nf90_fill_float
1110  IF (gtype.NE.ungtype) THEN
1111  coordtype=1
1112  ELSE
1113  coordtype=2
1114  ENDIF
1115 
1116  ! 1.2 Sets the date as ISO8601 convention
1117  ! S3 defines the number of characters in the date for the filename
1118  ! S3=0 -> field, S3=4-> YYYY, S3=6 -> YYYYMM, S3=10 -> YYYYMMDDHH
1119  ! Setups min and max date format
1120  IF (s3.GT.0 .AND. s3.LT.4) s3=4
1121  IF (s3.GT.10) s3=10
1122  !
1123  ! Defines the format of FILETIME
1124  s5=s3-8
1125  s4=s3
1126  oldtimeid=timeid
1127  ! if S3=>nodate then filetime='field'
1128  IF (s3.EQ.0) THEN
1129  s4=5
1130  timeid="field"
1131  ! if S3=>YYYYMMDDHH then filetime='YYYYMMDDTHHZ'
1132  ELSE IF (s3.EQ.10) THEN
1133  s4=s4+2 ! add chars for ISO8601 : day T hours Z
1134  WRITE(format1,'(A,I1,A,I1,A)') '(I8.8,A1,I',s5,'.',s5,',A1)'
1135  WRITE (timeid,format1) time(1), 'T', &
1136  floor(real(time(2))/nint(10.**(6-s5))), 'Z'
1137  ! if S3=>YYYYMMDD then filetime='YYYYMMDD'
1138  ELSE IF (s3.EQ.8) THEN
1139  WRITE(format1,'(A,I1,A,I1,A)') '(I',s3,'.',s3,')'
1140  WRITE (timeid,format1) time(1)
1141  ! if S3=>YYYYMM then filetime='YYYYMM'
1142  ! or S3=>YYYY then filetime='YYYY'
1143  ELSE
1144  WRITE(format1,'(A,I1,A,I1,A)') '(I',s3,'.',s3,')'
1145  WRITE (timeid,format1) floor(real(time(1))/nint(10.**(8-s3)))
1146  END IF
1147  ! redefines filename with updated date format
1148  s1=len_trim(fileprefix)
1149  fnamenc=''
1150  fnamenc(1:s1)=fileprefix(1:s1)
1151  fnamenc(s1+1:s1+s4) = timeid(1:s4)
1152 
1153  !
1154 #ifdef W3_SMC
1155  !
1156  !--- Update MAPSMC for SMC type 2 output. This needs to be
1157  ! done at each timestep as MAPSTA could change if there
1158  ! are water level or ice input chagnes.
1159  !
1160  IF( smcgrd .AND. (smcotype .EQ. 2) ) CALL mapsta_smc()
1161 #endif
1162  !
1163  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1164  ! 2. Loop over output fields.
1165  !
1166 
1167  ! Instanciates the field and group indexes
1168  i1=0
1169  j1=0
1170  !
1171  DO ifi=1, nogrp
1172  DO ifj=1, ngrpp
1173  ! If the flag for the variable IFI of the group IFJ is .TRUE.
1174  IF ( flg2d(ifi,ifj) ) THEN
1175  ! Instanciates the partition array
1176  indexipart=1
1177  ipart=tabipart(indexipart)
1178  nfield=1 ! Default is one field
1179 
1180 
1181  ! Loop over IPART for partition variables
1182 555 CONTINUE
1183 
1184  ! Initializes the index of field and group at the first flag FLG2D at .TRUE.
1185  IF (i1.EQ.0) i1=ifi
1186  IF (j1.EQ.0) j1=ifj
1187  formf = '(1X,32I5)'
1188 #ifdef W3_T
1189  WRITE (ndst,9020) idout(ifi,ifj)
1190 #endif
1191  !
1192  ! 2.1 Set output arrays and parameters
1193  !
1194  ! Initializes the flags for freq and direction dimensions
1195  flfrq = .false.
1196  fldir = .false.
1197  IF (ncvartypei.EQ.3) ncvartype=2
1198  !
1199  ! Depth
1200  IF ( ifi .EQ. 1 .AND. ifj .EQ. 1 ) THEN
1201  CALL s2grid(dw(1:nsea), x1)
1202 
1203  ! Surface current
1204  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 2 ) THEN
1205  !! Note - CX and CY read in from .ww3 file are X-Y vectors
1206 #ifdef W3_RTD
1207  ! Rotate x,y vector back to standard pole
1208  IF ( flagunr ) CALL w3xyrtn(nsea, cx(1:nsea), cy(1:nsea), angld)
1209 #endif
1210  !
1211  IF( .NOT. vector ) THEN
1212  CALL uv_to_mag_dir(cx(1:nsea), cy(1:nsea), nsea, &
1213  tolerance=0.05, conv='O')
1214  ENDIF
1215  !
1216  CALL s2grid(cx(1:nsea), xx)
1217  CALL s2grid(cy(1:nsea), xy)
1218  nfield=2
1219  !
1220  ! Wind
1221  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 3 ) THEN
1222  !! Note - UA and UD read in from .ww3 file are UX,UY
1223 #ifdef W3_RTD
1224  ! Rotate x,y vector back to standard pole
1225  IF ( flagunr ) CALL w3xyrtn(nsea, ua(1:nsea), ud(1:nsea), angld)
1226 #endif
1227  !
1228  IF( .NOT. vector ) THEN
1229  CALL uv_to_mag_dir(ua(1:nsea), ud(1:nsea), nsea, &
1230  tolerance=1.0, conv='N')
1231  ENDIF
1232  !
1233  CALL s2grid(ua(1:nsea), xx)
1234  CALL s2grid(ud(1:nsea), xy)
1235  nfield=2
1236  !
1237  ! Air-sea temperature difference
1238  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 4 ) THEN
1239  CALL s2grid(as(1:nsea), x1)
1240  !
1241  ! Sea surface height above sea level
1242  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 5 ) THEN
1243  CALL s2grid(wlv, x1)
1244  !
1245  ! Sea ice area fraction
1246  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 6 ) THEN
1247  CALL s2grid(ice(1:nsea), x1)
1248 
1249  ! Icebergs_damping
1250  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 7 ) THEN
1251  CALL s2grid(berg, x1)
1252  WHERE ( x1.NE.undef) x1 = x1*0.1
1253  !
1254  ! Atmospheric momentum
1255  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 8 ) THEN
1256  !! Note - TAUA and TAUADIR read in from .ww3 file are TAUAX,TAUAY
1257 #ifdef W3_RTD
1258  ! Rotate x,y vector back to standard pole
1259  IF ( flagunr ) CALL w3xyrtn(nsea, taua(1:nsea), tauadir(1:nsea), angld)
1260 #endif
1261 
1262  IF( smcgrd ) THEN
1263 #ifdef W3_SMC
1264  CALL w3s2xy_smc( taua(1:nsea), xx )
1265  CALL w3s2xy_smc( tauadir(1:nsea), xy )
1266 #endif
1267  ELSE ! IF(SMCGRD)
1268  CALL w3s2xy ( nsea, nsea, nx+1, ny, taua(1:nsea) &
1269  , mapsf, xx )
1270  CALL w3s2xy ( nsea, nsea, nx+1, ny, tauadir(1:nsea) &
1271  , mapsf, xy )
1272  ENDIF
1273  nfield=2
1274  !
1275  ! Air density
1276  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 9 ) THEN
1277  IF( smcgrd ) THEN
1278 #ifdef W3_SMC
1279  CALL w3s2xy_smc(rhoair, x1)
1280 #endif
1281  ELSE
1282  CALL w3s2xy ( nsea, nsea, nx+1, ny, rhoair, mapsf, x1 )
1283  ENDIF
1284  !
1285 #ifdef W3_BT4
1286  ! Krumbein phi scale
1287  ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 10 ) THEN
1288  CALL s2grid(sed_d50, x1)
1289  WHERE ( x1.NE.undef) x1 = -log(x1/0.001)/log2
1290  nfield=1
1291 #endif
1292  !
1293 #ifdef W3_IS2
1294  ! Ice thickness
1295  ELSE IF (ifi .EQ. 1 .AND. ifj .EQ. 11 ) THEN
1296  CALL s2grid(iceh(1:nsea), x1)
1297  nfield=1
1298 #endif
1299  !
1300 #ifdef W3_IS2
1301  ! Maximum ice floe diameter
1302  ELSE IF (ifi .EQ. 1 .AND. ifj .EQ. 12 ) THEN
1303  CALL s2grid(icef(1:nsea), x1)
1304  nfield=1
1305 #endif
1306 
1307  ! Significant wave height
1308  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 1 ) THEN
1309  IF (ncvartypei.EQ.3) ncvartype=2
1310  CALL s2grid(hs, x1)
1311 
1312  ! Mean wave length
1313  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 2 ) THEN
1314  CALL s2grid(wlm, x1)
1315  !
1316  ! Mean period T02
1317  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 3 ) THEN
1318  CALL s2grid(t02, x1)
1319  !
1320  ! Mean period T0m1
1321  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 4 ) THEN
1322  CALL s2grid(t0m1, x1)
1323  !
1324  ! Mean period T01
1325  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 5 ) THEN
1326  CALL s2grid(t01, x1)
1327  !
1328  ! Wave peak frequency
1329  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 6 ) THEN
1330  CALL s2grid(fp0, x1)
1331  !
1332  ! Wave mean direction
1333  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 7 ) THEN
1334 #ifdef W3_RTD
1335  ! Rotate direction back to standard pole
1336  IF ( flagunr ) CALL w3thrtn(nsea, thm, angld, .false.)
1337 #endif
1338 
1339  CALL s2grid(thm, x1, .true.)
1340  !
1341  ! Directional spread
1342  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 8 ) THEN
1343  CALL s2grid(ths, x1)
1344  !
1345  ! Peak direction
1346  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 9 ) THEN
1347 #ifdef W3_RTD
1348  ! Rotate direction back to standard pole
1349  IF ( flagunr ) CALL w3thrtn(nsea, thp0, angld, .false.)
1350 #endif
1351  CALL s2grid(thp0, x1, .true.)
1352  !
1353  ! Infragravity wave height
1354  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 10 ) THEN
1355  CALL s2grid(hsig, x1)
1356  !
1357  ! Expected maximum sea surface elevation
1358  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 11 ) THEN
1359  CALL s2grid(stmaxe, x1)
1360  !
1361  ! Standard deviation of maximum sea surface elevation
1362  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 12 ) THEN
1363  CALL s2grid(stmaxd, x1)
1364  !
1365  ! Expected maximum wave height
1366  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 13 ) THEN
1367  CALL s2grid(hmaxe, x1)
1368  !
1369  ! Expected maximum wave height from crest
1370  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 14 ) THEN
1371  CALL s2grid(hcmaxe, x1)
1372  !
1373  ! STD of maximum wave height
1374  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 15 ) THEN
1375  CALL s2grid(hmaxd, x1)
1376  !
1377  ! STD of maximum wave height from crest
1378  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 16 ) THEN
1379  CALL s2grid(hcmaxd, x1)
1380  !
1381  ! Dominant wave breaking probability
1382  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 17 ) THEN
1383  CALL s2grid(wbt, x1)
1384  !
1385  ! Wave peak period (derived from peak freq field)
1386  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 18 ) THEN
1387  DO i=1,nsea
1388  IF(fp0(i) .NE. undef) THEN
1389  aux1(i) = 1.0 / fp0(i)
1390  ELSE
1391  aux1(i) = undef
1392  ENDIF
1393  ENDDO
1394  !
1395  CALL s2grid(aux1, x1)
1396  !
1397  ! Mean wave number
1398  ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 19 ) THEN
1399  IF( smcgrd ) THEN
1400 #ifdef W3_SMC
1401  CALL w3s2xy_smc( wnmean, x1 )
1402 #endif
1403  ELSE
1404  CALL w3s2xy ( nsea, nsea, nx+1, ny, wnmean, mapsf, x1 )
1405  END IF
1406  !
1407  ! Wave elevation spectrum
1408  ELSE IF ( ifi .EQ. 3 .AND. ifj .EQ. 1 ) THEN
1409  ! Information for spectral
1410  flfrq = .true.
1411  i1f=e3df(2,1)
1412  i2f=e3df(3,1)
1413  DO ik=i1f,i2f
1414  CALL s2grid(ef(:,ik), xx)
1415  IF (ncvartype.EQ.2) WHERE ( xx.GE.0.) xx = alog10(xx+1e-12)
1416  xk(:,:,ik)=xx
1417  END DO
1418  !
1419  ! Mean wave direction frequency spectrum
1420  ELSE IF ( ifi .EQ. 3 .AND. ifj .EQ. 2 ) THEN
1421  ! Information for spectral
1422  flfrq = .true.
1423  i1f=e3df(2,2)
1424  i2f=e3df(3,2)
1425  DO ik=i1f,i2f
1426 #ifdef W3_RTD
1427  ! Rotate direction back to standard pole
1428  IF ( flagunr ) CALL w3thrtn(nsea, th1m(:,ik), angld, .false.)
1429 #endif
1430  CALL s2grid(th1m(:,ik), xx)
1431  xk(:,:,ik)=xx
1432  END DO
1433  !
1434  ! Spreading frequency spectrum
1435  ELSE IF ( ifi .EQ. 3 .AND. ifj .EQ. 3 ) THEN
1436  ! Information for spectral
1437  flfrq = .true.
1438  i1f=e3df(2,3)
1439  i2f=e3df(3,3)
1440  DO ik=i1f,i2f
1441  CALL s2grid(sth1m(:,ik), xx)
1442  xk(:,:,ik)=xx
1443  END DO
1444  !
1445  ! Second mean wave direction frequency spectrum
1446  ELSE IF ( ifi .EQ. 3 .AND. ifj .EQ. 4 ) THEN
1447  ! Information for spectral
1448  flfrq = .true.
1449  i1f=e3df(2,4)
1450  i2f=e3df(3,4)
1451  DO ik=i1f,i2f
1452 #ifdef W3_RTD
1453  ! Rotate direction back to standard pole
1454  IF ( flagunr ) CALL w3thrtn(nsea, th2m(:,ik), angld, .false.)
1455 #endif
1456  CALL s2grid(th2m(:,ik), xx)
1457  xk(:,:,ik)=xx
1458  END DO
1459  !
1460  ! Second spreading frequency spectrum
1461  ELSE IF ( ifi .EQ. 3 .AND. ifj .EQ. 5 ) THEN
1462  ! Information for spectral
1463  flfrq = .true.
1464  i1f=e3df(2,5)
1465  i2f=e3df(3,5)
1466  DO ik=i1f,i2f
1467  CALL s2grid(sth2m(:,ik), xx)
1468  xk(:,:,ik)=xx
1469  END DO
1470  !
1471  ! Wave numbers
1472  ELSE IF ( ifi .EQ. 3 .AND. ifj .EQ. 6 ) THEN
1473  ! Information for spectral
1474  flfrq = .true.
1475  i1f=1
1476  i2f=nk
1477  DO ik=1,nk
1478  CALL s2grid(wn(ik,:), xx)
1479  xk(:,:,ik)=xx
1480  END DO
1481  !
1482  ! Partition wave significant height
1483  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 1 ) THEN
1484  CALL s2grid(phs(:,ipart), x1)
1485  !
1486  ! Partition peak period
1487  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 2 ) THEN
1488  CALL s2grid(ptp(:,ipart), x1)
1489 
1490  ! Partition peak wave length
1491  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 3 ) THEN
1492  CALL s2grid(plp(:,ipart), x1)
1493  !
1494  ! Partition wave mean direction
1495  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 4 ) THEN
1496 #ifdef W3_RTD
1497  ! Rotate direction back to standard pole
1498  IF ( flagunr ) CALL w3thrtn(nsea, pdir(:,ipart), angld, .false.)
1499 #endif
1500  CALL s2grid(pdir(:,ipart), x1, .true.)
1501  !
1502  ! Partition directional spread
1503  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 5 ) THEN
1504  CALL s2grid(psi(:,ipart), x1)
1505  !
1506  ! Partition wind sea fraction
1507  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 6 ) THEN
1508  CALL s2grid(pws(:,ipart), x1)
1509  !
1510  ! Partition peak direction
1511  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 7 ) THEN
1512 #ifdef W3_RTD
1513  ! Rotate direction back to standard pole
1514  IF ( flagunr ) CALL w3thrtn(nsea, pthp0(:,ipart), angld, .false.)
1515 #endif
1516  CALL s2grid(pthp0(:,ipart), x1, .true.)
1517  !
1518  ! Partition peakedness
1519  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 8 ) THEN
1520  CALL s2grid(pqp(:,ipart), x1)
1521  !
1522  ! Partition peak enhancement factor
1523  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 9 ) THEN
1524  CALL s2grid(ppe(:,ipart), x1)
1525  !
1526  ! Partition frequency width
1527  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 10 ) THEN
1528  CALL s2grid(pgw(:,ipart), x1)
1529  !
1530  ! Partition spectral width
1531  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 11 ) THEN
1532  CALL s2grid(psw(:,ipart), x1)
1533  !
1534  ! Partition mean period Tm10
1535  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 12 ) THEN
1536  CALL s2grid(ptm1(:,ipart), x1)
1537  !
1538  ! Partition mean period T01
1539  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 13 ) THEN
1540  CALL s2grid(pt1(:,ipart), x1)
1541  !
1542  ! Partition mean period T02
1543  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 14 ) THEN
1544  CALL s2grid(pt2(:,ipart), x1)
1545  !
1546  ! Partition energy at peak frequency
1547  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 15 ) THEN
1548  CALL s2grid(pep(:,ipart), x1)
1549  nfield=1
1550  !
1551  ! Partition wind sea fraction
1552  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 16 ) THEN
1553  CALL s2grid(pwst(:), x1)
1554  !
1555  ! Number of wave partitions
1556  ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 17 ) THEN
1557  CALL s2grid(pnr(:), x1)
1558  !
1559  ! Friction velocity
1560  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 1 ) THEN
1561  !! Note - UST and USTDIR read in from .ww3 file are X-Y vectors
1562  DO isea=1, nsea
1563  uabs = sqrt(ust(isea)**2+ustdir(isea)**2)
1564  IF (uabs.GE.10.) THEN
1565  ust(isea)=undef
1566  ustdir(isea)=undef
1567  END IF
1568  END DO
1569 #ifdef W3_RTD
1570  ! Rotate x,y vector back to standard pole
1571  IF ( flagunr ) CALL w3xyrtn(nsea, ust(1:nsea), ustdir(1:nsea), angld)
1572 #endif
1573  CALL s2grid(ust(1:nsea), xx)
1574  CALL s2grid(ustdir(1:nsea), xy)
1575  !! Commented out unnecessary statements below for time being
1576  !! UST,USTDIR are in north-east convention and X1,X2
1577  !! are not actually written out below
1578  !DO ISEA=1, NSEA
1579  ! UABS = SQRT(UST(ISEA)**2+USTDIR(ISEA)**2)
1580  ! IF ( UST(ISEA) .EQ. UNDEF ) THEN
1581  ! USTDIR(ISEA) = UNDEF
1582  ! UABS = UNDEF
1583  ! ELSE IF ( UABS .GT. 0.05 ) THEN
1584  ! USTDIR(ISEA) = MOD ( 630. - &
1585  ! RADE*ATAN2(USTDIR(ISEA),UST(ISEA)) , 360. )
1586  ! ELSE
1587  ! USTDIR(ISEA) = UNDEF
1588  ! END IF
1589  ! UST(ISEA) = UABS
1590  ! END DO
1591  !CALL W3S2XY (NSEA,NSEA,NX+1,NY, UST (1:NSEA) , MAPSF, X1 )
1592  !CALL W3S2XY (NSEA,NSEA,NX+1,NY, USTDIR(1:NSEA) , MAPSF, X2 )
1593  nfield=2
1594  !
1595  ! Charnock coefficient
1596  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 2 ) THEN
1597  CALL s2grid(charn(1:nsea), x1)
1598  !
1599  ! Wave energy flux
1600  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 3 ) THEN
1601  DO isea=1, nsea
1602  IF ( cge(isea) .NE. undef ) &
1603  cge(isea) = 0.001 * cge(isea) ! from W / m to kW / m
1604  END DO
1605  CALL s2grid(cge(1:nsea), x1)
1606  !
1607  ! Wind to wave energy flux
1608  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 4 ) THEN
1609  IF (ncvartypei.EQ.3) ncvartype=4
1610  CALL s2grid(phiaw(1:nsea), x1)
1611  !
1612  ! Wave supported wind stress
1613  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 5 ) THEN
1614 #ifdef W3_RTD
1615  ! Rotate x,y vector back to standard pole
1616  IF ( flagunr ) CALL w3xyrtn(nsea, tauwix(1:nsea), tauwiy(1:nsea), angld)
1617 #endif
1618  CALL s2grid(tauwix(1:nsea), xx)
1619  CALL s2grid(tauwiy(1:nsea), xy)
1620 
1621  !! Commented out unnecessary statements below for time being
1622  !! TAUWIX, TAUWIY are in north-east convention and X1,X2
1623  !! are not actually written out below
1624  !DO ISEA=1, NSEA
1625  ! CABS = SQRT(TAUWIX(ISEA)**2+TAUWIY(ISEA)**2)
1626  ! IF ( CABS .NE. UNDEF ) THEN
1627  ! TAUWIY(ISEA) = MOD ( 630. - &
1628  ! RADE*ATAN2(TAUWIY(ISEA),TAUWIX(ISEA)) , 360. )
1629  ! ELSE
1630  ! TAUWIY(ISEA) = UNDEF
1631  ! END IF
1632  ! TAUWIX(ISEA) = CABS
1633  ! END DO
1634  !CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIX, MAPSF, X1 )
1635  !CALL W3S2XY ( NSEA, NSEA, NX+1, NY, TAUWIY, MAPSF, X2 )
1636  nfield=2
1637  !
1638  ! Wave to wind stress
1639  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 6 ) THEN
1640 #ifdef W3_RTD
1641  ! Rotate x,y vector back to standard pole
1642  IF ( flagunr ) CALL w3xyrtn(nsea, tauwnx(1:nsea), tauwny(1:nsea), angld)
1643 #endif
1644  CALL s2grid(tauwnx(1:nsea), xx)
1645  CALL s2grid(tauwny(1:nsea), xy)
1646  nfield=2
1647  !
1648  ! Whitecap coverage
1649  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 7 ) THEN
1650  CALL s2grid(whitecap(1:nsea,1), x1)
1651  !
1652  ! Whitecap foam thickness
1653  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 8 ) THEN
1654  CALL s2grid(whitecap(1:nsea,2), x1)
1655  !
1656  ! Significant breaking wave height
1657  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 9 ) THEN
1658  CALL s2grid(whitecap(1:nsea,3), x1)
1659  !
1660  ! Whitecap moment
1661  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 10 ) THEN
1662  CALL s2grid(whitecap(1:nsea,4), x1)
1663  !
1664  ! Wind sea mean period T0M1
1665  ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ. 11 ) THEN
1666  CALL s2grid(tws(1:nsea), x1)
1667  !
1668  ! Radiation stress
1669  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 1 ) THEN
1670 #ifdef W3_RTD
1671  ! Radition stress components are always left on rotated pole
1672  ! at present - need to confirm how to de-rotate
1673 #endif
1674 
1675  CALL s2grid(sxx(1:nsea), x1)
1676  CALL s2grid(syy(1:nsea), x2)
1677  CALL s2grid(sxy(1:nsea), xy)
1678  nfield=3
1679  !
1680  ! Wave to ocean stress
1681  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 2 ) THEN
1682 #ifdef W3_RTD
1683  ! Rotate x,y vector back to standard pole
1684  IF ( flagunr ) CALL w3xyrtn(nsea, tauox(1:nsea), tauoy(1:nsea), angld)
1685 #endif
1686  CALL s2grid(tauox(1:nsea), xx)
1687  CALL s2grid(tauoy(1:nsea), xy)
1688  nfield=2
1689  !
1690  ! Radiation pressure (Bernouilli Head)
1691  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 3 ) THEN
1692  CALL s2grid(bhd(1:nsea), x1)
1693  !
1694  ! Wave to ocean energy flux
1695  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 4 ) THEN
1696  IF (ncvartypei.EQ.3) ncvartype=4
1697  DO isea=1, nsea
1698  phioc(isea)=min(3000.,phioc(isea))
1699  END DO
1700  CALL s2grid(phioc(1:nsea), x1)
1701  !
1702  ! Stokes transport
1703  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 5 ) THEN
1704 #ifdef W3_RTD
1705  ! Rotate x,y vector back to standard pole
1706  IF ( flagunr ) CALL w3xyrtn(nsea, tusx(1:nsea), tusy(1:nsea), angld)
1707 #endif
1708  CALL s2grid(tusx(1:nsea), xx)
1709  CALL s2grid(tusy(1:nsea), xy)
1710  ! X1, X2 will not be output when NFIELD == 2
1711  ! ( Like for .cur, .wnd, .ust, .taw, and .uss ) (CHA at FCOO 2019-06-13):
1712  !! Commented out unnecessary statements below for time being
1713  !! (...) X1,X2 are not actually written out below
1714  !DO ISEA=1, NSEA
1715  ! CABS = SQRT(TUSX(ISEA)**2+TUSY(ISEA)**2)
1716  ! IF ( CABS .NE. UNDEF ) THEN
1717  ! TUSY(ISEA) = MOD ( 630. - &
1718  ! RADE*ATAN2(TUSY(ISEA),TUSX(ISEA)) , 360. )
1719  ! ELSE
1720  ! TUSY(ISEA) = UNDEF
1721  ! END IF
1722  ! TUSX(ISEA) = CABS
1723  ! END DO
1724  !IF( SMCGRD ) THEN
1725 #ifdef W3_SMC
1726  !CALL W3S2XY_SMC( TUSX(:), X1 )
1727  !CALL W3S2XY_SMC( TUSY(:), X2 ) ! TODO: CHRISB: TUSY is in degrees....W3S2XY_SMC expects radians...
1728 #endif
1729  !ELSE
1730  ! CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSX,MAPSF, X1 )
1731  ! CALL W3S2XY ( NSEA, NSEA, NX+1, NY,TUSY,MAPSF, X2 )
1732  !ENDIF ! SMCGRD
1733  nfield=2
1734  !
1735  ! Surface stokes drift
1736  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 6 ) THEN
1737  DO isea=1, nsea
1738  ussx(isea)=max(-0.9998,min(0.9998,ussx(isea)))
1739  ussy(isea)=max(-0.9998,min(0.9998,ussy(isea)))
1740  END DO
1741 #ifdef W3_RTD
1742  ! Rotate x,y vector back to standard pole
1743  IF ( flagunr ) CALL w3xyrtn(nsea, ussx(1:nsea), ussy(1:nsea), angld)
1744 #endif
1745  CALL s2grid(ussx(1:nsea), xx)
1746  CALL s2grid(ussy(1:nsea), xy)
1747  !! Commented out unnecessary statements below for time being
1748  !! TAUWIX, TAUWIY are in north-east convention and X1,X2
1749  !! are not actually written out below
1750  !DO ISEA=1, NSEA
1751  ! CABS = SQRT(USSX(ISEA)**2+USSY(ISEA)**2)
1752  ! IF ( CABS .NE. UNDEF ) THEN
1753  ! USSY(ISEA) = MOD ( 630. - &
1754  ! RADE*ATAN2(USSY(ISEA),USSX(ISEA)) , 360. )
1755  ! ELSE
1756  ! USSY(ISEA) = UNDEF
1757  ! END IF
1758  ! USSX(ISEA) = CABS
1759  ! END DO
1760  !CALL W3S2XY ( NSEA, NSEA, NX+1, NY,USSX,MAPSF, X1 )
1761  !CALL W3S2XY ( NSEA, NSEA, NX+1, NY,USSY,MAPSF, X2 )
1762  nfield=2
1763  !
1764  ! Power spectral density of equivalent surface pressure
1765  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 7 ) THEN
1766  nfield=2
1767  CALL s2grid(prms(1:nsea), xx)
1768  CALL s2grid(tpms(1:nsea), xy)
1769  !
1770  ! Spectral variance of surface stokes drift
1771  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 8 ) THEN
1772  ! Information for spectral distribution of surface Stokes drift (2nd file)
1773  flfrq=.true.
1774  nfield=2
1775  i1f=us3df(2)
1776  i2f=us3df(3)
1777  DO ik= i1f,i2f
1778 #ifdef W3_RTD
1779  ! Rotate x,y vector back to standard pole
1780  IF ( flagunr ) CALL w3xyrtn(nsea, us3d(:,ik), us3d(:,nk+ik), angld)
1781 #endif
1782  CALL s2grid(us3d(:,ik), xx)
1783  CALL s2grid(us3d(:,nk+ik), xy)
1784  xxk(:,:,ik)=xx
1785  xyk(:,:,ik)=xy
1786  END DO
1787  !
1788  ! Base10 logarithm of power spectral density of equivalent surface pressure
1789  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 9 ) THEN
1790  ! Information for spectral microseismic generation data (2nd file)
1791  flfrq=.true.
1792  i1f=p2msf(2)
1793  i2f=p2msf(3)
1794  DO ik=i1f,i2f
1795  CALL s2grid(p2sms(:,ik), xx)
1796 
1797  IF (ncvartype.EQ.2) THEN
1798  WHERE ( xx.GE.0.) xx = alog10(xx*(dwat*grav)**2+1e-12)
1799  ELSE
1800  WHERE ( xx.GE.0.) xx = xx*(dwat*grav)**2
1801  END IF
1802 
1803  xk(:,:,ik)=xx
1804  END DO
1805  !
1806  ! Wave to sea ice stress
1807  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 10 ) THEN
1808 #ifdef W3_RTD
1809  ! Rotate x,y vector back to standard pole
1810  IF ( flagunr ) CALL w3xyrtn(nsea, tauice(1:nsea,1), tauice(1:nsea,2), angld)
1811 #endif
1812  CALL s2grid(tauice(1:nsea,1), xx)
1813  CALL s2grid(tauice(1:nsea,2), xy)
1814  nfield=2
1815  !
1816  ! Wave to sea ice energy flux
1817  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 11 ) THEN
1818  IF (ncvartypei.EQ.3) ncvartype=4
1819  CALL s2grid(phice(1:nsea), x1)
1820  !
1821  ! Partitioned surface stokes drift
1822  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 12 ) THEN
1823  ! Information for spectral distribution of surface Stokes drift (2nd file)
1824  flfrq=.true.
1825  IF (usspf(1)==1) THEN
1826  customfrq=.true.
1827  ENDIF
1828  nfield=2
1829  i1f=1
1830  i2f=usspf(2)
1831  DO ik= i1f,i2f
1832 #ifdef W3_RTD
1833  ! Rotate x,y vector back to standard pole
1834  IF ( flagunr ) CALL w3xyrtn(nsea, ussp(:,ik), ussp(:,nk+ik), angld)
1835 #endif
1836  CALL s2grid(ussp(:,ik), xx)
1837  CALL s2grid(ussp(:,nk+ik), xy)
1838  xxk(:,:,ik) = xx
1839  xyk(:,:,ik) = xy
1840  END DO
1841  !
1842  ! Total momentum to the ocean
1843  ELSE IF ( ifi .EQ. 6 .AND. ifj .EQ. 13 ) THEN
1844 #ifdef W3_RTD
1845  ! Rotate x,y vector back to standard pole
1846  IF ( flagunr ) CALL w3xyrtn(nsea, tauocx(1:nsea), tauocy(1:nsea), angld)
1847 #endif
1848  IF( smcgrd ) THEN
1849 #ifdef W3_SMC
1850  CALL w3s2xy_smc( tauocx(1:nsea), xx )
1851  CALL w3s2xy_smc( tauocy(1:nsea), xy )
1852 #endif
1853  ELSE
1854  CALL w3s2xy ( nsea, nsea, nx+1, ny, tauocx(1:nsea) &
1855  , mapsf, xx )
1856  CALL w3s2xy ( nsea, nsea, nx+1, ny, tauocy(1:nsea) &
1857  , mapsf, xy )
1858  ENDIF ! SMCGRD
1859  nfield=2
1860  !
1861  ! RMS of bottom displacement amplitude
1862  ELSE IF ( ifi .EQ. 7 .AND. ifj .EQ. 1 ) THEN
1863  ! NB: ABA and ABD are the X and Y components of the bottom displacement
1864 #ifdef W3_RTD
1865  ! Rotate x,y vector back to standard pole
1866  IF ( flagunr ) CALL w3xyrtn(nsea, aba(1:nsea), abd(1:nsea), angld)
1867 #endif
1868  CALL s2grid(aba(1:nsea), xx)
1869  CALL s2grid(abd(1:nsea), xy)
1870  nfield=2
1871  !
1872  ! RMS of bottom velocity amplitude
1873  ELSE IF ( ifi .EQ. 7 .AND. ifj .EQ. 2 ) THEN
1874  ! NB: UBA and UBD are the X and Y components of the bottom velocity
1875 #ifdef W3_RTD
1876  ! Rotate x,y vector back to standard pole
1877  IF ( flagunr ) CALL w3xyrtn(nsea, uba(1:nsea), ubd(1:nsea), angld)
1878 #endif
1879  CALL s2grid(uba(1:nsea), xx)
1880  CALL s2grid(ubd(1:nsea), xy)
1881  nfield=2
1882  !
1883  ! Bottom roughness
1884  ELSE IF ( ifi .EQ. 7 .AND. ifj .EQ. 3 ) THEN
1885 #ifdef W3_RTD
1886  ! Rotate x,y vector back to standard pole
1887  IF ( flagunr ) CALL w3xyrtn(nsea, bedforms(1:nsea,2), &
1888  bedforms(1:nsea,3), angld)
1889 #endif
1890  CALL s2grid(bedforms(1:nsea,1), x1)
1891  CALL s2grid(bedforms(1:nsea,2), x2)
1892  CALL s2grid(bedforms(1:nsea,3), xy)
1893  nfield=3
1894  !
1895  ! Wave dissipation in bottom boundary layer
1896  ELSE IF ( ifi .EQ. 7 .AND. ifj .EQ. 4 ) THEN
1897  CALL s2grid(phibbl(1:nsea), x1)
1898  !
1899  ! Wave to bottom boundary layer stress
1900  ELSE IF ( ifi .EQ. 7 .AND. ifj .EQ. 5 ) THEN
1901 #ifdef W3_RTD
1902  ! Rotate x,y vector back to standard pole
1903  IF ( flagunr ) CALL w3xyrtn(nsea, taubbl(1:nsea,1), &
1904  taubbl(1:nsea,2), angld)
1905 #endif
1906  CALL s2grid(taubbl(1:nsea,1), xx)
1907  CALL s2grid(taubbl(1:nsea,2), xy)
1908  nfield=2
1909  !
1910  ! Mean square slope
1911  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 1 ) THEN
1912 #ifdef W3_RTD
1913  ! Rotate x,y vector back to standard pole
1914  IF ( flagunr ) CALL w3xyrtn(nsea, mssx, mssy, angld)
1915 #endif
1916  CALL s2grid(mssx, xx)
1917  CALL s2grid(mssy, xy)
1918  nfield=2
1919  !
1920  ! Phillips constant
1921  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 2 ) THEN
1922 #ifdef W3_RTD
1923  ! Rotate x,y vector back to standard pole
1924  IF ( flagunr ) CALL w3xyrtn(nsea, mscx, mscy, angld)
1925 #endif
1926  CALL s2grid(mscx, xx)
1927  CALL s2grid(mscy, xy)
1928  nfield=2
1929  !
1930  ! u direction for mss
1931  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 3 ) THEN
1932 #ifdef W3_RTD
1933  ! Rotate direction back to standard pole
1934  IF ( flagunr ) CALL w3thrtn(nsea, mssd, angld, .false.)
1935 #endif
1936  DO isea=1, nsea
1937  IF ( mssd(isea) .NE. undef ) THEN
1938  mssd(isea) = mod( 630. - rade*mssd(isea) , 180. )
1939  END IF
1940  END DO
1941  CALL s2grid(mssd, x1)
1942  !
1943  ! x direction for msc
1944  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 4 ) THEN
1945 #ifdef W3_RTD
1946  ! Rotate direction back to standard pole
1947  IF ( flagunr ) CALL w3thrtn(nsea, mscd, angld, .false.)
1948 #endif
1949  DO isea=1, nsea
1950  IF ( mscd(isea) .NE. undef ) THEN
1951  mscd(isea) = mod( 630. - rade*mscd(isea) , 180. )
1952  END IF
1953  END DO
1954  CALL s2grid(mscd, x1)
1955  !
1956  ! Peakedness
1957  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 5 ) THEN
1958  CALL s2grid(qp, x1)
1959  !
1960  ! k bandwidth
1961  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 6 ) THEN
1962  CALL s2grid(qkk, x1)
1963  !
1964  ! surface elevation skewness lambda_3,0,0
1965  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 7 ) THEN
1966  CALL s2grid(skew, x1)
1967  !
1968  ! em bias param 1
1969  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 8 ) THEN
1970  CALL s2grid(embia1, x1)
1971  !
1972  ! em bias param 2
1973  ELSE IF ( ifi .EQ. 8 .AND. ifj .EQ. 9 ) THEN
1974  CALL s2grid(embia2, x1)
1975  !
1976  ! Dynamic time step
1977  ELSE IF ( ifi .EQ. 9 .AND. ifj .EQ. 1 ) THEN
1978  DO isea=1, nsea
1979  IF ( dtdyn(isea) .NE. undef ) THEN
1980  dtdyn(isea) = dtdyn(isea) / 60.
1981  END IF
1982  END DO
1983  CALL s2grid(dtdyn, x1)
1984  !
1985  ! Cut off frequency
1986  ELSE IF ( ifi .EQ. 9 .AND. ifj .EQ. 2 ) THEN
1987  CALL s2grid(fcut, x1)
1988  !
1989  ! Maximum CFL for spatial advection
1990  ELSE IF ( ifi .EQ. 9 .AND. ifj .EQ. 3 ) THEN
1991  IF (ncvartypei.EQ.3) ncvartype=4
1992  CALL s2grid(cflxymax, x1)
1993  !
1994  ! Maximum CFL for direction advection
1995  ELSE IF ( ifi .EQ. 9 .AND. ifj .EQ. 4 ) THEN
1996  IF (ncvartypei.EQ.3) ncvartype=4
1997  CALL s2grid(cflthmax, x1)
1998  !
1999  ! Maximum CFL for frequency advection
2000  ELSE IF ( ifi .EQ. 9 .AND. ifj .EQ. 5 ) THEN
2001  IF (ncvartypei.EQ.3) ncvartype=4
2002  CALL s2grid(cflkmax, x1)
2003  !
2004  ! User defined...
2005  ELSE IF ( ifi .EQ. 10 ) THEN
2006  !CB WRITE (ENAME,'(A2,I2.2)') '.u', IFJ
2007  CALL s2grid(usero(:,ifj), x1)
2008  ELSE
2009  WRITE (ndse,999) ifi, ifj
2010  CALL extcde ( 1 )
2011  !
2012  END IF ! IFI AND IFJ
2013 
2014  ! CB Get netCDF metadata for IFI, IFJ combination (all components).
2015  DO i=1,nfield
2016  meta(i) = getmeta(ifi, ifj, icomp=i, ipart=ipart)
2017  ENDDO
2018 
2019  ! 2.2 Make map
2020 
2021  ! CB: TODO - need to handle MAPSTA differently for SMC grid output.
2022  IF( .NOT. smcgrd ) THEN
2023  DO ix=1, nx
2024  DO iy=1, ny
2025  mapout(ix,iy)=int2(mapsta(iy,ix) + 8*mapst2(iy,ix))
2026  IF ( mapsta(iy,ix) .EQ. 0 ) THEN
2027  x1(ix,iy) = undef
2028  x2(ix,iy) = undef
2029  xx(ix,iy) = undef
2030  xy(ix,iy) = undef
2031  END IF
2032  IF ( x1(ix,iy) .EQ. undef ) THEN
2033  map(ix,iy) = 0
2034  ELSE
2035  map(ix,iy) = 1
2036  END IF
2037  IF ( x2(ix,iy) .EQ. undef ) THEN
2038  mp2(ix,iy) = 0
2039  ELSE
2040  mp2(ix,iy) = 1
2041  END IF
2042  END DO
2043  END DO
2044  ENDIF ! CB
2045 
2046 
2047  ! 2.3 Setups the output type 4 ( NetCDF file )
2048 
2049  s2=len_trim(meta(1)%ENAME)
2050  s1=len_trim(fileprefix)+s4
2051  fnamenc(s1+1:128)=' '
2052  fnamenc(s1+1:s1+1) = '_'
2053 
2054  ! If flag TOGETHER and not variable with freq dim &
2055  ! (ef, p2l, ...), no variable name in file name
2056  IF (together.AND.(.NOT.flfrq)) THEN
2057  s2=0
2058  ! If NOT flag TOGETHER or variable with freq dim &
2059  ! (ef, p2l, ...), add variable name in file name
2060  ELSE
2061  fnamenc(s1+2:s1+s2) = meta(1)%ENAME(2:s2)
2062  ENDIF
2063  ! Defines the netcdf extension
2064  fnamenc(s1+s2+1:s1+s2+3) = '.nc'
2065  fnamenc(s1+s2+4:s1+s2+6) = ' '
2066  ! If the flag frequency is .TRUE., defines the fourth dimension
2067  IF (flfrq) THEN
2068  dimln(4)=i2f-i1f+1
2069  extradim=1
2070  ELSE
2071  dimln(4)=0
2072  extradim=0
2073  END IF
2074 
2075  ! If regular grid, initializes the lat/lon or x/y dimension lengths
2076  IF (gtype.NE.ungtype) THEN
2077  IF( smcgrd ) THEN
2078 #ifdef W3_SMC
2079  IF( smcotype .EQ. 1 ) THEN
2080  ! Flat seapoints file
2081  !dimln(2) = NSEA
2082  dimln(2) = smcnout
2083  dimln(3) = -1 ! not used
2084  ELSE
2085  ! Regular gridded lat/lon file:
2086  dimln(2) = nxo
2087  dimln(3) = nyo
2088  ENDIF ! SMCOTYPE
2089 #endif
2090  ELSE ! SMCGRD
2091  dimln(2)=ixn-ix1+1
2092  dimln(3)=iyn-iy1+1
2093  ENDIF ! SMCGRD
2094  ! If unstructured mesh, initializes the nelem,tri dimension lengths
2095  ELSE
2096  dimln(2)=ixn-ix1+1
2097  dimln(3)=ntri
2098  ENDIF
2099 
2100  ! Defines index of first field variable
2101  ivar1=21
2102 
2103 
2104  ! 2.4.1 Save the id of the previous file
2105 
2106  IF (together.AND.(.NOT.flfrq)) THEN
2107  oldncid = ncids(1,1,1)
2108  ELSE
2109  oldncid = ncids(ifi,ifj,ipart+1)
2110  END IF
2111 
2112 
2113  ! 2.4.2 Remove the new file (if not created by the run)
2114 
2115  INQUIRE(file=fnamenc, exist=fexist)
2116  IF (fexist) THEN
2117  fremove = .false.
2118  ! time splitted condition
2119  IF (index(timeid,oldtimeid).EQ.0) THEN
2120  ! all variables in the samefile
2121  IF (together.AND.(.NOT.flfrq).AND.ncid.EQ.0) fremove = .true.
2122  ! a file per variable
2123  IF (.NOT.together.OR.flfrq) fremove = .true.
2124  END IF
2125 
2126  IF (fremove) THEN
2127  OPEN(unit=1234, iostat=iret, file=fnamenc, status='old')
2128  IF (iret == 0) CLOSE(1234, status='delete')
2129  fexist=.false.
2130  ELSE
2131  ncid = oldncid
2132  END IF
2133  END IF
2134 
2135  ! 2.4.3 Finalize the previous file (if a new one will be created)
2136 
2137  IF (.NOT.fexist) THEN
2138  IF (index('0000000000000000',oldtimeid).EQ.0 .AND. index(timeid,oldtimeid).EQ.0) THEN
2139  iret = nf90_redef(oldncid)
2140  CALL check_err(iret)
2141  IF(fl_default_gbl_meta) THEN
2142  iret=nf90_put_att(oldncid,nf90_global,'stop_date',strstopdate)
2143  CALL check_err(iret)
2144  ENDIF
2145  iret=nf90_close(oldncid)
2146  CALL check_err(iret)
2147  END IF
2148  END IF
2149 
2150 
2151  ! 2.5 Creates the netcdf file
2152 
2153  IF (.NOT.fexist) THEN
2154 
2155  ! Initializes the time dimension length
2156  dimln(1)=1
2157 
2158  ! If NOT unstructure mesh (i.e. regular grid)
2159  !! CHRISB: VARNM for lat/lon not actually used below.
2160  ! IF (GTYPE.NE.UNGTYPE) THEN
2161  ! ! If spherical coordinate
2162  ! IF (FLAGLL) THEN
2163  ! VARNM(NFIELD+1)='Longitude'
2164  ! VARNM(NFIELD+2)='Latitude'
2165  ! ! If cartesian coordinate
2166  ! ELSE
2167  ! VARNM(NFIELD+1)='x'
2168  ! VARNM(NFIELD+2)='y'
2169  ! END IF
2170  ! END IF
2171 
2172  ! Initializes the time iteration counter n
2173  n=1
2174 
2175  ! 2.5.1 Creates the NetCDF file
2176  CALL w3crnc(fnamenc,ncid,dimid,dimln,varid, &
2177  extradim,nctype,mapstaout)
2178 
2179  ! Saves the NCID to keep the file opened to write all the variables
2180  ! and open/close at each time step
2181  IF (together.AND.(.NOT.flfrq)) THEN
2182  ncids(1,1,1)=ncid
2183  ELSE
2184  ncids(ifi,ifj,ipart+1)=ncid
2185  END IF
2186 
2187  ! If curvilinear grid, instanciates lat / lon
2188  IF (gtype.EQ.clgtype) THEN
2189  IF (.NOT.ALLOCATED(lon2d)) ALLOCATE(lon2d(nx,ny),lat2d(nx,ny))
2190  lon2d=transpose(xgrd)
2191  lat2d=transpose(ygrd)
2192  IF(fl_default_gbl_meta) THEN
2193  iret=nf90_put_att(ncid,nf90_global, &
2194  'latitude_resolution','n/a')
2195  CALL check_err(iret)
2196  iret=nf90_put_att(ncid,nf90_global, &
2197  'longitude_resolution','n/a')
2198  CALL check_err(iret)
2199  ENDIF
2200  ! If NOT curvilinear grid,
2201  ELSE
2202  IF( smcgrd ) THEN
2203 #ifdef W3_SMC
2204  IF(smcotype .EQ. 1) THEN
2205  ! Flat seapoints file
2206  IF(.NOT.ALLOCATED(lon)) ALLOCATE(lon(smcnout))
2207  IF(.NOT.ALLOCATED(lat)) ALLOCATE(lat(smcnout))
2208  IF(.NOT.ALLOCATED(smccx)) ALLOCATE(smccx(smcnout))
2209  IF(.NOT.ALLOCATED(smccy)) ALLOCATE(smccy(smcnout))
2210  ELSE
2211  ! Regular gridded file
2212  IF(.NOT.ALLOCATED(lon)) ALLOCATE(lon(nxo))
2213  IF(.NOT.ALLOCATED(lat)) ALLOCATE(lat(nyo))
2214 #endif
2215 #ifdef W3_RTD
2216  ! Intermediate EQUatorial lat/lon arrays for de-rotation
2217  ! of rotated pole coordinates:
2218  !!IF(.NOT.ALLOCATED(LON2DEQ)) ALLOCATE(LON2DEQ(NXO,NYO))
2219  !!IF(.NOT.ALLOCATED(LAT2DEQ)) ALLOCATE(LAT2DEQ(NXO,NYO))
2220  !
2221  ! Use local RTDNX/RTDNY variables until CPP implemented to
2222  ! avoid compile error when SMC switch not enabled (C.Bunney):
2223  IF(.NOT.ALLOCATED(lon2deq)) ALLOCATE(lon2deq(rtdnx,rtdny))
2224  IF(.NOT.ALLOCATED(lat2deq)) ALLOCATE(lat2deq(rtdnx,rtdny))
2225 #endif
2226 #ifdef W3_SMC
2227  ENDIF
2228 #endif
2229 #ifdef W3_RTD
2230  ! Arrays for de-rotated lat/lon coordinates:
2231  IF(.NOT.ALLOCATED(lon2d)) THEN
2232  !!ALLOCATE(LON2D(NXO,NYO), LAT2D(NXO,NYO))
2233  !!ALLOCATE(ANGLD2D(NXO,NYO))
2234  !
2235  ! Use local RTDNX/RTDNY variables until CPP implemented to
2236  ! avoid compile error when SMC switch not enabled (C.Bunney):
2237  ALLOCATE(lon2d(rtdnx,rtdny), lat2d(rtdnx,rtdny))
2238  ALLOCATE(angld2d(rtdnx,rtdny))
2239  ENDIF
2240 #endif
2241  ELSE ! SMCGRD
2242  ! instanciates lon with x/lon for regular grid or nodes for unstructured mesh
2243  IF (.NOT.ALLOCATED(lon)) ALLOCATE(lon(nx))
2244 #ifdef W3_RTD
2245  ! 2d longitude array for standard grid coordinates
2246  IF ( rtdl .AND. .NOT.ALLOCATED(lon2d)) &
2247  ALLOCATE(lon2d(nx,ny),lon2deq(nx,ny),angld2d(nx,ny))
2248 #endif
2249  IF (.NOT.ALLOCATED(lat)) THEN
2250  ! If regular grid, instanciates lat with y/lat
2251  IF (gtype.EQ.rlgtype) THEN
2252  ALLOCATE(lat(ny))
2253 #ifdef W3_RTD
2254  ! 2d latitude array for standard grid coordinates
2255  IF ( rtdl .AND. .NOT.ALLOCATED(lat2d)) &
2256  ALLOCATE(lat2d(nx,ny),lat2deq(nx,ny))
2257 #endif
2258  ! If unstructured mesh, instanciates lat with nodes
2259  ELSE
2260  ALLOCATE(lat(nx))
2261  END IF
2262  END IF
2263  END IF ! SMCGRD
2264  END IF
2265 
2266 
2267  ! 2.5.2 Generates Lat-Lon arrays
2268 
2269  ! If regular grid
2270  IF (gtype.EQ.rlgtype .OR. gtype.EQ.smctype) THEN
2271  IF( smcgrd ) THEN
2272 #ifdef W3_SMC
2273  ! CB: Calculate lat/lons of SMC grid
2274  IF( smcotype .EQ. 1 ) THEN
2275  ! CB: Flat seapoints file
2276  DO i=1,smcnout
2277  j = smcidx(i)
2278  lon(i) = (x0-0.5*sx) + (ijkcel(1,j) + 0.5 * ijkcel(3,j)) * dlon
2279  lat(i) = (y0-0.5*sy) + (ijkcel(2,j) + 0.5 * ijkcel(4,j)) * dlat
2280  smccx(i) = ijkcel(3,j)
2281  smccy(i) = ijkcel(4,j)
2282  ENDDO
2283 #endif
2284 #ifdef W3_RTD
2285  !!CALL W3EQTOLL(lat, lon, LAT2D(:,1), LON2D(:,1), &
2286  !! ANGLD2D(:,1), POLAT, POLON, NYO*NXO)
2287  !
2288  ! Use local RTDNX/RTDNY variables until CPP implemented to
2289  ! avoid compile error when SMC switch not enabled (C.Bunney):
2290  CALL w3eqtoll(lat, lon, lat2d(:,1), lon2d(:,1), &
2291  angld2d(:,1), polat, polon, rtdny*rtdnx)
2292 #endif
2293 #ifdef W3_SMC
2294  ELSE
2295  ! CB: Regridded SMC data
2296  sxd=dble(0.000001d0*dnint(1d6*(dble(dxo)) ))
2297  syd=dble(0.000001d0*dnint(1d6*(dble(dyo)) ))
2298  x0d=dble(0.000001d0*dnint(1d6*(dble(sxo)) ))
2299  y0d=dble(0.000001d0*dnint(1d6*(dble(syo)) ))
2300  DO i=1,nxo
2301  lon(i)=real(x0d+sxd*dble(i-1))
2302 #endif
2303 #ifdef W3_RTD
2304  lon2deq(i,:) = lon(i)
2305 #endif
2306 #ifdef W3_SMC
2307  END DO
2308  DO i=1,nyo
2309  lat(i)=real(y0d+syd*dble(i-1))
2310 #endif
2311 #ifdef W3_RTD
2312  lat2deq(:,i) = lat(i)
2313 #endif
2314 #ifdef W3_SMC
2315  END DO
2316  WRITE(str2,'(F12.7)') dyo
2317  str2=adjustl(str2)
2318  IF(fl_default_gbl_meta) THEN
2319  iret=nf90_put_att(ncid,nf90_global, &
2320  'latitude_resolution', trim(str2))
2321  WRITE(str2,'(F12.7)') dxo
2322  str2=adjustl(str2)
2323  iret=nf90_put_att(ncid,nf90_global, &
2324  'longitude_resolution',trim(str2))
2325  ENDIF
2326 #endif
2327 #ifdef W3_RTD
2328  !!CALL W3EQTOLL(LAT2DEQ, LON2DEQ, LAT2D, LON2D, &
2329  !! ANGLD2D, POLAT, POLON, NYO*NXO)
2330  !
2331  ! Use local RTDNX/RTDNY variables until CPP implemented to
2332  ! avoid compile error when SMC switch not enabled (C.Bunney):
2333  CALL w3eqtoll(lat2deq, lon2deq, lat2d, lon2d, &
2334  angld2d, polat, polon, rtdny*rtdnx)
2335 #endif
2336 #ifdef W3_SMC
2337  ENDIF ! SMCOTYPE
2338 #endif
2339  ELSE ! SMCGRD
2340  sxd=dble(0.000001d0*dnint(1d6*(dble(sx)) ))
2341  syd=dble(0.000001d0*dnint(1d6*(dble(sy)) ))
2342  x0d=dble(0.000001d0*dnint(1d6*(dble(x0)) ))
2343  y0d=dble(0.000001d0*dnint(1d6*(dble(y0)) ))
2344  DO i=1,nx
2345  lon(i)=real(x0d+sxd*dble(i-1))
2346  END DO
2347  DO i=1,ny
2348  lat(i)=real(y0d+syd*dble(i-1))
2349  END DO
2350 #ifdef W3_RTD
2351  IF ( rtdl ) THEN
2352  ! Calculate the standard grid coordinates
2353  DO i=1,nx
2354  lon2deq(i,:)=lon(i)
2355  END DO
2356  DO i=1,ny
2357  lat2deq(:,i)=lat(i)
2358  END DO
2359  CALL w3eqtoll(lat2deq, lon2deq, lat2d, lon2d, &
2360  angld2d, polat, polon, ny*nx)
2361  END IF ! RTDL
2362 #endif
2363  IF(fl_default_gbl_meta) THEN
2364  WRITE(str2,'(F12.0)') sy
2365  str2=adjustl(str2)
2366  iret=nf90_put_att(ncid,nf90_global, &
2367  'latitude_resolution', trim(str2))
2368  CALL check_err(iret)
2369  WRITE(str2,'(F12.0)') sx
2370  str2=adjustl(str2)
2371  iret=nf90_put_att(ncid,nf90_global, &
2372  'longitude_resolution',trim(str2))
2373  CALL check_err(iret)
2374  ENDIF
2375  END IF ! SMCGRD
2376  END IF
2377 
2378  ! If unstructured mesh
2379  IF (gtype.EQ.ungtype) THEN
2380  lon(:)=xgrd(1,:)
2381  lat(:)=ygrd(1,:)
2382  dimln(2)=nx
2383  dimln(3)=ntri
2384  IF(fl_default_gbl_meta) THEN
2385  iret=nf90_put_att(ncid,nf90_global, &
2386  'latitude_resolution','n/a')
2387  CALL check_err(iret)
2388  iret=nf90_put_att(ncid,nf90_global, &
2389  'longitude_resolution','n/a')
2390  CALL check_err(iret)
2391  ENDIF
2392  END IF
2393 
2394  ! Finishes declaration part in file by adding geographical bounds
2395  IF(fl_default_gbl_meta) THEN
2396  IF(smcgrd) THEN
2397  WRITE(str2,'(F12.0)') minval(lat)
2398  ELSE
2399  WRITE(str2,'(F12.0)') minval(ygrd)
2400  ENDIF
2401  str2=adjustl(str2)
2402  iret=nf90_put_att(ncid,nf90_global, &
2403  'southernmost_latitude',trim(str2))
2404  CALL check_err(iret)
2405 
2406  IF(smcgrd) THEN
2407  WRITE(str2,'(F12.0)') maxval(lat)
2408  ELSE
2409  WRITE(str2,'(F12.0)') maxval(ygrd)
2410  ENDIF
2411  str2=adjustl(str2)
2412  iret=nf90_put_att(ncid,nf90_global, &
2413  'northernmost_latitude',trim(str2))
2414  CALL check_err(iret)
2415 
2416  IF(smcgrd) THEN
2417  WRITE(str2,'(F12.0)') minval(lon)
2418  ELSE
2419  WRITE(str2,'(F12.0)') minval(xgrd)
2420  ENDIF
2421  str2=adjustl(str2)
2422  iret=nf90_put_att(ncid,nf90_global, &
2423  'westernmost_longitude',trim(str2))
2424  CALL check_err(iret)
2425 
2426 
2427  IF(smcgrd) THEN
2428  WRITE(str2,'(F12.0)') maxval(lon)
2429  ELSE
2430  WRITE(str2,'(F12.0)') maxval(xgrd)
2431  ENDIF
2432  str2=adjustl(str2)
2433  iret=nf90_put_att(ncid,nf90_global, &
2434  'easternmost_longitude',trim(str2))
2435  CALL check_err(iret)
2436  iret=nf90_put_att(ncid,nf90_global, &
2437  'minimum_altitude','-12000 m')
2438  CALL check_err(iret)
2439  iret=nf90_put_att(ncid,nf90_global, &
2440  'maximum_altitude','9000 m')
2441  CALL check_err(iret)
2442  iret=nf90_put_att(ncid,nf90_global, &
2443  'altitude_resolution','n/a')
2444  CALL check_err(iret)
2445 
2446 #ifdef W3_RTD
2447  IF ( rtdl ) THEN
2448  iret=nf90_put_att(ncid,nf90_global, &
2449  'grid_north_pole_latitude',polat)
2450  iret=nf90_put_att(ncid,nf90_global, &
2451  'grid_north_pole_longitude',polon)
2452  END IF
2453 #endif
2454  ENDIF ! FL_DEFAULT_GBL_META
2455 
2456  CALL t2d(time,startdate,ierr)
2457  WRITE(strstartdate,'(I4.4,A,4(I2.2,A),I2.2)') startdate(1),'-',startdate(2),'-', &
2458  startdate(3),' ',startdate(5),':',startdate(6),':',startdate(7)
2459 
2460  ! End of define mode of NetCDF file
2461  iret = nf90_enddef(ncid)
2462  CALL check_err(iret)
2463 
2464  ! 2.5.3 Writes longitudes, latitudes, triangles, frequency and status map (mapsta) to netcdf file
2465 
2466  ! If regular grid
2467  IF (gtype.EQ.rlgtype .OR. gtype.EQ.smctype) THEN
2468  IF(smcgrd) THEN ! CB: shelter original code from SMC grid
2469 #ifdef W3_SMC
2470  iret=nf90_put_var(ncid,varid(1),lon(:))
2471  CALL check_err(iret)
2472  iret=nf90_put_var(ncid,varid(2),lat(:))
2473  CALL check_err(iret)
2474  IF(smcotype .EQ. 1) THEN
2475  ! For type 1 SCM file also put lat/lons and cell sizes:
2476  iret=nf90_put_var(ncid,varid(5),smccx)
2477  CALL check_err(iret)
2478  iret=nf90_put_var(ncid,varid(6),smccy)
2479  CALL check_err(iret)
2480  ENDIF
2481 #endif
2482  ELSE ! SMCGRD
2483  iret=nf90_put_var(ncid,varid(1),lon(ix1:ixn))
2484  CALL check_err(iret)
2485  iret=nf90_put_var(ncid,varid(2),lat(iy1:iyn))
2486  CALL check_err(iret)
2487  ENDIF ! SMCGRD
2488 #ifdef W3_RTD
2489  IF ( rtdl ) THEN
2490  iret=nf90_put_var(ncid,varid(7),lon2d(ix1:ixn,iy1:iyn))
2491  CALL check_err(iret)
2492  iret=nf90_put_var(ncid,varid(8),lat2d(ix1:ixn,iy1:iyn))
2493  CALL check_err(iret)
2494  END IF
2495 #endif
2496  END IF
2497 
2498  ! If curvilinear grid
2499  IF (gtype.EQ.clgtype) THEN
2500  iret=nf90_put_var(ncid,varid(1),lon2d(ix1:ixn,iy1:iyn))
2501  CALL check_err(iret)
2502  iret=nf90_put_var(ncid,varid(2),lat2d(ix1:ixn,iy1:iyn))
2503  CALL check_err(iret)
2504  END IF
2505 
2506  ! If unstructured mesh
2507  IF (gtype.EQ.ungtype) THEN
2508  iret=nf90_put_var(ncid,varid(1),lon(ix1:ixn))
2509  CALL check_err(iret)
2510  iret=nf90_put_var(ncid,varid(2),lat(ix1:ixn))
2511  CALL check_err(iret)
2512  END IF
2513 
2514  ! Writes frequencies to netcdf file
2515  IF (extradim.EQ.1) THEN
2516  ALLOCATE(freq(i2f-i1f+1))
2517  !BGR Here is where we should tell it what frequencies are.
2518  IF (customfrq) THEN
2519  DO i=1,usspf(2)
2520  freq(i)=sqrt(grav*ussp_wn(i))*tpiinv
2521  ENDDO
2522  ELSE
2523  DO i=1,i2f-i1f+1
2524  freq(i)=sig(i1f-1+i)*tpiinv
2525  END DO
2526  ENDIF
2527  iret=nf90_put_var(ncid,varid(10),freq)
2528  CALL check_err(iret)
2529  DEALLOCATE(freq)
2530  END IF
2531 
2532  ! Writes triangles to netcdf file
2533  IF (gtype.EQ.ungtype) THEN
2534  iret=nf90_put_var(ncid,varid(4),trigp)
2535  CALL check_err(iret)
2536  END IF
2537 
2538  ! Writes status map array at variable index 2+1+coordtype+idim-4
2539  IF (mapstaout) THEN
2540  start(1)=1
2541  start(2)=1
2542  count(1)=ixn-ix1+1
2543  count(2)=iyn-iy1+1
2544  IF (gtype.NE.ungtype) THEN
2545  iret=nf90_put_var(ncid,varid(20),mapout(ix1:ixn,iy1:iyn), &
2546  (/start(1:2)/),(/count(1:2)/))
2547  ELSE
2548  iret=nf90_put_var(ncid,varid(20),mapout(ix1:ixn,1),(/start(1)/),(/count(1)/))
2549  ENDIF
2550  CALL check_err(iret)
2551  END IF
2552 
2553  ! Write forecast reference time, if requested:
2554  IF (flgfc) THEN
2555  IF(timeunit .EQ. 'S') THEN
2556  outsecs = tsubsec(epochdate, refdate)
2557  iret = nf90_put_var(ncid, varid(12), outsecs)
2558  ELSE
2559  outjulday = tsub(epochdate, refdate)
2560  iret = nf90_put_var(ncid, varid(12), outjulday)
2561  ENDIF
2562  CALL check_err(iret)
2563  ENDIF
2564 
2565  WRITE (ndso,973) fnamenc
2566 
2567  ! 2.5.4 Defines the field(LON,LAT,time) of the variable (i.e. ucur,vcur for current variable)
2568 
2569  iret = nf90_redef(ncid)
2570  CALL check_err(iret)
2571  DO i=1,nfield
2572  ivar=ivar1+i
2573  IF (coordtype.EQ.1) THEN
2574  IF (ncvartype.EQ.2) THEN
2575 #ifdef W3_SMC
2576  IF( smcgrd .AND. smcotype .EQ. 1 ) THEN
2577  ! SMC Flat file
2578  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_short, (/dimid(2), dimid(4+extradim)/), varid(ivar))
2579  ELSE
2580 #endif
2581  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_short, dimid(2:4+extradim), varid(ivar))
2582 #ifdef W3_SMC
2583  ENDIF
2584 #endif
2585  CALL check_err(iret)
2586  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2587  IF (nctype.EQ.4) CALL check_err(iret)
2588  ELSE
2589 #ifdef W3_SMC
2590  IF( smcgrd .AND. smcotype .EQ. 1 ) THEN
2591  ! SMC Flat file
2592  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_float, (/dimid(2), dimid(4+extradim)/), varid(ivar))
2593  ELSE
2594 #endif
2595  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_float, dimid(2:4+extradim), varid(ivar))
2596 #ifdef W3_SMC
2597  ENDIF
2598 #endif
2599  CALL check_err(iret)
2600  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2601  IF (nctype.EQ.4) CALL check_err(iret)
2602  END IF
2603  ELSE
2604  dimfield(1)=dimid(2)
2605  dimfield(2)=dimid(4)
2606  dimfield(3)=dimid(5)
2607  IF (ncvartype.EQ.2) THEN
2608  iret = nf90_def_var(ncid,meta(i)%VARNM, nf90_short, dimfield(1:2+extradim), varid(ivar))
2609  CALL check_err(iret)
2610  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2611  IF (nctype.EQ.4) CALL check_err(iret)
2612  ELSE
2613  iret = nf90_def_var(ncid,meta(i)%VARNM, nf90_float, dimfield(1:2+extradim), varid(ivar))
2614  CALL check_err(iret)
2615  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2616  IF (nctype.EQ.4) CALL check_err(iret)
2617  END IF
2618  END IF
2619 
2620  ! Set scale factor to 1.0 if using FLOAT variables for output
2621  IF(ncvartype .GT. 2) meta(i)%FSC = 1.0
2622 
2623  !! CB - USE NEW W3META MODULE
2624  CALL write_meta(ncid, varid(ivar), meta(i), iret) ! CB
2625  CALL check_err(iret) ! CB
2626  !
2627  !! CHRISB: Commenting out below - will be handled by w3oundmeta module
2628 #ifdef W3_RTD
2629 
2630  ! IF ( RTDL ) THEN
2631  ! ! Add grid mapping attribute for rotated pole grids:
2632  ! IRET=NF90_PUT_ATT(NCID,VARID(IVAR),'grid_mapping', &
2633  ! 'rotated_pole')
2634  ! CALL CHECK_ERR(IRET)
2635  ! END IF
2636 
2637 #endif
2638  END DO
2639  !
2640  ! put START date in global attribute
2641  IF(fl_default_gbl_meta) THEN
2642  iret=nf90_put_att(ncid,nf90_global,'start_date',strstartdate)
2643  CALL check_err(iret)
2644  ENDIF
2645  !
2646  iret = nf90_enddef(ncid)
2647  CALL check_err(iret)
2648 
2649 
2650  ! 2.6 Append data to the existing file
2651 
2652  ELSE ! FEXIST
2653 
2654  ! 2.6.1 Get the dimensions from the netcdf header
2655 
2656  ! If it is an unstructured mesh
2657  IF (gtype.EQ.ungtype) THEN
2658  iret=nf90_inq_varid(ncid, 'tri', varid(4))
2659  CALL check_err(iret)
2660  ! If it is a regular grid
2661  ELSE
2662  ! If it is spherical coordinate
2663  IF (flagll) THEN
2664 #ifdef W3_SMC
2665  IF(smcgrd .AND. smcotype .EQ. 1) THEN
2666  iret=nf90_inq_dimid(ncid, 'seapoint', dimid(2))
2667  ELSE
2668 #endif
2669  iret=nf90_inq_dimid(ncid, 'longitude', dimid(2))
2670  iret=nf90_inq_dimid(ncid, 'latitude', dimid(3))
2671 #ifdef W3_SMC
2672  ENDIF
2673 #endif
2674  iret=nf90_inq_varid(ncid, 'longitude', varid(1))
2675  iret=nf90_inq_varid(ncid, 'latitude', varid(2))
2676  ! If it is cartesian coordinate
2677  ELSE
2678  iret=nf90_inq_dimid(ncid, 'x', dimid(2))
2679  iret=nf90_inq_varid(ncid, 'x', varid(1))
2680  iret=nf90_inq_dimid(ncid, 'y', dimid(3))
2681  iret=nf90_inq_varid(ncid, 'y', varid(2))
2682  END IF
2683  CALL check_err(iret)
2684  END IF
2685  ! Get the dimension time
2686  iret=nf90_inq_dimid(ncid, 'time', dimid(4+extradim))
2687  iret=nf90_inquire_dimension(ncid, dimid(4+extradim),len=n)
2688  CALL check_err(iret)
2689  iret=nf90_inq_varid(ncid, 'time', varid(3))
2690  IF( flgfc ) THEN
2691  iret = nf90_inq_varid(ncid, 'forecast_period', varid(11))
2692  CALL check_err(iret)
2693  ENDIF
2694  ! Get the dimension f
2695  IF (extradim.EQ.1) iret=nf90_inq_dimid(ncid, 'f', dimid(4))
2696 
2697  ! 2.6.2 Increments the time step for existing file
2698 
2699  ! If it is the first field of the file in mode together
2700  ! or NOT together or variable with freq dim (ef or p2l)
2701  ! ChrisBunney: Also - check IPART=TABIPART in case first
2702  ! requested output is a partitioned field.
2703  IF((together .AND. ifi.EQ.i1 .AND. ifj.EQ.j1 .AND. ipart.EQ.tabipart(1)) &
2704  .OR.(.NOT.together).OR.flfrq) n=n+1
2705 
2706  ! 2.6.3 Defines or gets the variables identifiers
2707 
2708  ! If it is the first time step, define all the variables and attributes
2709  IF (n.EQ.1) THEN
2710  iret = nf90_redef(ncid)
2711  CALL check_err(iret)
2712 
2713  ! Loops on all the fields of the variable (i.e. ucur/vcur for current)
2714  DO i=1,nfield
2715  ivar=ivar1+i
2716  IF (coordtype.EQ.1) THEN
2717  IF (ncvartype.EQ.2) THEN
2718 #ifdef W3_SMC
2719  IF( smcgrd .AND. smcotype .EQ. 1 ) THEN
2720  ! SMC Flat file
2721  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_short, (/dimid(2), dimid(4+extradim)/), varid(ivar))
2722  ELSE
2723 #endif
2724  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_short, dimid(2:4+extradim), varid(ivar))
2725 #ifdef W3_SMC
2726  ENDIF
2727 #endif
2728  CALL check_err(iret)
2729  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2730  ELSE
2731 #ifdef W3_SMC
2732  IF( smcgrd .AND. smcotype .EQ. 1 ) THEN
2733  ! SMC Flat file
2734  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_float, (/dimid(2), dimid(4+extradim)/), varid(ivar))
2735  ELSE
2736 #endif
2737  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_float, dimid(2:4+extradim), varid(ivar))
2738 #ifdef W3_SMC
2739  ENDIF
2740 #endif
2741  CALL check_err(iret)
2742  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2743  IF (nctype.EQ.4) CALL check_err(iret)
2744  END IF
2745  ELSE
2746  dimfield(1)=dimid(2)
2747  dimfield(2)=dimid(4)
2748  dimfield(3)=dimid(5)
2749  IF (ncvartype.EQ.2) THEN
2750  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_short, dimfield(1:2+extradim), varid(ivar))
2751  CALL check_err(iret)
2752  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2753  IF (nctype.EQ.4) CALL check_err(iret)
2754  ELSE
2755  iret = nf90_def_var(ncid,meta(i)%varnm, nf90_float, dimfield(1:2+extradim), varid(ivar))
2756  CALL check_err(iret)
2757  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(ivar), 1, 1, deflate)
2758  CALL check_err(iret)
2759  END IF
2760  END IF
2761  !
2762  ! Set scale factor to 1.0 if using FLOAT variables for output
2763  IF(ncvartype .GT. 2) meta(i)%FSC = 1.0
2764 
2765  !! CB - USE NEW W3META MODULE
2766  CALL write_meta(ncid, varid(ivar), meta(i), iret) ! CB
2767  CALL check_err(iret) ! CB
2768  !
2769  !! CHRISB: Commenting out below - will be handled by w3oundmeta module
2770 #ifdef W3_RTD
2771 
2772  ! IF ( RTDL ) THEN
2773  ! ! Add grid mapping attribute for rotated pole grids:
2774  ! IRET=NF90_PUT_ATT(NCID,VARID(IVAR),'grid_mapping', &
2775  ! 'rotated_pole')
2776  ! CALL CHECK_ERR(IRET)
2777  ! END IF
2778 
2779 #endif
2780  END DO
2781  iret = nf90_enddef(ncid)
2782  CALL check_err(iret)
2783 
2784  ! If it is not the first time step, get all VARID from the netcdf file opened
2785  ELSE
2786  iret=nf90_redef(ncid)
2787  CALL check_err(iret)
2788  DO i=1,nfield
2789  ! Get meta-data for field
2790  !META = GETMETA(IFI, IFJ, ICOMP=I, IPART=IPART)
2791  ivar=ivar1+i
2792  iret=nf90_inq_varid(ncid, meta(i)%VARNM, varid(ivar))
2793  CALL check_err(iret)
2794  END DO
2795  iret=nf90_enddef(ncid)
2796  CALL check_err(iret)
2797  END IF ! N.EQ.1
2798  END IF ! FEXIST
2799 
2800  ! 2.6.4 Defines the current time step and index
2801 
2802  CALL t2d(time,curdate,ierr)
2803  WRITE(ndso,'(A,A9,A,I6,A,I4,A,I2.2,A,I2.2,A,I2.2,A,I2.2,A,I2.2,2A)') &
2804  'Writing new record ', meta(1)%ENAME(2:) ,'number ',n, &
2805  ' for ',curdate(1),':',curdate(2),':',curdate(3),'T',curdate(5),&
2806  ':',curdate(6),':',curdate(7),' in file ',trim(fnamenc)
2807 
2808 
2809 
2810  ! Defines starting point and size of arrays to be written
2811  start(1)=1
2812  start(2)=1
2813  start(3)=1
2814  start(4)=1
2815 
2816  ! Sets time index
2817  start(3+1-coordtype+extradim)=n
2818  count(1)=ixn-ix1+1
2819  count(2)=iyn-iy1+1
2820  count(3)=1
2821  count(4)=1
2822  start1d(1)=1
2823  start1d(2)=n
2824  count1d(1)=ixn-ix1+1
2825  count1d(2)=1
2826 
2827  ! Puts time in NetCDF file
2828  IF((ifi.EQ.i1.AND.ifj.EQ.j1.AND.together) &
2829  .OR.(.NOT.together).OR.flfrq) THEN
2830  ivar1 = 21
2831 
2832  IF(timeunit .EQ. 'S') THEN
2833  ! Time in seconds
2834  outsecs = tsubsec(epochdate,curdate)
2835  iret = nf90_put_var(ncid, varid(3), outsecs, (/n/))
2836  ELSE
2837  ! Time in days
2838  outjulday = tsub(epochdate,curdate)
2839  iret = nf90_put_var(ncid, varid(3), outjulday, (/n/))
2840  ENDIF
2841  CALL check_err(iret)
2842 
2843  ! ChrisB: Calculate forecast period w.r.t. forecast reference time:
2844  IF (flgfc) THEN
2845  outsecs = tsubsec(refdate, curdate)
2846  iret = nf90_put_var(ncid, varid(11), outsecs, (/n/))
2847  CALL check_err(iret)
2848  ENDIF
2849  END IF
2850  !
2851  ! 2.6.5 Puts field(s) in NetCDF file
2852 
2853  ! NFIELD=3
2854  IF (ncvartype.EQ.2) THEN
2855  IF ( nfield.EQ.3 ) THEN
2856  DO ix=ix1, ixn
2857  DO iy=iy1, iyn
2858  IF ( x1(ix,iy) .EQ. undef ) THEN
2859  mxx(ix,iy) = mfill
2860  myy(ix,iy) = mfill
2861  mxy(ix,iy) = mfill
2862  ELSE
2863  mxx(ix,iy) = nint(x1(ix,iy)/meta(1)%FSC)
2864  myy(ix,iy) = nint(x2(ix,iy)/meta(2)%FSC)
2865  mxy(ix,iy) = nint(xy(ix,iy)/meta(3)%FSC)
2866  END IF
2867  END DO
2868  END DO
2869 #ifdef W3_SMC
2870  IF(smcgrd .AND. smcotype .EQ. 1) THEN
2871  iret=nf90_put_var(ncid,varid(ivar1+1), &
2872  mxx(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
2873  call check_err(iret)
2874  iret=nf90_put_var(ncid,varid(ivar1+2), &
2875  myy(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
2876  call check_err(iret)
2877  iret=nf90_put_var(ncid,varid(ivar1+3), &
2878  mxy(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
2879  call check_err(iret)
2880  ELSE
2881 #endif
2882  iret=nf90_put_var(ncid,varid(ivar1+1), &
2883  mxx(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
2884  call check_err(iret)
2885  iret=nf90_put_var(ncid,varid(ivar1+2), &
2886  myy(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
2887  call check_err(iret)
2888  iret=nf90_put_var(ncid,varid(ivar1+3), &
2889  mxy(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
2890  call check_err(iret)
2891 #ifdef W3_SMC
2892  ENDIF
2893 #endif
2894  ! NFIELD=2
2895  ELSE IF (nfield.EQ.2 ) THEN
2896  ! EXTRADIM=0
2897  IF (extradim.EQ.0) THEN
2898  DO ix=ix1, ixn
2899  DO iy=iy1, iyn
2900  IF ( xx(ix,iy) .EQ. undef ) THEN
2901  mxx(ix,iy) = mfill
2902  myy(ix,iy) = mfill
2903  ELSE
2904  mxx(ix,iy) = nint(xx(ix,iy)/meta(1)%FSC)
2905  myy(ix,iy) = nint(xy(ix,iy)/meta(2)%FSC)
2906  END IF
2907  END DO
2908  END DO
2909 #ifdef W3_SMC
2910  IF(smcgrd .AND. smcotype .EQ. 1) THEN
2911  iret=nf90_put_var(ncid,varid(ivar1+1), &
2912  mxx(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
2913  call check_err(iret)
2914  iret=nf90_put_var(ncid,varid(ivar1+2), &
2915  myy(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
2916  call check_err(iret)
2917  ELSE
2918 #endif
2919  iret=nf90_put_var(ncid,varid(ivar1+1), &
2920  mxx(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
2921  call check_err(iret)
2922  iret=nf90_put_var(ncid,varid(ivar1+2), &
2923  myy(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
2924  call check_err(iret)
2925 #ifdef W3_SMC
2926  ENDIF
2927 #endif
2928  ! EXTRADIM=1
2929  ELSE
2930  start(3+1-coordtype)=0
2931  DO ik=i1f,i2f
2932  start(3+1-coordtype)=start(3+1-coordtype)+1
2933  DO ix=ix1, ixn
2934  DO iy=iy1, iyn
2935  IF ( xxk(ix,iy,ik) .EQ. undef ) THEN
2936  mxx(ix,iy) = mfill
2937  myy(ix,iy) = mfill
2938  ELSE
2939  mxx(ix,iy) = nint(xxk(ix,iy,ik)/meta(1)%FSC)
2940  myy(ix,iy) = nint(xyk(ix,iy,ik)/meta(2)%FSC)
2941  END IF
2942  END DO
2943  END DO
2944 #ifdef W3_SMC
2945  IF(smcgrd .AND. smcotype .EQ. 1) THEN
2946  iret=nf90_put_var(ncid,varid(ivar1+1), &
2947  mxx(ix1:ixn,iy1:iyn),(/start(1), start(3), start(4)/), &
2948  (/count(1), count(3), count(4)/))
2949  call check_err(iret)
2950  iret=nf90_put_var(ncid,varid(ivar1+2), &
2951  mxy(ix1:ixn,iy1:iyn),(/start(1), start(3), start(4)/), &
2952  (/count(1), count(3), count(4)/))
2953  call check_err(iret)
2954  ELSE
2955 #endif
2956  iret=nf90_put_var(ncid,varid(ivar1+1), &
2957  mxx(ix1:ixn,iy1:iyn),(/start(1:4)/),(/count(1:4)/))
2958  call check_err(iret)
2959  iret=nf90_put_var(ncid,varid(ivar1+2), &
2960  mxx(ix1:ixn,iy1:iyn),(/start(1:4)/),(/count(1:4)/))
2961  call check_err(iret)
2962 #ifdef W3_SMC
2963  ENDIF
2964 #endif
2965  END DO
2966  END IF ! EXTRADIM
2967  ! NFIELD=1
2968  ELSE
2969  ! EXTRADIM=0
2970  IF (extradim.EQ.0) THEN
2971  DO ix=ix1, ixn
2972  DO iy=iy1, iyn
2973  IF ( x1(ix,iy) .EQ. undef ) THEN
2974  mx1(ix,iy) = mfill
2975  ELSE
2976  mx1(ix,iy) = nint(x1(ix,iy)/meta(1)%FSC)
2977  END IF
2978  END DO
2979  END DO
2980 #ifdef W3_SMC
2981  IF(smcgrd .AND. smcotype .EQ. 1) THEN
2982  iret=nf90_put_var(ncid,varid(ivar1+1), &
2983  mx1(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
2984  call check_err(iret)
2985  ELSE
2986 #endif
2987  iret=nf90_put_var(ncid,varid(ivar1+1), &
2988  mx1(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
2989  call check_err(iret)
2990 #ifdef W3_SMC
2991  ENDIF
2992 #endif
2993  ! EXTRADIM=1
2994  ELSE
2995  start(3+1-coordtype)=0
2996  DO ik=i1f,i2f
2997  start(3+1-coordtype)=start(3+1-coordtype)+1
2998  DO ix=ix1, ixn
2999  DO iy=iy1, iyn
3000  IF ( xk(ix,iy,ik) .EQ. undef ) THEN
3001  mx1(ix,iy) = mfill
3002  ELSE
3003  mx1(ix,iy) = nint(xk(ix,iy,ik)/meta(1)%FSC)
3004  END IF
3005  END DO
3006  END DO
3007 #ifdef W3_SMC
3008  IF(smcgrd .AND. smcotype .EQ. 1) THEN
3009  iret=nf90_put_var(ncid,varid(ivar1+1), &
3010  mx1(ix1:ixn,iy1:iyn),(/start(1), start(3), start(4)/), &
3011  (/count(1), count(3), count(4)/))
3012  call check_err(iret)
3013  ELSE
3014 #endif
3015  iret=nf90_put_var(ncid,varid(ivar1+1), &
3016  mx1(ix1:ixn,iy1:iyn),(/start(1:4)/),(/count(1:4)/))
3017  call check_err(iret)
3018 #ifdef W3_SMC
3019  ENDIF
3020 #endif
3021  END DO
3022  END IF ! EXTRADIM
3023  END IF ! NFIELD
3024  !
3025  ! Real output (NCVARTYPE.GE.3)
3026  !
3027  ELSE
3028  IF ( nfield.EQ.3 ) THEN
3029  DO ix=ix1, ixn
3030  DO iy=iy1, iyn
3031  IF ( x1(ix,iy) .EQ. undef ) THEN
3032  mxxr(ix,iy) = mfillr
3033  myyr(ix,iy) = mfillr
3034  mxyr(ix,iy) = mfillr
3035  ELSE
3036  mxxr(ix,iy) = x1(ix,iy)
3037  myyr(ix,iy) = x2(ix,iy)
3038  mxyr(ix,iy) = xy(ix,iy)
3039  END IF
3040  END DO
3041  END DO
3042 #ifdef W3_SMC
3043  IF(smcgrd .AND. smcotype .EQ. 1) THEN
3044  iret=nf90_put_var(ncid,varid(ivar1+1), &
3045  mxxr(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
3046  call check_err(iret)
3047  iret=nf90_put_var(ncid,varid(ivar1+2), &
3048  myyr(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
3049  call check_err(iret)
3050  iret=nf90_put_var(ncid,varid(ivar1+3), &
3051  mxyr(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
3052  call check_err(iret)
3053  ELSE
3054 #endif
3055  iret=nf90_put_var(ncid,varid(ivar1+1), &
3056  mxxr(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
3057  call check_err(iret)
3058  iret=nf90_put_var(ncid,varid(ivar1+2), &
3059  myyr(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
3060  call check_err(iret)
3061  iret=nf90_put_var(ncid,varid(ivar1+3), &
3062  mxyr(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
3063  call check_err(iret)
3064 #ifdef W3_SMC
3065  ENDIF
3066 #endif
3067  ! NFIELD=2
3068  ELSE IF (nfield.EQ.2 ) THEN
3069  ! EXTRADIM=0
3070  IF (extradim.EQ.0) THEN
3071  DO ix=ix1, ixn
3072  DO iy=iy1, iyn
3073  IF ( xx(ix,iy) .EQ. undef ) THEN
3074  mxxr(ix,iy) = mfillr
3075  myyr(ix,iy) = mfillr
3076  ELSE
3077  mxxr(ix,iy) = xx(ix,iy)
3078  myyr(ix,iy) = xy(ix,iy)
3079  END IF
3080  END DO
3081  END DO
3082 #ifdef W3_SMC
3083  IF(smcgrd .AND. smcotype .EQ. 1) THEN
3084  iret=nf90_put_var(ncid,varid(ivar1+1), &
3085  mxxr(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
3086  call check_err(iret)
3087  iret=nf90_put_var(ncid,varid(ivar1+2), &
3088  myyr(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
3089  call check_err(iret)
3090  ELSE
3091 #endif
3092  iret=nf90_put_var(ncid,varid(ivar1+1), &
3093  mxxr(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
3094  call check_err(iret)
3095  iret=nf90_put_var(ncid,varid(ivar1+2), &
3096  myyr(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
3097  call check_err(iret)
3098 #ifdef W3_SMC
3099  ENDIF
3100 #endif
3101  ! EXTRADIM=1
3102  ELSE
3103  start(4-coordtype)=0
3104  DO ik=i1f,i2f
3105  start(4-coordtype)=start(4-coordtype)+1
3106  DO ix=ix1, ixn
3107  DO iy=iy1, iyn
3108  IF ( xxk(ix,iy,ik) .EQ. undef ) THEN
3109  mxxr(ix,iy) = mfillr
3110  myyr(ix,iy) = mfillr
3111  ELSE
3112  mxxr(ix,iy) = xxk(ix,iy,ik)
3113  myyr(ix,iy) = xyk(ix,iy,ik)
3114  END IF
3115  END DO
3116  END DO
3117 #ifdef W3_SMC
3118  IF(smcgrd .AND. smcotype .EQ. 1) THEN
3119  iret=nf90_put_var(ncid,varid(ivar1+1), &
3120  mxxr(ix1:ixn,iy1:iyn),(/start(1), start(3), start(4)/), &
3121  (/count(1), count(3), count(4)/))
3122  call check_err(iret)
3123  iret=nf90_put_var(ncid,varid(ivar1+2), &
3124  myyr(ix1:ixn,iy1:iyn),(/start(1), start(3), start(4)/), &
3125  (/count(1), count(3), count(4)/))
3126  call check_err(iret)
3127  ELSE
3128 #endif
3129  iret=nf90_put_var(ncid,varid(ivar1+1), &
3130  mxxr(ix1:ixn,iy1:iyn),(/start(1:4)/),(/count(1:4)/))
3131  call check_err(iret)
3132  iret=nf90_put_var(ncid,varid(ivar1+2), &
3133  myyr(ix1:ixn,iy1:iyn),(/start(1:4)/),(/count(1:4)/))
3134  call check_err(iret)
3135 #ifdef W3_SMC
3136  ENDIF
3137 #endif
3138  END DO
3139  END IF ! EXTRADIM
3140  ! NFIELD=1
3141  ELSE
3142  ! EXTRADIM=0
3143  IF (extradim.EQ.0) THEN
3144  DO ix=ix1, ixn
3145  DO iy=iy1, iyn
3146  IF ( x1(ix,iy) .EQ. undef ) THEN
3147  mx1r(ix,iy) = mfillr
3148  ELSE
3149  mx1r(ix,iy) = x1(ix,iy)
3150  END IF
3151  END DO
3152  END DO
3153 #ifdef W3_SMC
3154  IF(smcgrd .AND. smcotype .EQ. 1) THEN
3155  iret=nf90_put_var(ncid,varid(ivar1+1), &
3156  mx1r(ix1:ixn,iy1:iyn),(/start(1), start(3)/),(/count(1), count(3)/))
3157  call check_err(iret)
3158  ELSE
3159 #endif
3160  iret=nf90_put_var(ncid,varid(ivar1+1), &
3161  mx1r(ix1:ixn,iy1:iyn),(/start(1:3)/),(/count(1:3)/))
3162  call check_err(iret)
3163 #ifdef W3_SMC
3164  ENDIF
3165 #endif
3166  ! EXTRADIM=1
3167  ELSE
3168  start(4-coordtype)=0
3169  DO ik=i1f,i2f
3170  start(4-coordtype)=start(4-coordtype)+1
3171  DO ix=ix1, ixn
3172  DO iy=iy1, iyn
3173  IF ( xk(ix,iy,ik) .EQ. undef ) THEN
3174  mx1r(ix,iy) = mfillr
3175  ELSE
3176  mx1r(ix,iy) = xk(ix,iy,ik)
3177  END IF
3178  END DO
3179  END DO
3180 #ifdef W3_SMC
3181  IF(smcgrd .AND. smcotype .EQ. 1) THEN
3182  iret=nf90_put_var(ncid,varid(ivar1+1), &
3183  mx1r(ix1:ixn,iy1:iyn),(/start(1), start(3), start(4)/), &
3184  (/count(1), count(3), count(4)/))
3185  call check_err(iret)
3186  ELSE
3187 #endif
3188  iret=nf90_put_var(ncid,varid(ivar1+1), &
3189  mx1r(ix1:ixn,iy1:iyn),(/start(1:4)/),(/count(1:4)/))
3190  call check_err(iret)
3191 #ifdef W3_SMC
3192  ENDIF
3193 #endif
3194  END DO
3195  END IF ! EXTRADIM
3196  END IF ! NFIELD
3197  END IF ! NCVARTYPE
3198 
3199  ! updates the variable index
3200  ivar1=ivar1+nfield
3201 
3202 
3203  ! Loops over IPART for partition variables
3204  ! ChrisBunney: Don't loop IPART for last two entries in section 4
3205  ! (16: total wind sea fraction, 17: number of parts) as these fields
3206  ! do not have partitions.
3207  IF (ifi .EQ. 4 .AND. ifj .LE. noge(ifi) - 2) THEN
3208 560 CONTINUE
3209  IF (indexipart.LT.nbipart) THEN
3210  indexipart=indexipart+1
3211  IF (tabipart(indexipart).EQ.-1) GOTO 560
3212  ipart=tabipart(indexipart)
3213  GOTO 555
3214  END IF
3215  ELSE
3216  indexipart=1
3217  END IF
3218  !
3219  END IF ! FLG2D(IFI,IFJ)
3220  END DO ! IFI=1, NOGRP
3221  END DO ! IFJ=1, NGRPP
3222  !
3223  ! Clean up
3224  DEALLOCATE(x1, x2, xx, xy, xk, xxk, xyk)
3225  DEALLOCATE(mx1, mxx, myy, mxy, mapout)
3226  DEALLOCATE(mx1r, mxxr, myyr, mxyr)
3227  DEALLOCATE(aux1)
3228  IF (ALLOCATED(lon)) DEALLOCATE(lon, lat)
3229  IF (ALLOCATED(lon2d)) DEALLOCATE(lon2d, lat2d)
3230 #ifdef W3_RTD
3231  IF (ALLOCATED(lon2deq)) DEALLOCATE(lat2deq, lon2deq, angld2d)
3232 #endif
3233  !
3234  RETURN
3235  !
3236  ! Error escape locations
3237  !
3238 
3239  !
3240  ! Formats
3241  !
3242 973 FORMAT ( 'NEW NETCDF FILE WAS CREATED ',a)
3243 999 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXNC :'/ &
3244  ' PLEASE UPDATE FIELDS !!! '/ &
3245  ' IFI = ',i2, '- IFJ = ',i2/)
3246  !
3247 #ifdef W3_T
3248 9000 FORMAT (' TEST W3EXNC : FLAGS :',i3,2x,20l2)
3249 9001 FORMAT (' TEST W3EXNC : ITPYE :',i4/ &
3250  ' IX1/N :',2i7/ &
3251  ' IY1/N :',2i7/ &
3252  ' VECTOR :',1l2)
3253 #endif
3254  !
3255 #ifdef W3_T
3256 9012 FORMAT (' TEST W3EXNC : BLOK PARS : ',3i4)
3257 9014 FORMAT (' BASE NAME : ',a)
3258 #endif
3259  !
3260 #ifdef W3_T
3261 9020 FORMAT (' TEST W3EXNC : OUTPUT FIELD : ',a)
3262 #endif
3263  !/
3264 
3265 
3266 
3267  !/ End of W3EXNC ----------------------------------------------------- /
3268  !/
3269  END SUBROUTINE w3exnc
3270 
3271 
3272 
3273 
3274  !--------------------------------------------------------------------------
3288  SUBROUTINE w3crnc (NCFILE, NCID, DIMID, DIMLN, VARID, &
3289  EXTRADIM, NCTYPE, MAPSTAOUT )
3290  !
3291  USE w3gdatmd, ONLY : gtype, flagll, ungtype, clgtype, rlgtype
3292 #ifdef W3_RTD
3293  ! Rotated pole parameters from the mod_def file
3294  USE w3gdatmd, ONLY : polat, polon
3295 #endif
3296  USE netcdf
3297  USE w3timemd
3298 
3299  IMPLICIT NONE
3300 
3301 
3302 
3303  INTEGER, INTENT(IN) :: EXTRADIM
3304  INTEGER, INTENT(IN) :: NCTYPE
3305  CHARACTER*(*), INTENT(IN) :: NCFILE
3306  INTEGER, INTENT(OUT) :: NCID
3307  INTEGER, INTENT(OUT) :: DIMID(6)
3308  INTEGER, INTENT(IN) :: DIMLN(6)
3309  INTEGER, INTENT(OUT) :: VARID(300)
3310  LOGICAL, INTENT(IN) :: MAPSTAOUT
3311  !
3312  !/ ------------------------------------------------------------------- /
3313  ! Local parameters
3314  !
3315  INTEGER :: IVAR,IRET,ICODE,STRL,STRL2
3316  INTEGER :: DIMTRI(2)
3317  INTEGER :: DEFLATE=1
3318  !
3319  CHARACTER :: ATTNAME*120,ATTVAL*120
3320  !
3321  coords_attr = ''
3322  !
3323  ! Creation in netCDF3 or netCDF4
3324  !
3325  IF(nctype.EQ.3) iret = nf90_create(trim(ncfile), nf90_clobber, ncid)
3326  IF(nctype.EQ.4) iret = nf90_create(trim(ncfile), nf90_netcdf4, ncid)
3327  CALL check_err(iret)
3328  !
3329  ! Define dimensions
3330  !
3331  iret = nf90_def_dim(ncid, 'level', dimln(1), dimid(1))
3332 
3333  !
3334  ! Regular structured case
3335  !
3336  IF (gtype.NE.ungtype) THEN
3337  IF (flagll) THEN
3338 #ifdef W3_SMC
3339  IF(smcgrd .AND. smcotype .EQ. 1) THEN
3340  ! Flat seapoints file
3341  iret = nf90_def_dim(ncid, 'seapoint', dimln(2), dimid(2))
3342  ELSE
3343 #endif
3344  ! Regular gridded file:
3345  iret = nf90_def_dim(ncid, 'longitude', dimln(2), dimid(2))
3346  iret = nf90_def_dim(ncid, 'latitude', dimln(3), dimid(3))
3347 #ifdef W3_SMC
3348  ENDIF
3349 #endif
3350  ELSE
3351  iret = nf90_def_dim(ncid, 'x', dimln(2), dimid(2))
3352  iret = nf90_def_dim(ncid, 'y', dimln(3), dimid(3))
3353  END IF
3354  CALL check_err(iret)
3355  !
3356  ! Unstructured case
3357  !
3358  ELSE
3359  iret = nf90_def_dim(ncid, 'node', dimln(2), dimid(2))
3360  iret = nf90_def_dim(ncid, 'element', dimln(3), dimid(3))
3361  CALL check_err(iret)
3362  ENDIF
3363  !
3364  !
3365 
3366 
3367  IF (extradim.EQ.1) THEN
3368  iret = nf90_def_dim(ncid, 'f', dimln(4), dimid(4))
3369  CALL check_err(iret)
3370  ENDIF
3371 
3372  iret = nf90_def_dim(ncid, 'time',nf90_unlimited, dimid(4+extradim))
3373  CALL check_err(iret)
3374 
3375  IF (gtype.EQ.ungtype) THEN
3376  iret = nf90_def_dim(ncid, 'noel',3, dimid(5+extradim))
3377  CALL check_err(iret)
3378  ENDIF
3379 
3380 
3381  !
3382  ! define variables
3383  !
3384  IF (flagll) THEN
3385  !longitude
3386  IF (gtype.EQ.rlgtype .OR. gtype.EQ.smctype) THEN
3387  IF (smcgrd) THEN
3388 #ifdef W3_SMC
3389  IF(smcotype .EQ. 1) THEN
3390  ! Flat SMC grid - use seapoint dimension:
3391  iret = nf90_def_var(ncid, 'longitude', nf90_float, dimid(2), varid(1))
3392  CALL check_err(iret)
3393  iret = nf90_def_var(ncid, 'latitude', nf90_float, dimid(2), varid(2))
3394  CALL check_err(iret)
3395 
3396  ! Latitude and longitude are auxililary variables in type 1 sea point
3397  ! SMC file; add to "coordinates" attribute:
3398  coords_attr = trim(coords_attr) // " latitude longitude"
3399 
3400  ! For seapoint style SMC grid, also define out cell size variables:
3401  iret = nf90_def_var(ncid, 'cx', nf90_short, dimid(2), varid(5))
3402  CALL check_err(iret)
3403  iret = nf90_put_att(ncid, varid(5), 'long_name', &
3404  'longitude cell size factor')
3405  iret = nf90_put_att(ncid, varid(5), 'valid_min', 1)
3406  iret = nf90_put_att(ncid, varid(5), 'valid_max', 256)
3407 
3408  iret = nf90_def_var(ncid, 'cy', nf90_short, dimid(2), varid(6))
3409  call check_err(iret)
3410  iret = nf90_put_att(ncid, varid(6), 'long_name', &
3411  'latitude cell size factor')
3412  iret = nf90_put_att(ncid, varid(6), 'valid_min', 1)
3413  iret = nf90_put_att(ncid, varid(6), 'valid_max', 256)
3414  ELSE
3415  ! Regirdded regular SMC grid - use lon/lat dimensions:
3416  iret = nf90_def_var(ncid, 'longitude', nf90_float, dimid(2), varid(1))
3417  call check_err(iret)
3418  iret = nf90_def_var(ncid, 'latitude', nf90_float, dimid(3), varid(2))
3419  call check_err(iret)
3420  ENDIF
3421 #endif
3422  ELSE
3423  iret = nf90_def_var(ncid, 'longitude', nf90_float, dimid(2), varid(1))
3424  iret = nf90_def_var(ncid, 'latitude', nf90_float, dimid(3), varid(2))
3425  ENDIF ! SMCGRD
3426  ELSE IF (gtype.EQ.clgtype) THEN
3427  iret = nf90_def_var(ncid, 'longitude', nf90_float, (/ dimid(2), dimid(3)/), &
3428  varid(1))
3429  iret = nf90_def_var(ncid, 'latitude', nf90_float, (/ dimid(2), dimid(3)/), &
3430  varid(2))
3431  ELSE
3432  iret = nf90_def_var(ncid, 'longitude', nf90_float, dimid(2), varid(1))
3433  iret = nf90_def_var(ncid, 'latitude', nf90_float, dimid(2), varid(2))
3434  END IF
3435  iret=nf90_put_att(ncid,varid(1),'units','degree_east')
3436 #ifdef W3_RTD
3437  ! Is the grid really rotated
3438  IF ( .NOT. rtdl ) THEN
3439 #endif
3440  iret=nf90_put_att(ncid,varid(1),'long_name','longitude')
3441  iret=nf90_put_att(ncid,varid(1),'standard_name','longitude')
3442 #ifdef W3_RTD
3443  ELSE
3444  ! Override the above for RTD pole:
3445  iret=nf90_put_att(ncid,varid(1),'long_name','longitude in rotated pole grid')
3446  iret=nf90_put_att(ncid,varid(1),'standard_name','grid_longitude')
3447  END IF
3448 #endif
3449  iret=nf90_put_att(ncid,varid(1),'valid_min',-180.0)
3450  iret=nf90_put_att(ncid,varid(1),'valid_max',360.)
3451  !
3452  iret=nf90_put_att(ncid,varid(2),'units','degree_north')
3453 #ifdef W3_RTD
3454  IF ( .NOT. rtdl ) THEN
3455 #endif
3456  iret=nf90_put_att(ncid,varid(2),'long_name','latitude')
3457  iret=nf90_put_att(ncid,varid(2),'standard_name','latitude')
3458 #ifdef W3_RTD
3459  ELSE
3460  ! Override the above for RTD pole:
3461  iret=nf90_put_att(ncid,varid(2),'long_name','latitude in rotated pole grid')
3462  iret=nf90_put_att(ncid,varid(2),'standard_name','grid_latitude')
3463  END IF
3464 #endif
3465  iret=nf90_put_att(ncid,varid(2),'valid_min',-90.0)
3466  iret=nf90_put_att(ncid,varid(2),'valid_max',90.)
3467  !
3468  IF(smcgrd) THEN
3469 #ifdef W3_SMC
3470  IF(smcotype .EQ. 1) THEN
3471 #endif
3472 #ifdef W3_RTD
3473  IF ( rtdl ) THEN
3474  ! For SMC grid type 1, standard lat/lon variables are 1D:
3475  iret = nf90_def_var(ncid, 'standard_longitude', nf90_float, &
3476  (/ dimid(2) /), varid(7))
3477  call check_err(iret)
3478 
3479  iret = nf90_def_var(ncid, 'standard_latitude', nf90_float, &
3480  (/ dimid(2) /), varid(8))
3481  call check_err(iret)
3482  ENDIF ! RTDL
3483 #endif
3484 #ifdef W3_SMC
3485  ELSE
3486 #endif
3487 #ifdef W3_RTD
3488  IF ( rtdl ) THEN
3489  iret = nf90_def_var(ncid, 'standard_longitude', nf90_float, &
3490  (/ dimid(2), dimid(3)/), varid(7))
3491  call check_err(iret)
3492 
3493  iret = nf90_def_var(ncid, 'standard_latitude', nf90_float, &
3494  (/ dimid(2), dimid(3)/), varid(8))
3495  call check_err(iret)
3496  ENDIF ! RTDL
3497 #endif
3498 #ifdef W3_SMC
3499  ENDIF
3500 #endif
3501  ELSE
3502 #ifdef W3_RTD
3503  IF ( rtdl ) THEN
3504  !Add secondary coordinate system linking rotated grid back to standard lat-lon
3505  iret = nf90_def_var(ncid, 'standard_longitude', nf90_float, (/ dimid(2), dimid(3)/), &
3506  varid(7))
3507  call check_err(iret)
3508 
3509  iret = nf90_def_var(ncid, 'standard_latitude', nf90_float, (/ dimid(2), dimid(3)/), &
3510  varid(8))
3511  call check_err(iret)
3512  END IF
3513 #endif
3514  ENDIF ! SMCGRD
3515 #ifdef W3_RTD
3516 
3517  IF ( rtdl ) THEN
3518  ! Attributes for standard_longitude:
3519  iret=nf90_put_att(ncid,varid(7),'units','degree_east')
3520  iret=nf90_put_att(ncid,varid(7),'long_name','longitude')
3521  iret=nf90_put_att(ncid,varid(7),'standard_name','longitude')
3522  iret=nf90_put_att(ncid,varid(7),'valid_min',-180.0)
3523  iret=nf90_put_att(ncid,varid(7),'valid_max',360.)
3524 
3525  ! Attributes for standard_latitude:
3526  iret=nf90_put_att(ncid,varid(8),'units','degree_north')
3527  iret=nf90_put_att(ncid,varid(8),'long_name','latitude')
3528  iret=nf90_put_att(ncid,varid(8),'standard_name','latitude')
3529  iret=nf90_put_att(ncid,varid(8),'valid_min',-90.0)
3530  iret=nf90_put_att(ncid,varid(8),'valid_max',90.)
3531 
3532  ! Add rotated pole grid mapping variable (dummy scalar variable
3533  ! used to simply store rotated pole information; see CF1.6 conventions).
3534  ! TODO: FUTURE WW3_OUNF DEVELOPMENT WILL ALLOW USER TO DEFINE THE
3535  ! COORDINATE REFERENCE SYSTEM - THIS WILL REQUIRE THE BELOW TO BE
3536  ! HANDLED DIFFERENTLY. C. Bunney.
3537 #endif
3538 
3539  !! CHRISB: Commenting out below - will be handled by w3oundmeta module
3540 #ifdef W3_RTD
3541  !!IRET=NF90_DEF_VAR(NCID, 'rotated_pole', NF90_CHAR, VARID(12))
3542  !!IRET=NF90_PUT_ATT(NCID, VARID(12), 'grid_north_pole_latitude',POLAT)
3543  !!IRET=NF90_PUT_ATT(NCID, VARID(12), 'grid_north_pole_longitude',POLON)
3544  !!IRET=NF90_PUT_ATT(NCID, VARID(12), 'grid_mapping_name', &
3545  !! 'rotated_latitude_longitude')
3546  END IF
3547 #endif
3548  !
3549  ELSE
3550  IF (gtype.EQ.rlgtype) THEN
3551  iret = nf90_def_var(ncid, 'x', nf90_float, dimid(2), varid(1))
3552  iret = nf90_def_var(ncid, 'y', nf90_float, dimid(3), varid(2))
3553  ELSE IF (gtype.EQ.clgtype) THEN
3554  iret = nf90_def_var(ncid, 'x', nf90_float, (/ dimid(2), dimid(3)/), &
3555  varid(1))
3556  iret = nf90_def_var(ncid, 'y', nf90_float, (/ dimid(2), dimid(3)/), &
3557  varid(2))
3558  ELSE
3559  iret = nf90_def_var(ncid, 'x', nf90_float, dimid(2), varid(1))
3560  iret = nf90_def_var(ncid, 'y', nf90_float, dimid(2), varid(2))
3561  END IF
3562  !
3563  iret=nf90_put_att(ncid,varid(1),'units','m')
3564  iret=nf90_put_att(ncid,varid(1),'long_name','x')
3565  iret=nf90_put_att(ncid,varid(2),'units','m')
3566  iret=nf90_put_att(ncid,varid(2),'long_name','y')
3567  !
3568  END IF ! FLAGLL
3569  !
3570  iret=nf90_put_att(ncid,varid(1),'axis','X')
3571  iret=nf90_put_att(ncid,varid(2),'axis','Y')
3572  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(1), 1, 1, deflate)
3573  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(2), 1, 1, deflate)
3574 
3575  !
3576  ! frequency
3577  !
3578  if (extradim.EQ.1) THEN
3579  iret = nf90_def_var(ncid, 'f', nf90_float, dimid(4), varid(10))
3580  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(10), 1, 1, deflate)
3581  CALL check_err(iret)
3582  iret=nf90_put_att(ncid,varid(10),'long_name','wave_frequency')
3583  CALL check_err(iret)
3584  iret=nf90_put_att(ncid,varid(10),'standard_name','wave_frequency')
3585  CALL check_err(iret)
3586  iret=nf90_put_att(ncid,varid(10),'units','s-1')
3587  CALL check_err(iret)
3588  iret=nf90_put_att(ncid,varid(10),'axis','Hz')
3589  CALL check_err(iret)
3590  END IF
3591 
3592 
3593  !
3594  ! time
3595  !
3596  ! CHRISB: Allow different time variable types:
3597  iret = nf90_def_var(ncid, 'time', tvartype, dimid(4+extradim), varid(3))
3598  CALL check_err(iret)
3599  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(3), 1, 1, deflate)
3600  CALL check_err(iret)
3601  SELECT CASE (trim(caltype))
3602  CASE ('360_day')
3603  iret=nf90_put_att(ncid,varid(3),'long_name','time in 360 day calendar')
3604  CASE ('365_day')
3605  iret=nf90_put_att(ncid,varid(3),'long_name','time in 365 day calendar')
3606  CASE ('standard')
3607  !IRET=NF90_PUT_ATT(NCID,VARID(3),'long_name','julian day (UT)') ! CB
3608  iret=nf90_put_att(ncid,varid(3),'long_name','time')
3609  END SELECT
3610  CALL check_err(iret)
3611  iret=nf90_put_att(ncid,varid(3),'standard_name','time')
3612  CALL check_err(iret)
3613  ! CHRISB: Allow alternative time units:
3614  !IRET=NF90_PUT_ATT(NCID,VARID(3),'units','days since 1990-01-01 00:00:00')
3615  iret=nf90_put_att(ncid,varid(3),'units', epoch)
3616  CALL check_err(iret)
3617  ! CHRISB: Not sure this is useful - required information is in "units"
3618  !IRET=NF90_PUT_ATT(NCID,VARID(3),'conventions', &
3619  ! 'relative julian days with decimal part (as parts of the day )')
3620  iret=nf90_put_att(ncid,varid(3),'axis','T')
3621  CALL check_err(iret)
3622  iret=nf90_put_att(ncid,varid(3),'calendar',trim(caltype))
3623  CALL check_err(iret)
3624  !
3625  ! forecast period and (forecast reference time), if requested
3626  !
3627  IF (flgfc) THEN
3628  iret = nf90_def_var(ncid, 'forecast_period', nf90_int, &
3629  dimid(4+extradim), varid(11))
3630  CALL check_err(iret)
3631  iret = nf90_put_att(ncid, varid(11), 'long_name', &
3632  'forecast period')
3633  CALL check_err(iret)
3634  iret = nf90_put_att(ncid, varid(11), 'standard_name', &
3635  'forecast_period')
3636  CALL check_err(iret)
3637  iret = nf90_put_att(ncid, varid(11), 'units', 's')
3638  CALL check_err(iret)
3639 
3640  ! Forecast reference time is a scalar variable:
3641  iret = nf90_def_var(ncid, 'forecast_reference_time', &
3642  tvartype, varid=varid(12))
3643  CALL check_err(iret)
3644 
3645  iret = nf90_put_att(ncid, varid(12), 'long_name', &
3646  'forecast reference time')
3647  CALL check_err(iret)
3648 
3649  iret = nf90_put_att(ncid, varid(12), 'standard_name', &
3650  'forecast_reference_time')
3651  CALL check_err(iret)
3652 
3653  iret = nf90_put_att(ncid, varid(12), 'units', epoch)
3654  ! 'days since 1990-01-01 00:00:00')
3655  CALL check_err(iret)
3656 
3657  iret = nf90_put_att(ncid, varid(12), 'calendar', 'gregorian')
3658  CALL check_err(iret)
3659 
3660  ! Add these to auxiliary coordinates list:
3661  coords_attr = trim(coords_attr) // " forecast_period forecast_reference_time"
3662  ENDIF
3663  !
3664  ! triangles for irregular grids
3665  !
3666  IF (gtype.EQ.ungtype) THEN
3667  dimtri(1)=dimid(4+extradim+1)
3668  dimtri(2)=dimid(3)
3669  iret = nf90_def_var(ncid, 'tri', nf90_int, dimtri, varid(4))
3670  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(4), 1, 1, deflate)
3671  END IF
3672  !
3673  ! Status map: useful for grid combination
3674  !
3675  IF (mapstaout) THEN
3676  IF (gtype.EQ.ungtype) THEN
3677  iret = nf90_def_var(ncid,'MAPSTA', nf90_short,(/ dimid(2) /), varid(20))
3678  ELSE
3679  iret = nf90_def_var(ncid,'MAPSTA', nf90_short,(/ dimid(2) , dimid(3) /), &
3680  varid(20))
3681  ENDIF
3682  IF (nctype.EQ.4) iret = nf90_def_var_deflate(ncid, varid(20), 1, 1, deflate)
3683  !
3684  iret=nf90_put_att(ncid,varid(20),'long_name','status map')
3685  iret=nf90_put_att(ncid,varid(20),'standard_name','status map')
3686  iret=nf90_put_att(ncid,varid(20),'units','1')
3687  CALL check_err(iret)
3688  iret=nf90_put_att(ncid,varid(20),'valid_min',-32)
3689  CALL check_err(iret)
3690  iret=nf90_put_att(ncid,varid(20),'valid_max',32)
3691  CALL check_err(iret)
3692  END IF
3693  !
3694  ! Optional (user-defined) coordinate reference system (scalar variable)
3695  !
3696  IF(crs_meta%N .GT. 0) THEN
3697  iret = nf90_def_var(ncid, crs_name, nf90_char, varid=ivar)
3698  CALL check_err(iret)
3699 
3700  !CALL WRITE_FREEFORM_META(NCID, IVAR, CRS_META, N_CRSMETA, IERR)
3701  CALL write_freeform_meta_list(ncid, ivar, crs_meta, ierr)
3702  CALL check_err(iret)
3703  ENDIF
3704  !
3705  ! Global attributes
3706  !
3707  IF(fl_default_gbl_meta) THEN
3708  iret=nf90_put_att(ncid,nf90_global,'WAVEWATCH_III_version_number' ,trim(wwver))
3709  CALL check_err(iret)
3710  iret=nf90_put_att(ncid,nf90_global,'WAVEWATCH_III_switches',trim(switches))
3711  CALL check_err(iret)
3712 #ifdef W3_ST4
3713  IF (zzwnd.NE.10) iret=nf90_put_att(ncid,nf90_global,'SIN4 namelist parameter ZWD',zzwnd)
3714  IF (aalpha.NE.0.0095) iret=nf90_put_att(ncid,nf90_global,'SIN4 namelist parameter ALPHA0',aalpha)
3715  IF (bbeta.NE.1.43) iret=nf90_put_att(ncid,nf90_global,'SIN4 namelist parameter BETAMAX',bbeta)
3716  IF(ssdsc(7).NE.0.3) iret=nf90_put_att(ncid,nf90_global,'SDS4 namelist parameter WHITECAPWIDTH', ssdsc(7))
3717 #endif
3718  ! ... TO BE CONTINUED ...
3719 
3720  IF(smcgrd) THEN
3721 #ifdef W3_SMC
3722  IF(smcotype .EQ. 1) THEN
3723  iret = nf90_put_att(ncid, nf90_global, 'first_lat', y0)
3724  call check_err(iret)
3725  iret = nf90_put_att(ncid, nf90_global, 'first_lon', x0)
3726  call check_err(iret)
3727  iret = nf90_put_att(ncid, nf90_global, 'base_lat_size', dlat)
3728  call check_err(iret)
3729  iret = nf90_put_att(ncid, nf90_global, 'base_lon_size', dlon)
3730  call check_err(iret)
3731  iret=nf90_put_att(ncid,nf90_global,'SMC_grid_type','seapoint')
3732  call check_err(iret)
3733  ELSE IF(smcotype .EQ. 2) THEN
3734  iret=nf90_put_att(ncid,nf90_global,'SMC_grid_type','regular_regridded')
3735  call check_err(iret)
3736  ENDIF
3737 #endif
3738  ENDIF
3739  ENDIF ! FL_DEFAULT_GBL_META
3740 
3741  ! ChrisB: Write user global attributes:
3742  CALL write_global_meta(ncid, iret)
3743  CALL check_err(iret)
3744 
3745  ! ChrisB: Below is the old way of writing Global attributes, this
3746  ! is now deprecated, but still supported at the moment...
3747  open(unit=994,file='NC_globatt.inp',status='old',iostat=icode)
3748  IF (icode.EQ.0) THEN
3749  DO WHILE (icode.EQ.0)
3750  read(994,'(a)',iostat=icode) attname
3751  read(994,'(a)',iostat=icode) attval
3752  IF (icode.EQ.0) THEN
3753  strl=len_trim(attname)
3754  strl2=len_trim(attval)
3755  iret=nf90_put_att(ncid,nf90_global,attname(1:strl),attval(1:strl2))
3756  CALL check_err(iret)
3757  END IF
3758  END DO
3759  ENDIF
3760  CLOSE(994)
3761  IF(fl_default_gbl_meta) THEN
3762  iret=nf90_put_att(ncid,nf90_global,'product_name' ,trim(ncfile))
3763  CALL check_err(iret)
3764  iret=nf90_put_att(ncid,nf90_global,'area',trim(gname))
3765  CALL check_err(iret)
3766  ENDIF
3767 
3768  RETURN
3769 
3770  END SUBROUTINE w3crnc
3771 
3772 
3773  !/ ------------------------------------------------------------------- /
3774 
3787  SUBROUTINE s2grid(S, X, FLDIRN)
3788  !/
3789  !/ +-----------------------------------+
3790  !/ | C . Bunney |
3791  !/ | FORTRAN 90 |
3792  !/ | Last update : 03-Nov-2020 |
3793  !/ +-----------------------------------+
3794  !/
3795  !/ 03-Nov-2020 : Creation ( version 7.13 )
3796  !/
3797  ! 1. Purpose :
3798  !
3799  ! Exapand the seapoint array to full grid with handling of
3800  ! SMC regridding. The FLDIRN flag should be set to true for
3801  ! directional fields. In this case, they will be decomposed
3802  ! into U/V components for SMC grid interpolation and converted
3803  ! to oceanograhic convention.
3804  !
3805  ! 2. Parameters :
3806  !
3807  ! Parameter list
3808  ! ----------------------------------------------------------------
3809  ! S Real. I Sea point array
3810  ! X Real. O Gridded array
3811  ! FLDIRN Bool. I Directional field flag
3812  ! ----------------------------------------------------------------
3813  !
3814  !/ ------------------------------------------------------------------- /
3815  USE w3servmd, ONLY : w3s2xy
3816 
3817  IMPLICIT NONE
3818 
3819  REAL, INTENT(INOUT) :: S(:)
3820  REAL, INTENT(OUT) :: X(:,:)
3821  LOGICAL, OPTIONAL, INTENT(IN) :: FLDIRN
3822 
3823  LOGICAL :: FLDR
3824  INTEGER :: ISEA
3825 
3826  fldr = .false.
3827  IF(PRESENT(fldirn)) fldr = fldirn
3828 
3829 #ifdef W3_SMC
3830  IF( smcgrd ) THEN
3831  CALL w3s2xy_smc( s, x, fldr )
3832  ELSE ! IF(SMCGRD)
3833 #endif
3834  IF(fldr) THEN
3835  DO isea=1, nsea
3836  IF (s(isea) .NE. undef ) THEN
3837  s(isea) = mod( 630. - rade * s(isea) , 360. )
3838  END IF
3839  END DO
3840  ENDIF
3841 
3842  ! Change UNDEF sea points to NOVAL, if set differently
3843  IF(noval .NE. undef) WHERE(s .EQ. undef) s = noval
3844 
3845  CALL w3s2xy ( nsea, nsea, nx+1, ny, s, mapsf, x )
3846 #ifdef W3_SMC
3847  ENDIF
3848 #endif
3849 
3850  END SUBROUTINE s2grid
3851 
3852 
3865  SUBROUTINE uv_to_mag_dir(U, V, TOLERANCE)
3866  ! Converts fields formulated as U/V vectors into
3867  ! magnitude and direction fields. Conversion is
3868  ! done in-place. U becomes magnitude, V becomes
3869  ! direction. Optional TOLERANCE sets minimum
3870  ! magnitude.
3871  IMPLICIT NONE
3872 
3873  REAL, INTENT(INOUT) :: U(:), V(:)
3874  REAL, INTENT(IN), OPTIONAL :: TOLERANCE
3875 
3876  REAL :: TOL = 1.0
3877  REAL :: MAG ! Magnitude
3878  INTEGER :: ISEA
3879 
3880  IF(PRESENT(tolerance)) tol = tolerance
3881 
3882  DO isea=1, nsea
3883  mag = sqrt(u(isea)**2 + v(isea)**2)
3884  IF(mag .GT. tol) THEN
3885  v(isea) = mod( 630. - rade * atan2(u(isea), v(isea)), 360. )
3886  ELSE
3887  v(isea) = undef
3888  ! TODO - Setting V to undef does not work as later the write
3889  ! function only checks the U value. Set both to udef?
3890  END IF
3891  u(isea) = mag
3892  END DO
3893 
3894  END SUBROUTINE uv_to_mag_dir
3895 
3896  !==============================================================================
3897 
3903  SUBROUTINE check_error(IRET, ILINE)
3904 
3905  USE netcdf
3906  USE w3odatmd, ONLY: ndse
3907  USE w3servmd, ONLY: extcde
3908 
3909  IMPLICIT NONE
3910 
3911  INTEGER IRET, ILINE
3912 
3913  IF (iret .NE. nf90_noerr) THEN
3914  WRITE(ndse,*) ' *** WAVEWATCH III ERROR IN OUNF :'
3915  WRITE(ndse,*) ' LINE NUMBER ', iline
3916  WRITE(ndse,*) ' NETCDF ERROR MESSAGE: '
3917  WRITE(ndse,*) nf90_strerror(iret)
3918  CALL extcde ( 59 )
3919  END IF
3920  RETURN
3921 
3922  END SUBROUTINE check_error
3923 
3924  !==============================================================================
3925 
3926 
3927  !/
3928  !/ End of W3OUNF ----------------------------------------------------- /
3929  !/
3930 END PROGRAM w3ounf
w3adatmd::pt2
real, dimension(:,:), pointer pt2
Definition: w3adatmd.F90:597
w3adatmd::psw
real, dimension(:,:), pointer psw
Definition: w3adatmd.F90:597
w3gdatmd::nk
integer, pointer nk
Definition: w3gdatmd.F90:1230
w3adatmd::hcmaxe
real, dimension(:), pointer hcmaxe
Definition: w3adatmd.F90:587
w3gdatmd::trigp
integer, dimension(:,:), pointer trigp
Definition: w3gdatmd.F90:1111
w3servmd::nextln
subroutine nextln(CHCKC, NDSI, NDSE)
Definition: w3servmd.F90:222
w3adatmd::phice
real, dimension(:), pointer phice
Definition: w3adatmd.F90:607
w3adatmd::th2m
real, dimension(:,:), pointer th2m
Definition: w3adatmd.F90:594
w3wdatmd::iceh
real, dimension(:), pointer iceh
Definition: w3wdatmd.F90:183
w3adatmd::charn
real, dimension(:), pointer charn
Definition: w3adatmd.F90:603
w3adatmd::dtdyn
real, dimension(:), pointer dtdyn
Definition: w3adatmd.F90:620
w3adatmd::as
real, dimension(:), pointer as
Definition: w3adatmd.F90:584
w3gdatmd::ygrd
double precision, dimension(:,:), pointer ygrd
Definition: w3gdatmd.F90:1205
w3adatmd
Define data structures to set up wave model auxiliary data for several models simultaneously.
Definition: w3adatmd.F90:26
w3adatmd::hcmaxd
real, dimension(:), pointer hcmaxd
Definition: w3adatmd.F90:587
w3arrymd::outa2i
subroutine outa2i(ARRAY, MX, MY, LX, HX, LY, HY, NDS, NDST, NDSE, IDFM, RFORM, IDLA, VSC, VOF)
Definition: w3arrymd.F90:627
w3adatmd::sth1m
real, dimension(:,:), pointer sth1m
Definition: w3adatmd.F90:594
w3gdatmd::flagunr
logical, pointer flagunr
Definition: w3gdatmd.F90:1193
w3adatmd::ussy
real, dimension(:), pointer ussy
Definition: w3adatmd.F90:607
w3ounfmetamd::meta_t
Type for storing WW3 netCDF metadata for a variable.
Definition: w3ounfmetamd.F90:211
w3adatmd::pep
real, dimension(:,:), pointer pep
Definition: w3adatmd.F90:597
w3adatmd::mscd
real, dimension(:), pointer mscd
Definition: w3adatmd.F90:617
w3adatmd::abd
real, dimension(:), pointer abd
Definition: w3adatmd.F90:614
w3gdatmd::ungtype
integer, parameter ungtype
Definition: w3gdatmd.F90:626
w3gdatmd::ntri
integer, pointer ntri
Definition: w3gdatmd.F90:1109
w3wdatmd
Define data structures to set up wave model dynamic data for several models simultaneously.
Definition: w3wdatmd.F90:18
w3smcomd::celfac
integer celfac
Output grid cell scaling factor; should be an integer power of 2.
Definition: w3smcomd.F90:92
w3adatmd::stmaxe
real, dimension(:), pointer stmaxe
Definition: w3adatmd.F90:587
w3adatmd::tauice
real, dimension(:,:), pointer tauice
Definition: w3adatmd.F90:607
w3adatmd::t02
real, dimension(:), pointer t02
Definition: w3adatmd.F90:587
w3adatmd::us3d
real, dimension(:,:), pointer us3d
Definition: w3adatmd.F90:612
w3adatmd::cflxymax
real, dimension(:), pointer cflxymax
Definition: w3adatmd.F90:620
w3adatmd::tws
real, dimension(:), pointer tws
Definition: w3adatmd.F90:603
w3adatmd::tusx
real, dimension(:), pointer tusx
Definition: w3adatmd.F90:607
w3ounfmetamd::crs_meta
type(meta_list_t) crs_meta
Meta data list for CRS.
Definition: w3ounfmetamd.F90:253
w3adatmd::fcut
real, dimension(:), pointer fcut
Definition: w3adatmd.F90:620
w3gdatmd::rlgtype
integer, parameter rlgtype
Definition: w3gdatmd.F90:624
w3ounf
program w3ounf
Post-processing of grid output to NetCDF files.
Definition: ww3_ounf.F90:21
w3adatmd::tusy
real, dimension(:), pointer tusy
Definition: w3adatmd.F90:607
w3adatmd::ptp
real, dimension(:,:), pointer ptp
Definition: w3adatmd.F90:597
w3adatmd::dw
real, dimension(:), pointer dw
Definition: w3adatmd.F90:584
w3gdatmd::sig
real, dimension(:), pointer sig
Definition: w3gdatmd.F90:1234
w3wdatmd::icef
real, dimension(:), pointer icef
Definition: w3wdatmd.F90:183
w3gdatmd::xgrd
double precision, dimension(:,:), pointer xgrd
Definition: w3gdatmd.F90:1205
w3gdatmd::sy
real, pointer sy
Definition: w3gdatmd.F90:1183
w3adatmd::th1m
real, dimension(:,:), pointer th1m
Definition: w3adatmd.F90:594
w3adatmd::t01
real, dimension(:), pointer t01
Definition: w3adatmd.F90:587
w3adatmd::cge
real, dimension(:), pointer cge
Definition: w3adatmd.F90:603
w3wdatmd::wlv
real, dimension(:), pointer wlv
Definition: w3wdatmd.F90:183
w3odatmd::ptmeth
integer, pointer ptmeth
Definition: w3odatmd.F90:555
w3odatmd::iaproc
integer, pointer iaproc
Definition: w3odatmd.F90:457
w3odatmd::ngrpp
integer, parameter ngrpp
Definition: w3odatmd.F90:324
w3adatmd::pdir
real, dimension(:,:), pointer pdir
Definition: w3adatmd.F90:597
w3wdatmd::time
integer, dimension(:), pointer time
Definition: w3wdatmd.F90:172
w3adatmd::thp0
real, dimension(:), pointer thp0
Definition: w3adatmd.F90:587
w3adatmd::tauocy
real, dimension(:), pointer tauocy
Definition: w3adatmd.F90:607
constants::rade
real, parameter rade
RADE Conversion factor from radians to degrees.
Definition: constants.F90:76
w3adatmd::phs
real, dimension(:,:), pointer phs
Definition: w3adatmd.F90:597
w3adatmd::hs
real, dimension(:), pointer hs
Definition: w3adatmd.F90:587
w3gdatmd::gname
character(len=30), pointer gname
Definition: w3gdatmd.F90:1223
w3adatmd::uba
real, dimension(:), pointer uba
Definition: w3adatmd.F90:614
w3odatmd::fnmpre
character(len=80) fnmpre
Definition: w3odatmd.F90:330
w3adatmd::pqp
real, dimension(:,:), pointer pqp
Definition: w3adatmd.F90:597
w3nmlounfmd
Definition: w3nmlounfmd.F90:3
w3ounfmetamd::write_global_meta
subroutine write_global_meta(NCID, ERR)
Writes the user meta-data entries for the global attributes.
Definition: w3ounfmetamd.F90:2246
w3ounfmetamd::crs_name
character(len=128) crs_name
Coordinate reference system (CRS) name.
Definition: w3ounfmetamd.F90:252
w3servmd::w3eqtoll
subroutine w3eqtoll(PHI_EQ, LAMBDA_EQ, PHI, LAMBDA, ANGLED, PHI_POLE, LAMBDA_POLE, POINTS)
Definition: w3servmd.F90:1224
w3adatmd::tauwix
real, dimension(:), pointer tauwix
Definition: w3adatmd.F90:603
w3adatmd::pthp0
real, dimension(:,:), pointer pthp0
Definition: w3adatmd.F90:597
w3smcomd::exo
double precision exo
Output grid final longitude.
Definition: w3smcomd.F90:79
w3gdatmd::ussp_wn
real, dimension(:), pointer ussp_wn
Definition: w3gdatmd.F90:1099
w3gdatmd::w3setg
subroutine w3setg(IMOD, NDSE, NDST)
Definition: w3gdatmd.F90:2152
w3adatmd::tauwiy
real, dimension(:), pointer tauwiy
Definition: w3adatmd.F90:603
w3adatmd::taubbl
real, dimension(:,:), pointer taubbl
Definition: w3adatmd.F90:614
w3odatmd::ndse
integer, pointer ndse
Definition: w3odatmd.F90:456
w3adatmd::ef
real, dimension(:,:), pointer ef
Definition: w3adatmd.F90:594
w3wdatmd::berg
real, dimension(:), pointer berg
Definition: w3wdatmd.F90:183
w3adatmd::w3seta
subroutine w3seta(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3adatmd.F90:2645
w3adatmd::tauwny
real, dimension(:), pointer tauwny
Definition: w3adatmd.F90:603
w3servmd::w3thrtn
subroutine w3thrtn(NSEA, THETA, AnglD, Degrees)
Definition: w3servmd.F90:1333
w3wdatmd::w3ndat
subroutine w3ndat(NDSE, NDST)
Set up the number of grids to be used.
Definition: w3wdatmd.F90:210
w3adatmd::phiaw
real, dimension(:), pointer phiaw
Definition: w3adatmd.F90:603
w3adatmd::pws
real, dimension(:,:), pointer pws
Definition: w3adatmd.F90:597
w3adatmd::plp
real, dimension(:,:), pointer plp
Definition: w3adatmd.F90:597
w3exnc
subroutine w3exnc(NX, NY, IX1, IXN, IY1, IYN, NSEA, FILEPREFIX, E3DF, P2MSF, US3DF, USSPF, NCTYPE, TOGETHER, NCVARTYPEI, FLG2D, NCIDS, S3, STRSTOPDATE)
Perform actual grid output in NetCDF file.
Definition: ww3_ounf.F90:863
w3adatmd::phibbl
real, dimension(:), pointer phibbl
Definition: w3adatmd.F90:614
w3gdatmd::polat
real, pointer polat
Definition: w3gdatmd.F90:1191
w3gdatmd::x0
real, pointer x0
Definition: w3gdatmd.F90:1183
w3ounfmetamd::teardown_meta
subroutine teardown_meta()
De-allocates memory used for the META_T arrays.
Definition: w3ounfmetamd.F90:415
w3adatmd::cflthmax
real, dimension(:), pointer cflthmax
Definition: w3adatmd.F90:620
w3adatmd::skew
real, dimension(:), pointer skew
Definition: w3adatmd.F90:617
w3adatmd::psi
real, dimension(:,:), pointer psi
Definition: w3adatmd.F90:597
w3gdatmd::clgtype
integer, parameter clgtype
Definition: w3gdatmd.F90:625
w3adatmd::sth2m
real, dimension(:,:), pointer sth2m
Definition: w3adatmd.F90:594
w3adatmd::tpms
real, dimension(:), pointer tpms
Definition: w3adatmd.F90:607
w3servmd
Definition: w3servmd.F90:3
w3adatmd::embia1
real, dimension(:), pointer embia1
Definition: w3adatmd.F90:617
w3odatmd::flogrd
logical, dimension(:,:), pointer flogrd
Definition: w3odatmd.F90:478
w3adatmd::ths
real, dimension(:), pointer ths
Definition: w3adatmd.F90:587
w3adatmd::bedforms
real, dimension(:,:), pointer bedforms
Definition: w3adatmd.F90:614
w3timemd::caltype
character, public caltype
Definition: w3timemd.F90:79
w3adatmd::ud
real, dimension(:), pointer ud
Definition: w3adatmd.F90:584
w3adatmd::hmaxd
real, dimension(:), pointer hmaxd
Definition: w3adatmd.F90:587
w3adatmd::pwst
real, dimension(:), pointer pwst
Definition: w3adatmd.F90:597
w3smcomd::eyo
double precision eyo
Output grid final latitude.
Definition: w3smcomd.F90:80
w3wdatmd::w3setw
subroutine w3setw(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3wdatmd.F90:660
w3ounfmetamd::write_freeform_meta_list
subroutine write_freeform_meta_list(NCID, VARID, METALIST, ERR)
Writes the freeform user meta-data entries for a NetCDF variable.
Definition: w3ounfmetamd.F90:2293
w3adatmd::qkk
real, dimension(:), pointer qkk
Definition: w3adatmd.F90:617
w3odatmd::noge
integer, dimension(nogrp) noge
Definition: w3odatmd.F90:326
w3ounfmetamd::ncvartype
integer ncvartype
NetCDF variable type (2=int, 3=real, 4=depends)
Definition: w3ounfmetamd.F90:271
constants::tpiinv
real, parameter tpiinv
TPIINV Inverse of 2*Pi.
Definition: constants.F90:74
w3odatmd::w3seto
subroutine w3seto(IMOD, NDSERR, NDSTST)
Definition: w3odatmd.F90:1523
w3adatmd::sxy
real, dimension(:), pointer sxy
Definition: w3adatmd.F90:607
w3adatmd::tauwnx
real, dimension(:), pointer tauwnx
Definition: w3adatmd.F90:603
w3odatmd
Definition: w3odatmd.F90:3
w3adatmd::wbt
real, dimension(:), pointer wbt
Definition: w3adatmd.F90:587
w3adatmd::bhd
real, dimension(:), pointer bhd
Definition: w3adatmd.F90:607
w3adatmd::w3naux
subroutine w3naux(NDSE, NDST)
Set up the number of grids to be used.
Definition: w3adatmd.F90:704
w3adatmd::cy
real, dimension(:), pointer cy
Definition: w3adatmd.F90:584
w3adatmd::pnr
real, dimension(:), pointer pnr
Definition: w3adatmd.F90:597
s2grid
subroutine s2grid(S, X, FLDIRN)
Expand the seapoint array to full grid with handling of SMC regridding.
Definition: ww3_ounf.F90:3788
w3ounfmetamd
Manages user configurable netCDF meta-data for ww3_ounf program.
Definition: w3ounfmetamd.F90:162
w3odatmd::screen
integer, pointer screen
Definition: w3odatmd.F90:456
w3adatmd::taua
real, dimension(:), pointer taua
Definition: w3adatmd.F90:584
w3smcomd::sxo
double precision sxo
Output grid longitude origin.
Definition: w3smcomd.F90:77
w3adatmd::hmaxe
real, dimension(:), pointer hmaxe
Definition: w3adatmd.F90:587
w3adatmd::pt1
real, dimension(:,:), pointer pt1
Definition: w3adatmd.F90:597
constants::dwat
real, parameter dwat
DWAT Density of water (kg/m3).
Definition: constants.F90:62
w3adatmd::wlm
real, dimension(:), pointer wlm
Definition: w3adatmd.F90:587
w3gdatmd::mapsf
integer, dimension(:,:), pointer mapsf
Definition: w3gdatmd.F90:1163
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
w3adatmd::wnmean
real, dimension(:), pointer wnmean
Definition: w3adatmd.F90:587
w3adatmd::cflkmax
real, dimension(:), pointer cflkmax
Definition: w3adatmd.F90:620
w3iogomd::w3iogo
subroutine w3iogo(INXOUT, NDSOG, IOTST, IMOD ifdef W3_ASCII
Read/write gridded output.
Definition: w3iogomd.F90:2396
w3gdatmd::smctype
integer, parameter smctype
Definition: w3gdatmd.F90:627
w3adatmd::phioc
real, dimension(:), pointer phioc
Definition: w3adatmd.F90:607
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
w3nmlounfmd::nml_field_t
Definition: w3nmlounfmd.F90:27
w3crnc
subroutine w3crnc(NCFILE, NCID, DIMID, DIMLN, VARID, EXTRADIM, NCTYPE, MAPSTAOUT)
Desc not available.
Definition: ww3_ounf.F90:3290
check_err
subroutine check_err(IRET)
Check input return status for error value.
Definition: ww3_bounc.F90:856
w3adatmd::wn
real, dimension(:,:), pointer wn
Definition: w3adatmd.F90:575
w3servmd::str_to_upper
subroutine str_to_upper(STR)
Definition: w3servmd.F90:1500
w3adatmd::qp
real, dimension(:), pointer qp
Definition: w3adatmd.F90:587
w3iogomd
Gridded output of mean wave parameters.
Definition: w3iogomd.F90:15
w3smcomd
Service module for support of SMC regridding and interpolation.
Definition: w3smcomd.F90:56
uv_to_mag_dir
subroutine uv_to_mag_dir(U, V, TOLERANCE)
Converts fields formulated as U/V vectors into magnitude and direction fields.
Definition: ww3_ounf.F90:3866
w3nmlounfmd::nml_smc_t
Definition: w3nmlounfmd.F90:57
w3adatmd::stmaxd
real, dimension(:), pointer stmaxd
Definition: w3adatmd.F90:587
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3gdatmd::gtype
integer, pointer gtype
Definition: w3gdatmd.F90:1094
w3wdatmd::zeta_setup
real, dimension(:), pointer zeta_setup
Definition: w3wdatmd.F90:187
w3odatmd::ndso
integer, pointer ndso
Definition: w3odatmd.F90:456
w3wdatmd::ice
real, dimension(:), pointer ice
Definition: w3wdatmd.F90:183
w3gdatmd::w3nmod
subroutine w3nmod(NUMBER, NDSE, NDST, NAUX)
Definition: w3gdatmd.F90:1433
w3arrymd
Definition: w3arrymd.F90:3
w3adatmd::whitecap
real, dimension(:,:), pointer whitecap
Definition: w3adatmd.F90:603
w3gdatmd::y0
real, pointer y0
Definition: w3gdatmd.F90:1183
w3ounfmetamd::coords_attr
character(len=256) coords_attr
"coordinates" attribute - for defining auxiliary coordinates (for all variables)
Definition: w3ounfmetamd.F90:257
w3ounfmetamd::getmeta
type(meta_t) function getmeta(IFI, IFJ, ICOMP, IPART)
Get the meta data for a particular field.
Definition: w3ounfmetamd.F90:1610
w3adatmd::tauox
real, dimension(:), pointer tauox
Definition: w3adatmd.F90:607
w3adatmd::p2sms
real, dimension(:,:), pointer p2sms
Definition: w3adatmd.F90:612
w3odatmd::idout
character(len=20), dimension(nogrp, ngrpp) idout
Definition: w3odatmd.F90:329
w3adatmd::prms
real, dimension(:), pointer prms
Definition: w3adatmd.F90:607
w3adatmd::usero
real, dimension(:,:), pointer usero
Definition: w3adatmd.F90:623
w3iogomd::w3readflgrd
subroutine w3readflgrd(NDSI, NDSO, NDSS, NDSEN, COMSTR, FLG1D, FLG2D, IAPROC, NAPOUT, IERR)
Fills in FLG1D and FLG2D arrays from ASCII input file.
Definition: w3iogomd.F90:336
w3adatmd::mssy
real, dimension(:), pointer mssy
Definition: w3adatmd.F90:617
w3gdatmd::sx
real, pointer sx
Definition: w3gdatmd.F90:1183
w3odatmd::ndst
integer, pointer ndst
Definition: w3odatmd.F90:456
w3wdatmd::ust
real, dimension(:), pointer ust
Definition: w3wdatmd.F90:183
constants
Define some much-used constants for global use (all defined as PARAMETER).
Definition: constants.F90:20
w3adatmd::ua
real, dimension(:), pointer ua
Definition: w3adatmd.F90:584
w3nmlounfmd::w3nmlounf
subroutine w3nmlounf(NDSI, INFILE, NML_FIELD, NML_FILE, NML_SMC, IERR)
Definition: w3nmlounfmd.F90:76
w3ounfmetamd::fl_default_gbl_meta
logical fl_default_gbl_meta
Flag for using default (true) or user-defined (false) global meta data.
Definition: w3ounfmetamd.F90:249
w3adatmd::tauoy
real, dimension(:), pointer tauoy
Definition: w3adatmd.F90:607
w3odatmd::nogrp
integer, parameter nogrp
Definition: w3odatmd.F90:323
w3adatmd::fp0
real, dimension(:), pointer fp0
Definition: w3adatmd.F90:587
w3initmd::switches
character(len=512), parameter switches
Definition: w3initmd.F90:130
w3gdatmd
Definition: w3gdatmd.F90:16
w3adatmd::hsig
real, dimension(:), pointer hsig
Definition: w3adatmd.F90:587
w3odatmd::ptfcut
real, pointer ptfcut
Definition: w3odatmd.F90:556
w3servmd::w3xyrtn
subroutine w3xyrtn(NSEA, XVEC, YVEC, AnglD)
Definition: w3servmd.F90:1387
w3nmlounfmd::nml_file_t
Definition: w3nmlounfmd.F90:47
w3adatmd::ussx
real, dimension(:), pointer ussx
Definition: w3adatmd.F90:607
w3adatmd::embia2
real, dimension(:), pointer embia2
Definition: w3adatmd.F90:617
w3adatmd::mssx
real, dimension(:), pointer mssx
Definition: w3adatmd.F90:617
w3adatmd::tauadir
real, dimension(:), pointer tauadir
Definition: w3adatmd.F90:584
w3servmd::extcde
subroutine extcde(IEXIT, UNIT, MSG, FILE, LINE, COMM)
Definition: w3servmd.F90:736
w3odatmd::w3nout
subroutine w3nout(NDSERR, NDSTST)
Definition: w3odatmd.F90:561
w3adatmd::mscy
real, dimension(:), pointer mscy
Definition: w3adatmd.F90:617
w3wdatmd::rhoair
real, dimension(:), pointer rhoair
Definition: w3wdatmd.F90:183
w3servmd::itrace
subroutine itrace(NDS, NMAX)
Definition: w3servmd.F90:91
w3wdatmd::ustdir
real, dimension(:), pointer ustdir
Definition: w3wdatmd.F90:183
w3gdatmd::angld
real, dimension(:), pointer angld
Definition: w3gdatmd.F90:1192
w3ounfmetamd::init_meta
subroutine init_meta(VEC)
Allocates space for the META_T arrays and sets some defaults.
Definition: w3ounfmetamd.F90:299
w3adatmd::ptm1
real, dimension(:,:), pointer ptm1
Definition: w3adatmd.F90:597
w3odatmd::noswll
integer, pointer noswll
Definition: w3odatmd.F90:460
w3smcomd::noval
real noval
Fill value for seapoints with no value.
Definition: w3smcomd.F90:110
w3adatmd::thm
real, dimension(:), pointer thm
Definition: w3adatmd.F90:587
check_error
subroutine check_error(IRET, ILINE)
Desc not available.
Definition: ww3_ounf.F90:3904
w3ounfmetamd::write_meta
subroutine write_meta(NCID, VARID, META, ERR)
Writes the meta-data entries for a variable.
Definition: w3ounfmetamd.F90:2115
w3adatmd::mscx
real, dimension(:), pointer mscx
Definition: w3adatmd.F90:617
w3adatmd::ppe
real, dimension(:,:), pointer ppe
Definition: w3adatmd.F90:597
w3adatmd::cx
real, dimension(:), pointer cx
Definition: w3adatmd.F90:584
w3adatmd::pgw
real, dimension(:,:), pointer pgw
Definition: w3adatmd.F90:597
w3smcomd::syo
double precision syo
Output grid latitude origin.
Definition: w3smcomd.F90:78
w3timemd
Definition: w3timemd.F90:3
constants::undef
real undef
UNDEF Value for undefined variable in output.
Definition: constants.F90:84
w3adatmd::ussp
real, dimension(:,:), pointer ussp
Definition: w3adatmd.F90:612
w3smcomd::smcotype
integer smcotype
Type of SMC output: 1=seapoint grid of SMC cells; 2=regridding to regular grid; 3=interpolation to ar...
Definition: w3smcomd.F90:90
w3adatmd::mssd
real, dimension(:), pointer mssd
Definition: w3adatmd.F90:617
w3servmd::w3s2xy
subroutine w3s2xy(NSEA, MSEA, MX, MY, S, MAPSF, XY)
Definition: w3servmd.F90:337
w3adatmd::t0m1
real, dimension(:), pointer t0m1
Definition: w3adatmd.F90:587
w3arrymd::prtblk
subroutine prtblk(NDS, NX, NY, MX, F, MAP, MAP0, FSC, IX1, IX2, IX3, IY1, IY2, IY3, PRVAR, PRUNIT)
Definition: w3arrymd.F90:1112
w3gdatmd::mapsta
integer, dimension(:,:), pointer mapsta
Definition: w3gdatmd.F90:1163
constants::grav
real, parameter grav
GRAV Acc.
Definition: constants.F90:61
w3gdatmd::polon
real, pointer polon
Definition: w3gdatmd.F90:1191
w3initmd
Contains module W3INITMD.
Definition: w3initmd.F90:14
w3initmd::wwver
character(len=10), parameter wwver
Definition: w3initmd.F90:129
w3adatmd::tauocx
real, dimension(:), pointer tauocx
Definition: w3adatmd.F90:607
w3gdatmd::mapst2
integer, dimension(:,:), pointer mapst2
Definition: w3gdatmd.F90:1163
w3adatmd::aba
real, dimension(:), pointer aba
Definition: w3adatmd.F90:614
w3adatmd::syy
real, dimension(:), pointer syy
Definition: w3adatmd.F90:607
w3adatmd::ubd
real, dimension(:), pointer ubd
Definition: w3adatmd.F90:614
w3iogomd::w3flgrdflag
subroutine w3flgrdflag(NDSO, NDSS, NDSEN, FLDOUT, FLG1D, FLG2D, IAPROC, NAPOUT, IERR)
Fills in FLG1D and FLG2D arrays from ASCII input file.
Definition: w3iogomd.F90:586
w3adatmd::sxx
real, dimension(:), pointer sxx
Definition: w3adatmd.F90:607
w3servmd::uv_to_mag_dir
subroutine uv_to_mag_dir(U, V, NSEA, MAG, DIR, TOLERANCE, CONV)
Definition: w3servmd.F90:1922
w3gdatmd::flagll
logical, pointer flagll
Definition: w3gdatmd.F90:1219