Changeset 030e3c1 in flexpart.git
- Timestamp:
- Apr 11, 2017, 2:03:19 AM (7 years ago)
- Branches:
- fp9.3.1-20161214-nc4
- Children:
- 89ad9c3
- Parents:
- ee13a7b
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
flexpart_code/fpmetbinary_mod.F90
ree13a7b r030e3c1 304 304 305 305 306 ! Helper functions (in this module) 307 !INTEGER :: logical2integer 308 !LOGICAL :: integer2logical 309 310 INTEGER :: temp_integer ! temporary value 306 311 INTEGER :: ncret ! Return value from NetCDF calls 307 312 INTEGER :: ncvarid ! NetCDF variable ID … … 309 314 INTEGER :: nxmax_dimid, nymax_dimid, nzmax_dimid, nuvzmax_dimid, nwzmax_dimid, & 310 315 & maxspec_dimid, numclass_dimid, maxnests_dimid, nxmaxn_dimid, nymaxn_dimid, & 311 & zero_to_nzmax_dimid, zero_to_maxnests_dimid, polemap_dimid 316 & zero_to_nzmax_dimid, zero_to_maxnests_dimid, polemap_dimid, & 317 & nconvlevmax_dimid, na_dimid 312 318 313 319 … … 327 333 & maxnests_dimname, nxmaxn_dimname, nymaxn_dimname, & 328 334 & zero_to_nzmax_dimname, zero_to_maxnests_dimname, & 329 & polemap_dimname 335 & polemap_dimname, nconvlevmax_dimname, na_dimname 330 336 331 337 ! These are temporary variables, used in the LOAD option, for … … 367 373 ncret = nf90_def_dim(ncid, 'numclass', numclass, numclass_dimid) 368 374 call handle_nf90_err(ncret) 375 376 ! There are a handful of variables indexed from 0 to n, rather than 0 to n-1, 377 ! so these dimensions handle that. What a pain. 369 378 ncret = nf90_def_dim(ncid, 'zero_to_nzmax', nzmax+1, zero_to_nzmax_dimid) 370 379 call handle_nf90_err(ncret) 371 380 ncret = nf90_def_dim(ncid, 'zero_to_maxnests', maxnests+1, zero_to_maxnests_dimid) 372 381 call handle_nf90_err(ncret) 382 383 ! This is for a couple of small arrays that store polar stereographic stuff 373 384 ncret = nf90_def_dim(ncid, 'polemap_dim', 9, polemap_dimid) 385 call handle_nf90_err(ncret) 386 387 ! These two values come from conv_mod 388 ncret = nf90_def_dim(ncid, 'nconvlevmax_dim', nconvlevmax, nconvlevmax_dimid) 389 call handle_nf90_err(ncret) 390 ncret = nf90_def_dim(ncid, 'na_dim', na, na_dimid) 374 391 call handle_nf90_err(ncret) 375 392 … … 1872 1889 1873 1890 1874 1891 ! xglobal, sglobal, nglobal are LOGICAL vars, and need to be converted 1892 ! to INTEGER for NetCDF storage 1875 1893 ncret = nf90_def_var(ncid, 'xglobal', NF90_INT, ncvarid) 1876 1894 call handle_nf90_err(ncret) 1877 ncret = nf90_put_var(ncid, ncvarid, xglobal)1895 ncret = nf90_put_var(ncid, ncvarid, logical2integer(xglobal)) 1878 1896 call handle_nf90_err(ncret) 1879 1897 1880 1898 ncret = nf90_def_var(ncid, 'sglobal', NF90_INT, ncvarid) 1881 1899 call handle_nf90_err(ncret) 1882 ncret = nf90_put_var(ncid, ncvarid, sglobal)1900 ncret = nf90_put_var(ncid, ncvarid, logical2integer(sglobal)) 1883 1901 call handle_nf90_err(ncret) 1884 1902 1885 1903 ncret = nf90_def_var(ncid, 'nglobal', NF90_INT, ncvarid) 1886 1904 call handle_nf90_err(ncret) 1887 ncret = nf90_put_var(ncid, ncvarid, nglobal)1905 ncret = nf90_put_var(ncid, ncvarid, logical2integer(nglobal)) 1888 1906 call handle_nf90_err(ncret) 1889 1907 … … 1924 1942 WRITE(iounit) psconv, tt2conv, td2conv 1925 1943 WRITE(iounit) nconvlev, nconvtop 1944 1945 1946 dim1dids = (/nconvlevmax_dimid/) 1947 1948 ncret = nf90_def_var(ncid, 'pconv', NF90_FLOAT, & 1949 & dim1dids, ncvarid) 1950 ncret = nf90_def_var_deflate(ncid, ncvarid, & 1951 & shuffle=0, & 1952 & deflate=1, & 1953 & deflate_level=DEF_LEVEL) 1954 ncret = nf90_put_var(ncid, ncvarid, & 1955 & pconv(:)) 1956 1957 ncret = nf90_def_var(ncid, 'dpr', NF90_FLOAT, & 1958 & dim1dids, ncvarid) 1959 ncret = nf90_def_var_deflate(ncid, ncvarid, & 1960 & shuffle=0, & 1961 & deflate=1, & 1962 & deflate_level=DEF_LEVEL) 1963 ncret = nf90_put_var(ncid, ncvarid, & 1964 & dpr(:)) 1965 1966 ncret = nf90_def_var(ncid, 'pconv_hpa', NF90_FLOAT, & 1967 & dim1dids, ncvarid) 1968 ncret = nf90_def_var_deflate(ncid, ncvarid, & 1969 & shuffle=0, & 1970 & deflate=1, & 1971 & deflate_level=DEF_LEVEL) 1972 ncret = nf90_put_var(ncid, ncvarid, & 1973 & pconv_hpa(:)) 1974 1975 ncret = nf90_def_var(ncid, 'ft', NF90_FLOAT, & 1976 & dim1dids, ncvarid) 1977 ncret = nf90_def_var_deflate(ncid, ncvarid, & 1978 & shuffle=0, & 1979 & deflate=1, & 1980 & deflate_level=DEF_LEVEL) 1981 ncret = nf90_put_var(ncid, ncvarid, & 1982 & ft(:)) 1983 1984 ncret = nf90_def_var(ncid, 'fq', NF90_FLOAT, & 1985 & dim1dids, ncvarid) 1986 ncret = nf90_def_var_deflate(ncid, ncvarid, & 1987 & shuffle=0, & 1988 & deflate=1, & 1989 & deflate_level=DEF_LEVEL) 1990 ncret = nf90_put_var(ncid, ncvarid, & 1991 & fq(:)) 1992 1993 ncret = nf90_def_var(ncid, 'sub', NF90_FLOAT, & 1994 & dim1dids, ncvarid) 1995 ncret = nf90_def_var_deflate(ncid, ncvarid, & 1996 & shuffle=0, & 1997 & deflate=1, & 1998 & deflate_level=DEF_LEVEL) 1999 ncret = nf90_put_var(ncid, ncvarid, & 2000 & sub(:)) 2001 2002 dim1dids = (/na_dimid/) 2003 2004 ncret = nf90_def_var(ncid, 'phconv', NF90_FLOAT, & 2005 & dim1dids, ncvarid) 2006 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2007 & shuffle=0, & 2008 & deflate=1, & 2009 & deflate_level=DEF_LEVEL) 2010 ncret = nf90_put_var(ncid, ncvarid, & 2011 & phconv(:)) 2012 2013 ncret = nf90_def_var(ncid, 'phconv_hpa', NF90_FLOAT, & 2014 & dim1dids, ncvarid) 2015 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2016 & shuffle=0, & 2017 & deflate=1, & 2018 & deflate_level=DEF_LEVEL) 2019 ncret = nf90_put_var(ncid, ncvarid, & 2020 & phconv_hpa(:)) 2021 2022 ncret = nf90_def_var(ncid, 'tconv', NF90_FLOAT, & 2023 & dim1dids, ncvarid) 2024 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2025 & shuffle=0, & 2026 & deflate=1, & 2027 & deflate_level=DEF_LEVEL) 2028 ncret = nf90_put_var(ncid, ncvarid, & 2029 & tconv(:)) 2030 2031 ncret = nf90_def_var(ncid, 'qconv', NF90_FLOAT, & 2032 & dim1dids, ncvarid) 2033 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2034 & shuffle=0, & 2035 & deflate=1, & 2036 & deflate_level=DEF_LEVEL) 2037 ncret = nf90_put_var(ncid, ncvarid, & 2038 & qconv(:)) 2039 2040 ncret = nf90_def_var(ncid, 'qsconv', NF90_FLOAT, & 2041 & dim1dids, ncvarid) 2042 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2043 & shuffle=0, & 2044 & deflate=1, & 2045 & deflate_level=DEF_LEVEL) 2046 ncret = nf90_put_var(ncid, ncvarid, & 2047 & qsconv(:)) 2048 2049 ! New dimensions 2050 dim2dids = (/nconvlevmax_dimid, nconvlevmax_dimid/) 2051 2052 ncret = nf90_def_var(ncid, 'fmass', NF90_FLOAT, & 2053 & dim2dids, ncvarid) 2054 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2055 & shuffle=0, & 2056 & deflate=1, & 2057 & deflate_level=DEF_LEVEL) 2058 ncret = nf90_put_var(ncid, ncvarid, & 2059 & fmass(:,:)) 2060 2061 ncret = nf90_def_var(ncid, 'fmassfrac', NF90_FLOAT, & 2062 & dim2dids, ncvarid) 2063 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2064 & shuffle=0, & 2065 & deflate=1, & 2066 & deflate_level=DEF_LEVEL) 2067 ncret = nf90_put_var(ncid, ncvarid, & 2068 & fmassfrac(:,:)) 2069 2070 2071 ! New dimensions 2072 dim2dids = (/nxmax_dimid, nymax_dimid/) 2073 2074 ncret = nf90_def_var(ncid, 'cbaseflux', NF90_FLOAT, & 2075 & dim2dids, ncvarid) 2076 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2077 & shuffle=0, & 2078 & deflate=1, & 2079 & deflate_level=DEF_LEVEL) 2080 ncret = nf90_put_var(ncid, ncvarid, & 2081 & cbaseflux(0:nxmax-1,0:nymax-1)) 2082 2083 ! New dimensions 2084 dim3dids = (/nxmaxn_dimid, nymaxn_dimid, maxnests_dimid/) 2085 2086 ncret = nf90_def_var(ncid, 'cbasefluxn', NF90_FLOAT, & 2087 & dim3dids, ncvarid) 2088 ncret = nf90_def_var_deflate(ncid, ncvarid, & 2089 & shuffle=0, & 2090 & deflate=1, & 2091 & deflate_level=DEF_LEVEL) 2092 ncret = nf90_put_var(ncid, ncvarid, & 2093 & cbasefluxn(0:nxmaxn-1,0:nymaxn-1,1:maxnests)) 2094 2095 2096 ! Scalars 2097 ncret = nf90_def_var(ncid, 'psconv', NF90_FLOAT, ncvarid) 2098 call handle_nf90_err(ncret) 2099 ncret = nf90_put_var(ncid, ncvarid, psconv) 2100 call handle_nf90_err(ncret) 2101 2102 ncret = nf90_def_var(ncid, 'tt2conv', NF90_FLOAT, ncvarid) 2103 call handle_nf90_err(ncret) 2104 ncret = nf90_put_var(ncid, ncvarid, tt2conv) 2105 call handle_nf90_err(ncret) 2106 2107 ncret = nf90_def_var(ncid, 'td2conv', NF90_FLOAT, ncvarid) 2108 call handle_nf90_err(ncret) 2109 ncret = nf90_put_var(ncid, ncvarid, td2conv) 2110 call handle_nf90_err(ncret) 2111 2112 ncret = nf90_def_var(ncid, 'nconvlev', NF90_INT, ncvarid) 2113 call handle_nf90_err(ncret) 2114 ncret = nf90_put_var(ncid, ncvarid, nconvlev) 2115 call handle_nf90_err(ncret) 2116 2117 ncret = nf90_def_var(ncid, 'nconvtop', NF90_INT, ncvarid) 2118 call handle_nf90_err(ncret) 2119 ncret = nf90_put_var(ncid, ncvarid, nconvtop) 2120 call handle_nf90_err(ncret) 2121 2122 PRINT *, 'SUM(pconv): ', SUM(pconv) 2123 PRINT *, 'SUM(qconv): ', SUM(qconv) 2124 PRINT *, 'SUM(fmassfrac): ', SUM(fmassfrac) 2125 PRINT *, 'SUM(cbasefluxn): ', SUM(cbasefluxn) 2126 PRINT *, 'tt2conv: ', tt2conv 2127 PRINT *, 'nconvlev: ', nconvlev 2128 2129 1926 2130 1927 2131 ELSE IF (op == 'LOAD') THEN … … 2844 3048 call handle_nf90_err(ncret) 2845 3049 3050 ! xglobal, sglobal, nglobal are LOGICAL vars, and need to be converted 3051 ! to INTEGER for NetCDF storage 2846 3052 ncret = nf90_inq_varid(ncid, 'xglobal', ncvarid) 2847 3053 call handle_nf90_err(ncret) 2848 ncret = nf90_get_var(ncid, ncvarid, xglobal) 2849 call handle_nf90_err(ncret) 3054 ncret = nf90_get_var(ncid, ncvarid, temp_integer) 3055 call handle_nf90_err(ncret) 3056 xglobal = integer2logical(temp_integer) 2850 3057 2851 3058 ncret = nf90_inq_varid(ncid, 'sglobal', ncvarid) 2852 3059 call handle_nf90_err(ncret) 2853 ncret = nf90_get_var(ncid, ncvarid, sglobal) 2854 call handle_nf90_err(ncret) 3060 ncret = nf90_get_var(ncid, ncvarid, temp_integer) 3061 call handle_nf90_err(ncret) 3062 sglobal = integer2logical(temp_integer) 2855 3063 2856 3064 ncret = nf90_inq_varid(ncid, 'nglobal', ncvarid) 2857 3065 call handle_nf90_err(ncret) 2858 ncret = nf90_get_var(ncid, ncvarid, nglobal) 2859 call handle_nf90_err(ncret) 3066 ncret = nf90_get_var(ncid, ncvarid, temp_integer) 3067 call handle_nf90_err(ncret) 3068 nglobal = integer2logical(temp_integer) 2860 3069 2861 3070 ncret = nf90_inq_varid(ncid, 'switchnorthg', ncvarid) … … 2898 3107 READ(iounit) nconvlev, nconvtop 2899 3108 3109 ncret = nf90_inq_varid(ncid, 'pconv', ncvarid) 3110 call handle_nf90_err(ncret) 3111 ncret = nf90_get_var(ncid, ncvarid, pconv(:)) 3112 call handle_nf90_err(ncret) 3113 3114 ncret = nf90_inq_varid(ncid, 'dpr', ncvarid) 3115 call handle_nf90_err(ncret) 3116 ncret = nf90_get_var(ncid, ncvarid, dpr(:)) 3117 call handle_nf90_err(ncret) 3118 3119 ncret = nf90_inq_varid(ncid, 'pconv_hpa', ncvarid) 3120 call handle_nf90_err(ncret) 3121 ncret = nf90_get_var(ncid, ncvarid, pconv_hpa(:)) 3122 call handle_nf90_err(ncret) 3123 3124 ncret = nf90_inq_varid(ncid, 'ft', ncvarid) 3125 call handle_nf90_err(ncret) 3126 ncret = nf90_get_var(ncid, ncvarid, ft(:)) 3127 call handle_nf90_err(ncret) 3128 3129 ncret = nf90_inq_varid(ncid, 'fq', ncvarid) 3130 call handle_nf90_err(ncret) 3131 ncret = nf90_get_var(ncid, ncvarid, fq(:)) 3132 call handle_nf90_err(ncret) 3133 3134 ncret = nf90_inq_varid(ncid, 'sub', ncvarid) 3135 call handle_nf90_err(ncret) 3136 ncret = nf90_get_var(ncid, ncvarid, sub(:)) 3137 call handle_nf90_err(ncret) 3138 3139 ncret = nf90_inq_varid(ncid, 'phconv', ncvarid) 3140 call handle_nf90_err(ncret) 3141 ncret = nf90_get_var(ncid, ncvarid, phconv(:)) 3142 call handle_nf90_err(ncret) 3143 3144 ncret = nf90_inq_varid(ncid, 'phconv_hpa', ncvarid) 3145 call handle_nf90_err(ncret) 3146 ncret = nf90_get_var(ncid, ncvarid, phconv_hpa(:)) 3147 call handle_nf90_err(ncret) 3148 3149 ncret = nf90_inq_varid(ncid, 'tconv', ncvarid) 3150 call handle_nf90_err(ncret) 3151 ncret = nf90_get_var(ncid, ncvarid, tconv(:)) 3152 call handle_nf90_err(ncret) 3153 3154 ncret = nf90_inq_varid(ncid, 'qconv', ncvarid) 3155 call handle_nf90_err(ncret) 3156 ncret = nf90_get_var(ncid, ncvarid, qconv(:)) 3157 call handle_nf90_err(ncret) 3158 3159 ncret = nf90_inq_varid(ncid, 'qsconv', ncvarid) 3160 call handle_nf90_err(ncret) 3161 ncret = nf90_get_var(ncid, ncvarid, qsconv(:)) 3162 call handle_nf90_err(ncret) 3163 3164 ncret = nf90_inq_varid(ncid, 'fmass', ncvarid) 3165 call handle_nf90_err(ncret) 3166 ncret = nf90_get_var(ncid, ncvarid, fmass(:,:)) 3167 call handle_nf90_err(ncret) 3168 3169 ncret = nf90_inq_varid(ncid, 'fmassfrac', ncvarid) 3170 call handle_nf90_err(ncret) 3171 ncret = nf90_get_var(ncid, ncvarid, fmassfrac(:,:)) 3172 call handle_nf90_err(ncret) 3173 3174 ncret = nf90_inq_varid(ncid, 'cbaseflux', ncvarid) 3175 call handle_nf90_err(ncret) 3176 ncret = nf90_get_var(ncid, ncvarid, cbaseflux(0:nxmax-1,0:nymax-1)) 3177 call handle_nf90_err(ncret) 3178 3179 ncret = nf90_inq_varid(ncid, 'cbasefluxn', ncvarid) 3180 call handle_nf90_err(ncret) 3181 ncret = nf90_get_var(ncid, ncvarid, cbasefluxn(0:nxmaxn-1,0:nymaxn-1,1:maxnests)) 3182 call handle_nf90_err(ncret) 3183 3184 ncret = nf90_inq_varid(ncid, 'psconv', ncvarid) 3185 call handle_nf90_err(ncret) 3186 ncret = nf90_get_var(ncid, ncvarid, psconv) 3187 call handle_nf90_err(ncret) 3188 3189 ncret = nf90_inq_varid(ncid, 'tt2conv', ncvarid) 3190 call handle_nf90_err(ncret) 3191 ncret = nf90_get_var(ncid, ncvarid, tt2conv) 3192 call handle_nf90_err(ncret) 3193 3194 ncret = nf90_inq_varid(ncid, 'td2conv', ncvarid) 3195 call handle_nf90_err(ncret) 3196 ncret = nf90_get_var(ncid, ncvarid, td2conv) 3197 call handle_nf90_err(ncret) 3198 3199 ncret = nf90_inq_varid(ncid, 'nconvlev', ncvarid) 3200 call handle_nf90_err(ncret) 3201 ncret = nf90_get_var(ncid, ncvarid, nconvlev) 3202 call handle_nf90_err(ncret) 3203 3204 ncret = nf90_inq_varid(ncid, 'nconvtop', ncvarid) 3205 call handle_nf90_err(ncret) 3206 ncret = nf90_get_var(ncid, ncvarid, nconvtop) 3207 call handle_nf90_err(ncret) 3208 3209 3210 3211 3212 PRINT *, 'SUM(pconv): ', SUM(pconv) 3213 PRINT *, 'SUM(qconv): ', SUM(qconv) 3214 PRINT *, 'SUM(fmassfrac): ', SUM(fmassfrac) 3215 PRINT *, 'SUM(cbasefluxn): ', SUM(cbasefluxn) 3216 PRINT *, 'tt2conv: ', tt2conv 3217 PRINT *, 'nconvlev: ', nconvlev 3218 3219 3220 3221 3222 3223 3224 3225 3226 2900 3227 ELSE 2901 3228 STOP 'fpio(): Illegal operation' … … 2965 3292 2966 3293 3294 INTEGER FUNCTION logical2integer(logical_value) 3295 IMPLICIT NONE 3296 3297 ! Auxiliary function to convert logical values to 3298 ! integers. THIS DOES NO TYPE CHECKING!!! 3299 3300 3301 LOGICAL, INTENT(IN) :: logical_value 3302 3303 IF (logical_value .EQV. .TRUE.) THEN 3304 logical2integer = 1 3305 ELSE 3306 logical2integer = 0 3307 ENDIF 3308 3309 RETURN 3310 3311 END FUNCTION logical2integer 3312 3313 3314 LOGICAL FUNCTION integer2logical(integer_value) 3315 IMPLICIT NONE 3316 3317 ! Auxiliary function to convert integer values to 3318 ! logical. THIS DOES NO TYPE CHECKING!!! 3319 3320 3321 INTEGER, INTENT(IN) :: integer_value 3322 3323 IF (integer_value .EQ. 0) THEN 3324 integer2logical = .FALSE. 3325 ELSE 3326 integer2logical = .TRUE. 3327 ENDIF 3328 3329 RETURN 3330 3331 END FUNCTION integer2logical 2967 3332 2968 3333
Note: See TracChangeset
for help on using the changeset viewer.