Increase SMC grid coordinate and metadata precisions

model/src/w3metamd.F90

@@ -43,7 +43,7 @@ MODULE W3METAMD
   TYPE META_PAIR_T
     CHARACTER(LEN=64)  :: ATTNAME = UNSETC  !< Attribute name
     CHARACTER(LEN=120) :: ATTVAL = UNSETC   !< Attribute value
-    CHARACTER          :: TYPE = 'c'        !< Attribute type (c,i,f/r)
+    CHARACTER          :: TYPE = 'c'        !< Attribute type (c,i,f/r,d)
     TYPE(META_PAIR_T), POINTER  :: NEXT     !< Pointer to next node
   END TYPE META_PAIR_T
 
@@ -59,6 +59,7 @@ MODULE W3METAMD
     MODULE PROCEDURE META_LIST_APPEND_R !< Append a REAL value
     MODULE PROCEDURE META_LIST_APPEND_I !< Append an INTEGER value
     MODULE PROCEDURE META_LIST_APPEND_C !< Append a CHARACTER value
+    MODULE PROCEDURE META_LIST_APPEND_D !< Append a DOUBLE value
   END INTERFACE META_LIST_APPEND
 
 CONTAINS
@@ -242,6 +243,35 @@ SUBROUTINE META_LIST_APPEND_R(LIST, ATTNAME, RVAL)
   END SUBROUTINE META_LIST_APPEND_R
 
 
+  !/ ------------------------------------------------------------------- /
+  !> @brief Append DOUBLE value attribute to list
+  !>
+  !> @param[in,out] LIST     The list to append to
+  !> @param[in]     ATTNAME  The attribute name
+  !> @param[in]     DVAL     The attribute value (DOUBLE)
+  !>
+  !> @author Kit Stokes
+  !/ ------------------------------------------------------------------- /
+  SUBROUTINE META_LIST_APPEND_D(LIST, ATTNAME, DVAL)
+
+    IMPLICIT NONE
+
+    TYPE(META_LIST_T), INTENT(INOUT) :: LIST
+    CHARACTER(*), INTENT(IN)         :: ATTNAME
+    DOUBLE PRECISION, INTENT(IN)     :: DVAL
+    !/ ------------------------------------------------------------------- /
+    !/ Local parameters
+    !/
+    TYPE(META_PAIR_T) :: META
+
+    META%ATTNAME = ATTNAME
+    WRITE(META%ATTVAL,*) DVAL
+    META%TYPE = 'd'
+    CALL META_LIST_APPEND(LIST, META)
+
+  END SUBROUTINE META_LIST_APPEND_D
+
+
   !/ ------------------------------------------------------------------- /
   !> @brief Append INTEGER value attribute to list
   !>

model/src/w3ounfmetamd.F90

@@ -46,8 +46,8 @@
 !>    attribute. This extra attribute can take an optional "type"
 !>    keyworkd to specify the variable tpye of the metadata. If
 !>    no type is supplied, it defaults to a characer type. Valid
-!>    types are one of ["c", "r", "i"] for character/string,
-!>    real/float or integer values respectively.
+!>    types are one of ["c", "r", "i", "d"] for character/string,
+!>    real/float, integer, or double values respectively.
 !>
 !>    Global meta data can be specified with a special "META global" line:
 !>
@@ -1031,7 +1031,7 @@ END SUBROUTINE DECODE_HEADER
   !>    or EOF is found. Splits meta pairs on the = character.
   !>
   !>    Note - the "extra" metadata pair can also provide a variable
-  !>    type ("c", "i", or "r"; for character, int or real respectively)
+  !>    type ("c", "i", "r", or "d"; for character, int, real, or double respectively)
   !>
   !> @param[in]      NDMI  Unit number of metadata input file
   !> @param[out]     META  Pointer to META type
@@ -1063,7 +1063,7 @@ SUBROUTINE READ_META_PAIRS(NDMI, META, ILINE)
     !     or EOF is found. Splits meta pairs on the = character.
     !
     !     Note - the "extra" metadata pair can also provide a variable
-    !     type ("c", "i", or "r"; for character, int or real respectively)
+    !     type ("c", "i", "r", or "d"; for character, int, real, or double respectively)
     !
     !  3. Parameters :
     !
@@ -1211,8 +1211,8 @@ END SUBROUTINE READ_META_PAIRS
   !>
   !>    It is important to quote strings if they contain spaces.
   !>
-  !>    Valid types are "c" "r/f", and "i" for character, real/float and
-  !>     integer values.
+  !>    Valid types are "c" "r/f", "i", and "d" for character, real/float,
+  !>     integer, and double values respectively.
   !>
   !> @param[in]   BUF       Input string to process
   !> @param[in]   ILINE     Line number (for error reporting)
@@ -1247,8 +1247,8 @@ SUBROUTINE GET_ATTVAL_TYPE(BUF, ILINE, ATTV, ATT_TYPE)
     !
     !     It is important to quote strings if they contain spaces.
     !
-    !     Valid types are "c" "r/f", and "i" for character, real/float and
-    !     integer values.
+    !     Valid types are "c" "r/f", "i", and "d" for character, real/float
+    !     integer, and double values respectively.
 
     !  3. Parameters :
     !
@@ -1271,6 +1271,7 @@ SUBROUTINE GET_ATTVAL_TYPE(BUF, ILINE, ATTV, ATT_TYPE)
     !
     REAL :: R
     INTEGER :: I, IERR
+    DOUBLE PRECISION :: D
 
     ! Get attribute and type (default to "c" if no type set)
     ATT_TYPE = 'c'
@@ -1295,6 +1296,13 @@ SUBROUTINE GET_ATTVAL_TYPE(BUF, ILINE, ATTV, ATT_TYPE)
         CALL EXTCDE(10)
       ENDIF
 
+    CASE("d")
+      READ(attv, *, iostat=ierr) d
+      IF(ierr .ne. 0) THEN
+        WRITE(NDSE, 8001) "DOUBLE", TRIM(FN_META), ILINE, TRIM(ATTV)
+        CALL EXTCDE(10)
+      ENDIF
+
     CASE("c")
       ! Always ok.
 
@@ -1311,7 +1319,7 @@ SUBROUTINE GET_ATTVAL_TYPE(BUF, ILINE, ATTV, ATT_TYPE)
          '  => ', A /)
     !
 8002 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUNFMETA : '/           &
-         '     ATTRIBUTE TYPE SHOULD BE ONE OF [c,i,r] '/       &
+         '     ATTRIBUTE TYPE SHOULD BE ONE OF [c,i,r,d] '/       &
          '     FILENAME = ', A /                                &
          '     LINE NO =', I5 /                                 &
          '  => ', A /)
@@ -1325,7 +1333,7 @@ END SUBROUTINE GET_ATTVAL_TYPE
   !>    or EOF is found. Splits meta pairs on the `=` character.
   !>
   !>    Freeform metadata pairs can also provide a variable type
-  !>    ("c", "i", or "r"; for character, int or real respectively).
+  !>    ("c", "i", "r", or "d"; for character, int, real, or double respectively).
   !>    String values with spaces should be quoted.
   !>
   !> @param[in]      NDMI      Unit number of metadata input file
@@ -1357,7 +1365,7 @@ SUBROUTINE READ_FREEFORM_META_LIST(NDMI, ILINE, METALIST)
     !     or EOF is found. Splits meta pairs on the = character.
     !
     !     Freeform metadata pairs can also provide a variable type
-    !     ("c", "i", or "r"; for character, int or real respectively).
+    !     ("c", "i", "r", or "d"; for character, int, real, or double respectively).
     !     String values with spaces should be quoted.
     !
     !  3. Parameters :
@@ -2328,6 +2336,7 @@ SUBROUTINE WRITE_FREEFORM_META_LIST(NCID, VARID, METALIST, ERR)
     !/
     INTEGER :: I, IVAL
     REAL    :: RVAL
+    DOUBLE PRECISION :: DVAL
     TYPE(META_PAIR_T), POINTER :: P
 
     IF(METALIST%N .EQ. 0) RETURN
@@ -2352,6 +2361,11 @@ SUBROUTINE WRITE_FREEFORM_META_LIST(NCID, VARID, METALIST, ERR)
         ERR = NF90_PUT_ATT(NCID, VARID, P%ATTNAME, RVAL)
         IF(ERR /= NF90_NOERR) RETURN
 
+      CASE('d')
+        READ(P%ATTVAL, *) DVAL
+        ERR = NF90_PUT_ATT(NCID, VARID, P%ATTNAME, DVAL)
+        IF(ERR /= NF90_NOERR) RETURN
+
       CASE('c')
         ERR = NF90_PUT_ATT(NCID, VARID, P%ATTNAME,    &
              P%ATTVAL)

model/src/ww3_ounf.F90

@@ -2293,10 +2293,11 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA,             &
 #ifdef W3_SMC
                 ELSE
                   ! CB: Regridded SMC data
-                  SXD=DBLE(0.000001d0*DNINT(1d6*(DBLE(DXO)) ))
-                  SYD=DBLE(0.000001d0*DNINT(1d6*(DBLE(DYO)) ))
-                  X0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(SXO)) ))
-                  Y0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(SYO)) ))
+                  SXD=DBLE(0.00000001d0*DNINT(1d8*(DBLE(DXO)) ))
+                  SYD=DBLE(0.00000001d0*DNINT(1d8*(DBLE(DYO)) ))
+                  X0D=DBLE(0.00000001d0*DNINT(1d8*(DBLE(SXO)) ))
+                  Y0D=DBLE(0.00000001d0*DNINT(1d8*(DBLE(SYO)) ))
+
                   DO i=1,NXO
                     lon(i)=REAL(X0D+SXD*DBLE(i-1))
 #endif
@@ -2337,10 +2338,11 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA,             &
                 ENDIF ! SMCOTYPE
 #endif
               ELSE ! SMCGRD
-                SXD=DBLE(0.000001d0*DNINT(1d6*(DBLE(SX)) ))
-                SYD=DBLE(0.000001d0*DNINT(1d6*(DBLE(SY)) ))
-                X0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(X0)) ))
-                Y0D=DBLE(0.000001d0*DNINT(1d6*(DBLE(Y0)) ))
+                SXD=DBLE(0.00000001d0*DNINT(1d8*(DBLE(SX)) ))
+                SYD=DBLE(0.00000001d0*DNINT(1d8*(DBLE(SY)) ))
+                X0D=DBLE(0.00000001d0*DNINT(1d8*(DBLE(X0)) ))
+                Y0D=DBLE(0.00000001d0*DNINT(1d8*(DBLE(Y0)) ))
+
                 DO I=1,NX
                   LON(I)=REAL(X0D+SXD*DBLE(I-1))
                 END DO
@@ -3388,9 +3390,9 @@ SUBROUTINE W3CRNC (NCFILE, NCID, DIMID, DIMLN, VARID,  &
 #ifdef W3_SMC
           IF(SMCOTYPE .EQ. 1) THEN
             ! Flat SMC grid - use seapoint dimension:
-            IRET = NF90_DEF_VAR(NCID, 'longitude', NF90_FLOAT, DIMID(2), VARID(1))
+            IRET = NF90_DEF_VAR(NCID, 'longitude', NF90_DOUBLE, DIMID(2), VARID(1))
             CALL CHECK_ERR(IRET)
-            IRET = NF90_DEF_VAR(NCID, 'latitude', NF90_FLOAT, DIMID(2), VARID(2))
+            IRET = NF90_DEF_VAR(NCID, 'latitude', NF90_DOUBLE, DIMID(2), VARID(2))
             CALL CHECK_ERR(IRET)
 
             ! Latitude and longitude are auxililary variables in type 1 sea point
@@ -3412,10 +3414,10 @@ SUBROUTINE W3CRNC (NCFILE, NCID, DIMID, DIMLN, VARID,  &
             IRET = NF90_PUT_ATT(NCID, VARID(6), 'valid_min', 1)
             IRET = NF90_PUT_ATT(NCID, VARID(6), 'valid_max', 256)
           ELSE
-            ! Regirdded regular SMC grid - use lon/lat dimensions:
-            IRET = NF90_DEF_VAR(NCID, 'longitude', NF90_FLOAT, DIMID(2), VARID(1))
+            ! Regridded regular SMC grid - use lon/lat dimensions:
+            IRET = NF90_DEF_VAR(NCID, 'longitude', NF90_DOUBLE, DIMID(2), VARID(1))
             call CHECK_ERR(IRET)
-            IRET = NF90_DEF_VAR(NCID, 'latitude', NF90_FLOAT, DIMID(3), VARID(2))
+            IRET = NF90_DEF_VAR(NCID, 'latitude', NF90_DOUBLE, DIMID(3), VARID(2))
             call CHECK_ERR(IRET)
           ENDIF
 #endif