diff --git a/geogrid/src/v431/gridinfo_module.F b/geogrid/src/v431/gridinfo_module.F
index b854319218bf2b4da0aa3e1adf2e380f4a785ea0..369d1521a40c835cd368018ae41f205fddf4db2e 100644
--- a/geogrid/src/v431/gridinfo_module.F
+++ b/geogrid/src/v431/gridinfo_module.F
@@ -28,6 +28,10 @@ module gridinfo_module
logical :: do_tiled_output
logical, dimension(MAX_DOMAINS) :: grid_is_active
integer :: debug_level
+! L. Fita, CIMA. January 2020. RegIPSL
+ INTEGER :: minwatersize, Nbndsorogfilt
+ CHARACTER(len=100) :: typebndsorogfilt, bnds_to_filt
+ LOGICAL :: bndsorogfilt
contains
@@ -69,7 +73,9 @@ module gridinfo_module
i_parent_start, j_parent_start, s_we, e_we, s_sn, e_sn, &
map_proj, ref_x, ref_y, ref_lat, ref_lon, &
pole_lat, pole_lon, truelat1, truelat2, stand_lon, &
- dx, dy, geog_data_res, geog_data_path, opt_geogrid_tbl_path
+ dx, dy, geog_data_res, geog_data_path, opt_geogrid_tbl_path, &
+! L. Fita, CIMA. January 2020. RegIPSL
+ minwatersize, bndsorogfilt, bnds_to_filt, Nbndsorogfilt, typebndsorogfilt
! Set defaults for namelist variables
debug_level = 0
@@ -119,6 +125,12 @@ module gridinfo_module
opt_geogrid_tbl_path = 'geogrid/'
interval_seconds = INVALID
nocolons = .false.
+! L. Fita, CIMA. January 2020. RegIPSL
+ minwatersize = 500
+ bndsorogfilt = .FALSE.
+ bnds_to_filt = 'all'
+ Nbndsorogfilt = 5
+ typebndsorogfilt = 'incremental'
! Read parameters from Fortran namelist
do funit=10,100
@@ -268,6 +280,8 @@ module gridinfo_module
call mprintf(.true.,LOGFILE,' STAND_LON = %f',f1=stand_lon)
call mprintf(.true.,LOGFILE,' GEOG_DATA_PATH = %s',s1=geog_data_path)
call mprintf(.true.,LOGFILE,' OPT_GEOGRID_TBL_PATH = %s',s1=opt_geogrid_tbl_path)
+! L. Fita, CIMA. January 2020. RegIPSL
+ call mprintf(.true.,LOGFILE,' MINWATERSIZE = %i',i1=minwatersize)
call mprintf(.true.,LOGFILE,'/')
dxkm = dx
diff --git a/geogrid/src/v431/process_tile_module.F b/geogrid/src/v431/process_tile_module.F
index b8f4f6c304a6e4c2cf0567908a3b31ee0a703d0f..2045238df0b2ae5b7afabea6922aec083eb74a4b 100644
--- a/geogrid/src/v431/process_tile_module.F
+++ b/geogrid/src/v431/process_tile_module.F
@@ -61,7 +61,7 @@ module process_tile_module
integer :: sm1, em1, sm2, em2
integer :: istagger
integer, dimension(MAX_LANDMASK_CATEGORIES) :: landmask_value
- real :: sum, dominant, msg_fill_val, topo_flag_val, mass_flag, land_total, water_total
+ real :: sumv, dominant, msg_fill_val, topo_flag_val, mass_flag, land_total, water_total
real, dimension(16) :: corner_lats, corner_lons
real, pointer, dimension(:,:) :: xlat_array, xlon_array, &
xlat_array_u, xlon_array_u, &
@@ -734,13 +734,13 @@ module process_tile_module
! Find fractions
do i=start_mem_i, end_mem_i
do j=start_mem_j, end_mem_j
- sum = 0.
+ sumv = 0.
do k=min_category,max_category
- sum = sum + field(i,j,k)
+ sumv = sumv + field(i,j,k)
end do
- if (sum > 0.0) then
+ if (sumv > 0.0) then
do k=min_category,max_category
- field(i,j,k) = field(i,j,k) / sum
+ field(i,j,k) = field(i,j,k) / sumv
end do
else
do k=min_category,max_category
@@ -1515,13 +1515,13 @@ module process_tile_module
! Find fractions
do i=sm1, em1
do j=sm2, em2
- sum = 0.
+ sumv = 0.
do k=min_category,max_category
- sum = sum + field(i,j,k)
+ sumv = sumv + field(i,j,k)
end do
- if (sum > 0.0) then
+ if (sumv > 0.0) then
do k=min_category,max_category
- field(i,j,k) = field(i,j,k) / sum
+ field(i,j,k) = field(i,j,k) / sumv
end do
else
do k=min_category,max_category
diff --git a/nc2wps/Makefile.irene b/nc2wps/Makefile.irene
new file mode 100644
index 0000000000000000000000000000000000000000..421be654bd36d3294de6d5912d668c895ccf8ed2
--- /dev/null
+++ b/nc2wps/Makefile.irene
@@ -0,0 +1,53 @@
+# Makefile for netcdf2wps tool.
+# From netcdf to WPS' ungrib output
+# - Compilation for JeanZay (IDRIS)
+#source $CCCWORKDIR/RegIPSL/regipsl/RegIPSL/modeles/ARCH/irene.def
+#module load netcdf-fortran/4.5.3 mpi/intelmpi/21.4.0
+
+FC = ifort
+F90FLAGS = -FR -convert big_endian
+DEBUG = #-g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+LOPT = -lnetcdff -lnetcdf
+#CPPFLAGS = -D_UNDERSCORE -DBYTESWAP -DLINUX -DIO_NETCDF -DBIT32 -DNO_SIGNAL
+#CPPFLAGS = -D_UNDERSCORE -DLINUX -DIO_NETCDF -DIO_BINARY -DIO_GRIB1 -DBIT32 -D_MPI
+#CPPFLAGS = -D_UNDERSCORE -DBYTESWAP -DLINUX -DIO_NETCDF -DIO_BINARY -DIO_GRIB1 -DBIT32 -D_MPI
+NETCDFLIBS = -L/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-c-4.6.0/intel--20.0.2__openmpi--4.0.1/hdf5__parallel/lib -L/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-fortran-4.4.4/intel--20.0.0__openmpi--4.0.1/hdf5__parallel/lib
+NETCDFINCS = -I/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-fortran-4.4.4/intel--20.0.0__openmpi--4.0.1/hdf5__parallel/include
+FOPT = $(NETCDFLIBS) $(NETCDFINCS)
+
+####### ###### ##### #### ### ## #
+
+MODULES = \
+ stringop.o \
+ errioipsl.o \
+ calendar.o \
+ met_data_module.o \
+ module_definitions.o \
+ module_netcdf_utils.o \
+ module_ncwps.o
+
+all : \
+ read_FILE \
+ test \
+ netcdf2wps
+
+clean :
+ rm read_FILE netcdf2wps *.o *.mod
+
+clean_wrtcode :
+ rm netcdf2wps module_netcdf_utils.mod module_netcdf_utils.o module_ncwps.o
+
+## Compilation
+
+%.o: %.f90
+ $(FC) -c $(F90FLAGS) $(CPPFLAGS) $(DEBUG) $(FOPT) $(LOPT) -o $@ $<
+
+read_FILE: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) read_FILE.f90 -o read_FILE
+
+test: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) test.f90 -o test
+
+netcdf2wps: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) netcdf2wps.f90 -o netcdf2wps
+
diff --git a/nc2wps/Makefile.irene_RegIPSL b/nc2wps/Makefile.irene_RegIPSL
new file mode 100644
index 0000000000000000000000000000000000000000..421be654bd36d3294de6d5912d668c895ccf8ed2
--- /dev/null
+++ b/nc2wps/Makefile.irene_RegIPSL
@@ -0,0 +1,53 @@
+# Makefile for netcdf2wps tool.
+# From netcdf to WPS' ungrib output
+# - Compilation for JeanZay (IDRIS)
+#source $CCCWORKDIR/RegIPSL/regipsl/RegIPSL/modeles/ARCH/irene.def
+#module load netcdf-fortran/4.5.3 mpi/intelmpi/21.4.0
+
+FC = ifort
+F90FLAGS = -FR -convert big_endian
+DEBUG = #-g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+LOPT = -lnetcdff -lnetcdf
+#CPPFLAGS = -D_UNDERSCORE -DBYTESWAP -DLINUX -DIO_NETCDF -DBIT32 -DNO_SIGNAL
+#CPPFLAGS = -D_UNDERSCORE -DLINUX -DIO_NETCDF -DIO_BINARY -DIO_GRIB1 -DBIT32 -D_MPI
+#CPPFLAGS = -D_UNDERSCORE -DBYTESWAP -DLINUX -DIO_NETCDF -DIO_BINARY -DIO_GRIB1 -DBIT32 -D_MPI
+NETCDFLIBS = -L/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-c-4.6.0/intel--20.0.2__openmpi--4.0.1/hdf5__parallel/lib -L/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-fortran-4.4.4/intel--20.0.0__openmpi--4.0.1/hdf5__parallel/lib
+NETCDFINCS = -I/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-fortran-4.4.4/intel--20.0.0__openmpi--4.0.1/hdf5__parallel/include
+FOPT = $(NETCDFLIBS) $(NETCDFINCS)
+
+####### ###### ##### #### ### ## #
+
+MODULES = \
+ stringop.o \
+ errioipsl.o \
+ calendar.o \
+ met_data_module.o \
+ module_definitions.o \
+ module_netcdf_utils.o \
+ module_ncwps.o
+
+all : \
+ read_FILE \
+ test \
+ netcdf2wps
+
+clean :
+ rm read_FILE netcdf2wps *.o *.mod
+
+clean_wrtcode :
+ rm netcdf2wps module_netcdf_utils.mod module_netcdf_utils.o module_ncwps.o
+
+## Compilation
+
+%.o: %.f90
+ $(FC) -c $(F90FLAGS) $(CPPFLAGS) $(DEBUG) $(FOPT) $(LOPT) -o $@ $<
+
+read_FILE: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) read_FILE.f90 -o read_FILE
+
+test: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) test.f90 -o test
+
+netcdf2wps: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) netcdf2wps.f90 -o netcdf2wps
+
diff --git a/nc2wps/Makefile.irene_WRF b/nc2wps/Makefile.irene_WRF
new file mode 100644
index 0000000000000000000000000000000000000000..ec1badd0e294bb57c3b88cc2bbd408c3f608debb
--- /dev/null
+++ b/nc2wps/Makefile.irene_WRF
@@ -0,0 +1,54 @@
+# Makefile for netcdf2wps tool.
+# From netcdf to WPS' ungrib output
+# - Compilation for JeanZay (IDRIS)
+#module switch dfldatadir/gen6877
+#module load netcdf-c/4.7.4
+#module load netcdf-fortran/4.5.3
+
+FC = ifort
+F90FLAGS = -FR -convert big_endian
+DEBUG = #-g -O2 -traceback -fp-stack-check -ftrapuv -check bounds
+LOPT = -lnetcdff -lnetcdf
+#CPPFLAGS = -D_UNDERSCORE -DBYTESWAP -DLINUX -DIO_NETCDF -DBIT32 -DNO_SIGNAL
+#CPPFLAGS = -D_UNDERSCORE -DLINUX -DIO_NETCDF -DIO_BINARY -DIO_GRIB1 -DBIT32 -D_MPI
+#CPPFLAGS = -D_UNDERSCORE -DBYTESWAP -DLINUX -DIO_NETCDF -DIO_BINARY -DIO_GRIB1 -DBIT32 -D_MPI
+NETCDFLIBS = -L/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-c-4.7.4/intel--20.0.0/hdf5__serial/lib -L/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-fortran-4.5.3/intel--20.0.0/hdf5__serial/lib
+NETCDFINCS = -I/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-fortran-4.5.3/intel--20.0.0/hdf5__serial/include -I/ccc/products/ccc_users_env/compil/Rhel_8__x86_64/netcdf-fortran-4.5.3/intel--20.0.0/hdf5__serial/include
+FOPT = $(NETCDFLIBS) $(NETCDFINCS)
+
+####### ###### ##### #### ### ## #
+
+MODULES = \
+ stringop.o \
+ errioipsl.o \
+ calendar.o \
+ met_data_module.o \
+ module_definitions.o \
+ module_netcdf_utils.o \
+ module_ncwps.o
+
+all : \
+ read_FILE \
+ test \
+ netcdf2wps
+
+clean :
+ rm read_FILE netcdf2wps *.o *.mod
+
+clean_wrtcode :
+ rm netcdf2wps module_netcdf_utils.mod module_netcdf_utils.o module_ncwps.o
+
+## Compilation
+
+%.o: %.f90
+ $(FC) -c $(F90FLAGS) $(CPPFLAGS) $(DEBUG) $(FOPT) $(LOPT) -o $@ $<
+
+read_FILE: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) read_FILE.f90 -o read_FILE
+
+test: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) test.f90 -o test
+
+netcdf2wps: $(MODULES)
+ $(FC) $(F90FLAGS) $(MODULES) $(DEBUG) $(LOPT) $(FOPT) netcdf2wps.f90 -o netcdf2wps
+
diff --git a/nc2wps/module_definitions.f90 b/nc2wps/module_definitions.f90
index dbba053bc7b5cad9bfc6efd7b7588caac3eaf306..62f87529e28b5498ed9cb799a98e41d633575778 100644
--- a/nc2wps/module_definitions.f90
+++ b/nc2wps/module_definitions.f90
@@ -6,6 +6,8 @@ MODULE module_definitions
INTEGER, PARAMETER :: r_k = KIND(1.d0)
REAL(r_k), PARAMETER :: zeroRK = 0.
REAL(r_k), PARAMETER :: oneRK = 1.
+
+ REAL(r_k), PARAMETER :: epsilonv = 1.e-6
REAL, PARAMETER :: CtoK = 273.15
@@ -89,9 +91,18 @@ MODULE module_definitions
! When providing the values, maximum amount of pressure levels to interpolate
INTEGER, PARAMETER :: maxNpres = 100
- ! Amount of input variables
- INTEGER, PARAMETER :: Ninvars = 30
+ ! Amount of standard input variables
+ INTEGER, PARAMETER :: Ninvars = 31
+ ! Amount of extra input variables (Ninvars + 'DZS', 'ZS'
+ INTEGER, PARAMETER :: Nextrainvars = 33
+
+ ! Variable index for 'DZS'
+ INTEGER, PARAMETER :: idzsv = 32
+
+ ! Variable index for 'ZS'
+ INTEGER, PARAMETER :: izsv = 33
+
! ! universal gas constant
! REAL, PARAMETER :: Rstar = 8.3144598
@@ -109,10 +120,30 @@ MODULE module_definitions
! Earth radius WSG84 [km]
REAL(r_k), PARAMETER :: EarthradiiWGS84 = 6371.009
+
+ ! Rd: gas constant of dry air (J deg^-1 kg^-1)
+ REAL(r_k), PARAMETER :: Rd = 287.
+
+ ! R/Cp
+ REAL(r_k), PARAMETER :: rcp = 0.286
+
+ ! p0
+ REAL(r_k), PARAMETER :: p0 = 100000
+
+ ! K --> C temperature transformation
+ REAL(r_k), PARAMETER :: SVPT0 = 273.15
+ ! August-Roche-Magnus approximation
+ REAL(r_k), PARAMETER :: ARM1 = 6.1094
+ REAL(r_k), PARAMETER :: ARM2 = 17.625
+ REAL(r_k), PARAMETER :: ARM3 = 243.04
+
+! Ratio between molecular weights of water and dry air
+ REAL(r_k), PARAMETER :: mol_watdry = 0.622
! Names of the variables to process
- ! name of the variables where [varn]= mask, hurs, huss, qvs, uas, vas, tas, tds, ts, sst, ps, psl,
- ! snd, ci, ua, va, ta, tda, hur, hus, qv, zg, stl1, stl2, stl3, stl4, swvl1, swvl2, swvl3, swvl4n
+ ! name of the variables where [varn]= mask, orog, hurs, huss, qvs, uas, vas, tas, tds, ts, sst, ps,
+ ! psl, snd, ci, ua, va, ta, tda, hur, hus, qv, zg, stl1, stl2, stl3, stl4, swvl1, swvl2, swvl3,
+ ! swvl4n
! Type with all the bsic information of the configuration
TYPE infconfig
@@ -134,7 +165,7 @@ MODULE module_definitions
! list of the CF-names variables names to process
CHARACTER(len=30), DIMENSION(Ninvars) :: cfvarns
! list of variables names to process
- CHARACTER(len=30), DIMENSION(Ninvars) :: invarns
+ CHARACTER(len=30), DIMENSION(Nextrainvars) :: invarns
! Parameters of projection of the data
! version, xfcst, map_source, iproj, is_wind_grid_rel, startloc, NLg, lonres, latres, centlon,
! truelat1, truelat2, earth_radius,
@@ -190,6 +221,10 @@ MODULE module_definitions
INTEGER :: inprojvmask
! extraction of land/sea mask from an other variable
CHARACTER(len=Sm) :: varVland
+ ! Name of orog
+ CHARACTER(len=St) :: invorogn
+ ! Projection of orog
+ INTEGER :: inprojvorog
! Name of hurs
CHARACTER(len=St) :: invhursn
! Projection of hurs
@@ -326,6 +361,14 @@ MODULE module_definitions
CHARACTER(len=St) :: invswvl4n
! Projection of swvl4
INTEGER :: inprojvswvl4
+ ! Name of ZS. Specific for WRFstl, WRFswvl
+ CHARACTER(len=St) :: invzsn
+ ! Projection of ZS
+ INTEGER :: inprojvzs
+ ! Name of DZS. Specific for WRFstl, WRFswvl
+ CHARACTER(len=St) :: invdzsn
+ ! Projection of DZS
+ INTEGER :: inprojvdzs
! top of pressure (for p_top_requested < level(levellen))
INTEGER :: p_top
! Maximum time difference (minutes)
@@ -343,7 +386,7 @@ MODULE module_definitions
! projection of each file
CHARACTER(len=Sl), DIMENSION(maxNfiles) :: infilens
! projection for each variable to process (-1, if is not passed)
- INTEGER, DIMENSION(Ninvars) :: inprojv
+ INTEGER, DIMENSION(Nextrainvars) :: inprojv
! projection of each file
INTEGER, DIMENSION(maxNfiles) :: infileproj
! amount of variables in each projection
@@ -351,28 +394,28 @@ MODULE module_definitions
! amount of files in each projection
INTEGER, DIMENSION(maxNprojs) :: inNpfile
! name of the variables in each projection
- CHARACTER(len=30), DIMENSION(maxNprojs,Ninvars) :: inprojvars
+ CHARACTER(len=30), DIMENSION(maxNprojs,Nextrainvars) :: inprojvars
! amount of opened netCDF files in each projection by variables found
INTEGER, DIMENSION(maxNprojs) :: inNpncids
! index of file in each projection
INTEGER, DIMENSION(maxNprojs,maxNfiles) :: inprojifile
! name of file in each projection
- CHARACTER(len=200), DIMENSION(maxNprojs,maxNfiles) :: inprojfilen
+ CHARACTER(len=Sl), DIMENSION(maxNprojs,maxNfiles) :: inprojfilen
! opened netCDF file in each projection
INTEGER, DIMENSION(maxNprojs,maxNfiles) :: inprojncid
! amount of variables to process per file
INTEGER, DIMENSION(maxNfiles) :: inNfvars
! amount of files with the variables to process
- INTEGER, DIMENSION(Ninvars) :: Nvarinfile
+ INTEGER, DIMENSION(Nextrainvars) :: Nvarinfile
! variables to process located at which i-file
- INTEGER, DIMENSION(Ninvars,maxNfiles) :: varinfile
+ INTEGER, DIMENSION(Nextrainvars,maxNfiles) :: varinfile
! variables to process in each file
- CHARACTER(len=30), DIMENSION(maxNfiles,Ninvars) :: filewithvar
+ CHARACTER(len=30), DIMENSION(maxNfiles,Nextrainvars) :: filewithvar
! variables to process located at which ncid
- INTEGER, DIMENSION(Ninvars,maxNfiles) :: varinncid
+ INTEGER, DIMENSION(Nextrainvars,maxNfiles) :: varinncid
END TYPE infconfig
- ! Type with all the bsic information of the execution of the program
+ ! Type with all the basic information of the execution of the program
TYPE infrun
! Should lon be read
LOGICAL :: computelon
@@ -388,6 +431,8 @@ MODULE module_definitions
LOGICAL, DIMENSION(Ninvars) :: computeinvarns
! Should mask be computed & written
LOGICAL :: computemask
+ ! Should orog be computed & written
+ LOGICAL :: computeorog
! Should hurs be computed & written
LOGICAL :: computehurs
! Should huss be computed & written
diff --git a/nc2wps/module_ncwps.f90 b/nc2wps/module_ncwps.f90
index 5a12ff090a2928141370b165a690a43fa256ecee..2db932c0509dd473dda17e423b60e8a3f6591c02 100644
--- a/nc2wps/module_ncwps.f90
+++ b/nc2wps/module_ncwps.f90
@@ -376,7 +376,7 @@ MODULE module_ncwps
CHARACTER(len=50) :: fname
!!!!!!! Variables
-! height: Height at which the pressure will be obtained [m]
+! pressure: pressure at which the height will be obtained [Pa]
fname = 'hgt_barometric'
@@ -485,6 +485,7 @@ MODULE module_ncwps
END DO
PRINT *, spc // spc // 'mask projection: ', icnf%inprojvmask
PRINT *, spc // spc // 'extraction of land/sea mask from an other variable: ', TRIM(icnf%varVland)
+ PRINT *, spc // spc // 'Projection of orog: ', icnf%inprojvorog
PRINT *, spc // spc // 'Projection of hurs: ', icnf%inprojvhurs
PRINT *, spc // spc // 'Projection of huss: ', icnf%inprojvhuss
PRINT *, spc // spc // 'Projection of qvs: ', icnf%inprojvqvs
@@ -553,6 +554,8 @@ MODULE module_ncwps
SELECT CASE (TRIM(vn))
CASE('mask')
LongName = 'land/sea mask (1: land, 0: sea)'
+ CASE('orog')
+ LongName = 'Orography height above geoide'
CASE('hurs')
LongName = '2m relative humidity'
CASE('huss')
@@ -682,6 +685,13 @@ MODULE module_ncwps
irunf%computemask = .FALSE.
END IF
iv = iv + 1
+ ! orog
+ IF (TRIM(icnf%invorogn) /= 'None' .AND. icnf%inprojvorog == ip) THEN
+ irunf%computeorog = .TRUE.
+ irunf%computeinvarns(iv) = .TRUE.
+ ELSE
+ irunf%computeorog = .FALSE.
+ END IF
! hurs
IF (TRIM(icnf%invhursn) /= 'None' .AND. icnf%inprojvhurs == ip) THEN
irunf%computehurs = .TRUE.
@@ -1043,7 +1053,7 @@ MODULE module_ncwps
ELSE IF (extraconfv(1) == 'extrapmean') THEN
CALL ExpectArgs(extraconf, 'extrap,[varn],[projvar],[varmeann],[type]', ',')
varn2 = TRIM(extraconfv(4))
- CALL multisearch_var(dbg, nfiles, ncids, TRIM(varn2), Nfound2, foundfns2, foundncids2)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, TRIM(varn2), Nfound2, foundfns2, foundncids2)
typev = TRIM(extraconfv(5))
ELSE
Navailtypev = 3
@@ -1071,9 +1081,11 @@ MODULE module_ncwps
" found at unit ", foundncids(1:Nfound)
IF (ALLOCATED(dimts)) DEALLOCATE(dimts)
ALLOCATE(dimts(Nfound))
+ dimts = 0
DO i=1, Nfound
CALL read_dimlength (foundncids(i), TRIM(indtimen), dimts(i))
+ PRINT *,' Lluis 0 id:', foundncids(i), 'dimt', dimts(i)
END DO
IF ( (extraconfv(1) == 'constant') .OR. (extraconfv(1) == 'extrap') ) THEN
@@ -1086,6 +1098,7 @@ MODULE module_ncwps
ALLOCATE(new4D(dimx, dimy, Nextr, dimts(i)))
! How to extrapolate ?
+ PRINT *,' Lluis id:', foundncids(i), 'dimt', dimts(i)
CALL compute_extrapol(foundncids(i), dimx, dimy, dimts(i), extraconfv(2), indtimen, typev, &
Nextr, extrvals, var4D)
@@ -1166,10 +1179,11 @@ MODULE module_ncwps
END IF
- DEALLOCATE(extraconfv)
- DEALLOCATE(dimts)
- DEALLOCATE(var4D)
- DEALLOCATE(new4d)
+ IF (ALLOCATED(extraconfv)) DEALLOCATE(extraconfv)
+ IF (ALLOCATED(availtypev)) DEALLOCATE(availtypev)
+ IF (ALLOCATED(dimts)) DEALLOCATE(dimts)
+ IF (ALLOCATED(var4D)) DEALLOCATE(var4D)
+ IF (ALLOCATED(new4d)) DEALLOCATE(new4d)
RETURN
@@ -1182,14 +1196,15 @@ MODULE module_ncwps
invlonn, invlatn, invtimen, invplevn, invmodlevn, &
version, xfcst, map_source, iproj, is_wind_grid_rel, startloc, NLg, lonres, latres, centlon, &
truelat1, truelat2, earth_radius, &
- invmaskn, invhursn, invhussn, invqvsn, invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, &
- invpsn, invpsln, invsndn, invcin, invuan, invvan, invtan, invtdan, invhurn, invhusn, invqvn, &
- invzgn, invstl1n, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, invswvl4n, &
- inprojvmask, inprojvhurs, inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, &
- inprojvtds, inprojvts, inprojvsst, inprojvps, inprojvpsl, inprojvsnd, inprojvci, inprojvua, &
- inprojvva, inprojvta, inprojvtda, inprojvhur, inprojvhus, inprojvqv, inprojvzg, inprojvstl1, &
- inprojvstl2, inprojvstl3, inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4, &
- icnf, dbg)
+ invmaskn, invorogn, invhursn, invhussn, invqvsn, invuasn, invvasn, invtasn, invtdsn, invtsn, &
+ invsstn, invpsn, invpsln, invsndn, invcin, invuan, invvan, invtan, invtdan, invhurn, invhusn, &
+ invqvn, invzgn, invstl1n, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, &
+ invswvl4n, inptua, inptva, inptta, inpttda, inptqv, inpthur, inpthus, inptzg, &
+ inprojvmask, inprojvorog, inprojvhurs, inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, &
+ inprojvtas, inprojvtds, inprojvts, inprojvsst, inprojvps, inprojvpsl, inprojvsnd, inprojvci, &
+ inprojvua, inprojvva, inprojvta, inprojvtda, inprojvhur, inprojvhus, inprojvqv, inprojvzg, &
+ inprojvstl1, inprojvstl2, inprojvstl3, inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3, &
+ inprojvswvl4, icnf, dbg)
! Subroutine to initialize pojection dimension-values
IMPLICIT NONE
@@ -1213,24 +1228,30 @@ MODULE module_ncwps
CHARACTER(len=8), DIMENSION(Nprojs), INTENT(in) :: startloc
REAL, DIMENSION(Nprojs), INTENT(in) :: lonres, latres, centlon, truelat1, &
truelat2, earth_radius
- CHARACTER(len=St), INTENT(in) :: invmaskn, invhursn, invhussn, invqvsn, &
- invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, invuan, &
- invvan, invtan, invtdan, invhurn, invhusn, invqvn, invzgn, invstl1n, invstl2n, invstl3n, &
+ CHARACTER(len=St), INTENT(in) :: invmaskn, invorogn, invhursn, invhussn, &
+ invqvsn, invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, &
+ invuan, invvan, invtan, invtdan, invhurn, invhusn, invqvn, invzgn, invstl1n, invstl2n, invstl3n,&
invstl4n, invswvl1n, invswvl2n, invswvl3n, invswvl4n
- INTEGER, INTENT(in) :: inprojvmask, inprojvhurs, inprojvhuss, &
- inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, inprojvsst, inprojvps, &
- inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, inprojvta, inprojvtda, inprojvhur, &
- inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2, inprojvstl3, inprojvstl4, &
- inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4
+ CHARACTER(len=Su), INTENT(in) :: inptua, inptva, inptta, inpttda, inptqv, &
+ inpthur, inpthus, inptzg
+ INTEGER, INTENT(in) :: inprojvmask, inprojvorog, inprojvhurs, &
+ inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, inprojvsst, &
+ inprojvps, inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, inprojvta, inprojvtda, &
+ inprojvhur, inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2, inprojvstl3, &
+ inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4
LOGICAL, INTENT(in) :: dbg
TYPE(infconfig), INTENT(inout) :: icnf
! Local
- INTEGER :: iv, ip, iiNp, inv, iiv
+ INTEGER :: iv, ivi, ip, iiNp, inv, iiv
INTEGER :: Npv, ncid, dtimev, Nfncid
+ INTEGER :: Nindims, iind
+ INTEGER :: Nfproj
INTEGER, DIMENSION(nfiles) :: fifiles
INTEGER, DIMENSION(nfiles) :: fncids
+ CHARACTER(len=Sm), DIMENSION(100) :: indimns
CHARACTER(len=St) :: invn
+ LOGICAL :: inproj
CHARACTER(len=Ss) :: fname
!!!!!!! Variables
@@ -1240,9 +1261,10 @@ MODULE module_ncwps
! Nintpres: amount of passed pressure-levels for p-level interpolation
! ind[lon/lat/time/plev/modlev]n: name of the x, y, z, t dimensions for each projection
! Nvars: amount of variables to process (22)
-! inv[varn]n: name of the variables where [varn]= mask, hurs, huss, qvs, uas, vas, tas, tds, ts, sst,
-! ps, psl, snd, ci, ua, va, ta, tda, hur, hus, qv, zg, stl1, stl2, stl3, stl4, swvl1, swvl2, swvl3,
-! swvl4
+! inv[varn]n: name of the variables where [varn]= mask, orog, hurs, huss, qvs, uas, vas, tas, tds, ts,
+! sst, ps, psl, snd, ci, ua, va, ta, tda, hur, hus, qv, zg, stl1, stl2, stl3, stl4, swvl1, swvl2,
+! swvl3, swvl4
+! inpt[varn]: assigned type of vertical levels of the variables
! inprojv[varn]: assigned projection of the variables
! [lon/lat/plev/modlev]lenproj: length of the dimensions in each projection
! invarns: list of variables to process
@@ -1282,35 +1304,36 @@ MODULE module_ncwps
! List of cf-convention names of the variables to process (ordered as their information is loaded)
icnf%cfvarns(1) = 'mask'
- icnf%cfvarns(2) = 'hurs'
- icnf%cfvarns(3) = 'huss'
- icnf%cfvarns(4) = 'qvs'
- icnf%cfvarns(5) = 'uas'
- icnf%cfvarns(6) = 'vas'
- icnf%cfvarns(7) = 'tas'
- icnf%cfvarns(8) = 'tds'
- icnf%cfvarns(9) = 'ts'
- icnf%cfvarns(10) = 'sst'
- icnf%cfvarns(11) = 'ps'
- icnf%cfvarns(12) = 'psl'
- icnf%cfvarns(13) = 'snd'
- icnf%cfvarns(14) = 'ci'
- icnf%cfvarns(15) = 'ua'
- icnf%cfvarns(16) = 'va'
- icnf%cfvarns(17) = 'ta'
- icnf%cfvarns(18) = 'tda'
- icnf%cfvarns(19) = 'hur'
- icnf%cfvarns(20) = 'hus'
- icnf%cfvarns(21) = 'qv'
- icnf%cfvarns(22) = 'zg'
- icnf%cfvarns(23) = 'stl1'
- icnf%cfvarns(24) = 'stl2'
- icnf%cfvarns(25) = 'stl3'
- icnf%cfvarns(26) = 'stl4'
- icnf%cfvarns(27) = 'swvl1'
- icnf%cfvarns(28) = 'swvl2'
- icnf%cfvarns(29) = 'swvl3'
- icnf%cfvarns(30) = 'swvl4'
+ icnf%cfvarns(2) = 'orog'
+ icnf%cfvarns(3) = 'hurs'
+ icnf%cfvarns(4) = 'huss'
+ icnf%cfvarns(5) = 'qvs'
+ icnf%cfvarns(6) = 'uas'
+ icnf%cfvarns(7) = 'vas'
+ icnf%cfvarns(8) = 'tas'
+ icnf%cfvarns(9) = 'tds'
+ icnf%cfvarns(10) = 'ts'
+ icnf%cfvarns(11) = 'sst'
+ icnf%cfvarns(12) = 'ps'
+ icnf%cfvarns(13) = 'psl'
+ icnf%cfvarns(14) = 'snd'
+ icnf%cfvarns(15) = 'ci'
+ icnf%cfvarns(16) = 'ua'
+ icnf%cfvarns(17) = 'va'
+ icnf%cfvarns(18) = 'ta'
+ icnf%cfvarns(19) = 'tda'
+ icnf%cfvarns(20) = 'hur'
+ icnf%cfvarns(21) = 'hus'
+ icnf%cfvarns(22) = 'qv'
+ icnf%cfvarns(23) = 'zg'
+ icnf%cfvarns(24) = 'stl1'
+ icnf%cfvarns(25) = 'stl2'
+ icnf%cfvarns(26) = 'stl3'
+ icnf%cfvarns(27) = 'stl4'
+ icnf%cfvarns(28) = 'swvl1'
+ icnf%cfvarns(29) = 'swvl2'
+ icnf%cfvarns(30) = 'swvl3'
+ icnf%cfvarns(31) = 'swvl4'
icnf%invarns = ''
icnf%inprojv = -1
@@ -1356,7 +1379,7 @@ MODULE module_ncwps
iv = 0
! Going through all variables
- !mask
+ !1. mask
iv = iv + 1
icnf%invmaskn = invmaskn
IF (TRIM(invmaskn) /= 'None' .AND. TRIM(invmaskn) /= 'varVland') THEN
@@ -1368,7 +1391,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1376,20 +1399,85 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invmaskn)
icnf%inprojv(iv) = -1
END IF
- !hurs
+ !2. orog
+ iv = iv + 1
+ icnf%invorogn = invorogn
+ IF (TRIM(invorogn) /= 'None') THEN
+ invn = icnf%invorogn
+ ip = inprojvorog
+ icnf%inprojvorog = ip
+ inv = icnf%inNpvars(ip) + 1
+ icnf%invarns(iv) = TRIM(invn)
+ icnf%inprojv(iv) = ip
+ icnf%inNpvars(ip) = inv
+ icnf%inprojvars(ip,inv) = TRIM(invn)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ iiNp = icnf%inNpncids(ip) + 1
+ icnf%Nvarinfile(iv) = Nfncid
+ icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
+ icnf%varinncid(iv,1:Nfncid) = fncids(1:Nfncid)
+ icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
+ DO iiv=1, Nfncid
+ icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
+ END IF
+ icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
+ END DO
+ ELSE
+ icnf%invarns(iv) = TRIM(invorogn)
+ icnf%inprojv(iv) = -1
+ END IF
+ !3. hurs
iv = iv + 1
icnf%invhursn = invhursn
IF (TRIM(invhursn) /= 'None') THEN
@@ -1401,7 +1489,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1409,20 +1497,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invhursn)
icnf%inprojv(iv) = -1
END IF
- !huss
+ !4. huss
iv = iv + 1
icnf%invhussn = invhussn
IF (TRIM(invhussn) /= 'None') THEN
@@ -1434,7 +1538,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1442,20 +1546,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invhussn)
icnf%inprojv(iv) = -1
END IF
- !qvs
+ !5. qvs
iv = iv + 1
icnf%invqvsn = invqvsn
IF (TRIM(invqvsn) /= 'None') THEN
@@ -1467,7 +1587,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1475,20 +1595,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invqvsn)
icnf%inprojv(iv) = -1
END IF
- !uas
+ !6. uas
iv = iv + 1
icnf%invuasn = invuasn
IF (TRIM(invuasn) /= 'None') THEN
@@ -1500,7 +1636,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1508,20 +1644,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invuasn)
icnf%inprojv(iv) = -1
END IF
- !vas
+ !7. vas
iv = iv + 1
icnf%invvasn = invvasn
IF (TRIM(invvasn) /= 'None') THEN
@@ -1533,7 +1685,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1541,20 +1693,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invvasn)
icnf%inprojv(iv) = -1
END IF
- !tas
+ !8. tas
iv = iv + 1
icnf%invtasn = invtasn
IF (TRIM(invtasn) /= 'None') THEN
@@ -1566,7 +1734,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1574,20 +1742,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invtasn)
icnf%inprojv(iv) = -1
END IF
- !tds
+ !9. tds
iv = iv + 1
icnf%invtdsn = invtdsn
IF (TRIM(invtdsn) /= 'None') THEN
@@ -1599,7 +1783,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1607,20 +1791,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invtdsn)
icnf%inprojv(iv) = -1
END IF
- !ts
+ !10. ts
iv = iv + 1
icnf%invtsn = invtsn
IF (TRIM(invtsn) /= 'None') THEN
@@ -1632,7 +1832,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1640,20 +1840,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invtsn)
icnf%inprojv(iv) = -1
END IF
- !sst
+ !11. sst
iv = iv + 1
icnf%invsstn = invsstn
IF (TRIM(invsstn) /= 'None') THEN
@@ -1665,7 +1881,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1673,20 +1889,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invsstn)
icnf%inprojv(iv) = -1
END IF
- !ps
+ !12. ps
iv = iv + 1
icnf%invpsn = invpsn
IF (TRIM(invpsn) /= 'None') THEN
@@ -1698,7 +1930,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1706,20 +1938,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invpsn)
icnf%inprojv(iv) = -1
END IF
- !psl
+ !13. psl
iv = iv + 1
icnf%invpsln = invpsln
IF (TRIM(invpsln) /= 'None') THEN
@@ -1731,7 +1979,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1739,20 +1987,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invpsln)
icnf%inprojv(iv) = -1
END IF
- !snd
+ !14. snd
iv = iv + 1
icnf%invsndn = invsndn
IF (TRIM(invsndn) /= 'None') THEN
@@ -1764,7 +2028,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1772,20 +2036,36 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invsndn)
icnf%inprojv(iv) = -1
END IF
- !ci
+ !15. ci
iv = iv + 1
icnf%invcin = invcin
IF (TRIM(invcin) /= 'None') THEN
@@ -1797,7 +2077,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1805,22 +2085,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invcin)
icnf%inprojv(iv) = -1
END IF
- !ua
+ !16. ua
iv = iv + 1
icnf%invuan = invuan
+ IF (TRIM(inptua) /= 'plev') icnf%inptua = inptua
IF (TRIM(invuan) /= 'None') THEN
invn = icnf%invuan
ip = inprojvua
@@ -1830,7 +2127,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1838,22 +2135,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invuan)
icnf%inprojv(iv) = -1
END IF
- !va
+ !17. va
iv = iv + 1
icnf%invvan = invvan
+ IF (TRIM(inptva) /= 'plev') icnf%inptva = inptva
IF (TRIM(invvan) /= 'None') THEN
invn = icnf%invvan
ip = inprojvva
@@ -1863,7 +2177,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1871,23 +2185,40 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invvan)
icnf%inprojv(iv) = -1
END IF
- !ta
+ !18. ta
iv = iv + 1
icnf%invtan = invtan
- IF (TRIM(invtan) /= 'None') THEN
+ IF (TRIM(inptta) /= 'plev') icnf%inptta = inptta
+ IF (TRIM(invtan) /= 'None' .AND. TRIM(invtan) /= 'WRFta') THEN
invn = icnf%invtan
ip = inprojvta
icnf%inprojvta = ip
@@ -1896,7 +2227,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1904,22 +2235,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invtan)
icnf%inprojv(iv) = -1
END IF
- !tda
+ !19. tda
iv = iv + 1
icnf%invtdan = invtdan
+ IF (TRIM(inpttda) /= 'plev') icnf%inpttda = inpttda
IF (TRIM(invtdan) /= 'None') THEN
invn = icnf%invtdan
ip = inprojvtda
@@ -1929,7 +2277,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1937,22 +2285,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invtdan)
icnf%inprojv(iv) = -1
END IF
- !hur
+ !20. hur
iv = iv + 1
icnf%invhurn = invhurn
+ IF (TRIM(inpthur) /= 'plev') icnf%inpthur = inpthur
IF (TRIM(invhurn) /= 'None') THEN
invn = icnf%invhurn
ip = inprojvhur
@@ -1962,7 +2327,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -1970,22 +2335,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invhurn)
icnf%inprojv(iv) = -1
END IF
- !hus
+ !21. hus
iv = iv + 1
icnf%invhusn = invhusn
+ IF (TRIM(inpthus) /= 'plev') icnf%inpthus = inpthus
IF (TRIM(invhusn) /= 'None') THEN
invn = icnf%invhusn
ip = inprojvhus
@@ -1995,7 +2377,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2003,22 +2385,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invhusn)
icnf%inprojv(iv) = -1
END IF
- !qv
+ !22. qv
iv = iv + 1
icnf%invqvn = invqvn
+ IF (TRIM(inptqv) /= 'plev') icnf%inptqv = inptqv
IF (TRIM(invqvn) /= 'None') THEN
invn = icnf%invqvn
ip = inprojvqv
@@ -2028,7 +2427,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2036,23 +2435,40 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invqvn)
icnf%inprojv(iv) = -1
END IF
- !zg
+ !23. zg
iv = iv + 1
icnf%invzgn = invzgn
- IF (TRIM(invzgn) /= 'None') THEN
+ IF (TRIM(inptzg) /= 'plev') icnf%inptzg = inptzg
+ IF (TRIM(invzgn) /= 'None' .AND. TRIM(invzgn) /= 'WRFgeop') THEN
invn = icnf%invzgn
ip = inprojvzg
icnf%inprojvzg = ip
@@ -2061,7 +2477,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2069,23 +2485,40 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invzgn)
icnf%inprojv(iv) = -1
END IF
- !stl1
+ !24. stl1
iv = iv + 1
icnf%invstl1n = invstl1n
- IF (TRIM(invstl1n) /= 'None' .AND. TRIM(invstl1n) /= 'tskextrap') THEN
+ IF (TRIM(invstl1n) /= 'None' .AND. TRIM(invstl1n) /= 'tskextrap' .AND. &
+ TRIM(invstl1n) /= 'WRFstl') THEN
invn = icnf%invstl1n
ip = inprojvstl1
icnf%inprojvstl1 = ip
@@ -2094,7 +2527,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2102,23 +2535,85 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invstl1n)
icnf%inprojv(iv) = -1
+ ! Looking for file with 'ZS' if it is in another file, it does not get assigned to a given
+ ! projection
+ IF (TRIM(invstl1n) == 'WRFstl') THEN
+ ivi = izsv
+ invn = 'ZS'
+ ip = inprojvstl1
+ icnf%inprojvstl1 = ip
+ inv = icnf%inNpvars(ip) + 1
+ icnf%invarns(ivi) = TRIM(invn)
+ icnf%inprojv(ivi) = ip
+ icnf%inNpvars(ip) = inv
+ icnf%inprojvars(ip,inv) = TRIM(invn)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ iiNp = icnf%inNpncids(ip) + 1
+ icnf%Nvarinfile(ivi) = Nfncid
+ icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
+ icnf%varinncid(ivi,1:Nfncid) = fncids(1:Nfncid)
+ icnf%varinfile(ivi,1:Nfncid) = fifiles(1:Nfncid)
+ DO iiv=1, Nfncid
+ icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
+ END IF
+ icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
+ END DO
+ END IF
END IF
- !stl2
+ !25. stl2
iv = iv + 1
icnf%invstl2n = invstl2n
- IF (TRIM(invstl2n) /= 'None') THEN
+ IF (TRIM(invstl2n) /= 'None' .AND. TRIM(invstl2n) /= 'WRFstl') THEN
invn = icnf%invstl2n
ip = inprojvstl2
icnf%inprojvstl2 = ip
@@ -2127,7 +2622,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2135,23 +2630,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invstl2n)
icnf%inprojv(iv) = -1
END IF
- !stl3
+ !26. stl3
iv = iv + 1
icnf%invstl3n = invstl3n
- IF (TRIM(invstl3n) /= 'None') THEN
+ IF (TRIM(invstl3n) /= 'None' .AND. TRIM(invstl3n) /= 'WRFstl') THEN
invn = icnf%invstl3n
ip = inprojvstl3
icnf%inprojvstl3 = ip
@@ -2160,7 +2671,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2168,23 +2679,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invstl3n)
icnf%inprojv(iv) = -1
END IF
- !stl4
+ !27. stl4
iv = iv + 1
icnf%invstl4n = invstl4n
- IF (TRIM(invstl4n) /= 'None') THEN
+ IF (TRIM(invstl4n) /= 'None' .AND. TRIM(invstl4n) /= 'WRFstl') THEN
invn = icnf%invstl4n
ip = inprojvstl4
icnf%inprojvstl4 = ip
@@ -2193,7 +2720,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2201,23 +2728,40 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invstl4n)
icnf%inprojv(iv) = -1
END IF
- !swvl1
+ !28. swvl1
iv = iv + 1
icnf%invswvl1n = invswvl1n
- IF (TRIM(invswvl1n) /= 'None' .AND. TRIM(invswvl1n) /= 'mrsosextrap') THEN
+ IF (TRIM(invswvl1n) /= 'None' .AND. TRIM(invswvl1n) /= 'mrsosextrap' .AND. &
+ TRIM(invswvl1n) /= 'WRFswvl') THEN
invn = icnf%invswvl1n
ip = inprojvswvl1
icnf%inprojvswvl1 = ip
@@ -2226,7 +2770,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2234,23 +2778,140 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invswvl1n)
icnf%inprojv(iv) = -1
+ icnf%invarns(iv) = TRIM(invswvl1n)
+ icnf%inprojv(iv) = -1
+ ! Looking for file with 'DZS' if it is in another file, it does not get assigned to a given
+ ! projection
+ IF (TRIM(invswvl1n) == 'WRFswvl') THEN
+ ! Looking for the presence of 'ZS'
+ inproj = .FALSE.
+ DO iiv=1, icnf%inNpvars(ip)
+ IF (TRIM(icnf%inprojvars(ip,inv)) == 'ZS') THEN
+ inproj = .TRUE.
+ EXIT
+ END IF
+ END DO
+ IF (.NOT.inproj) THEN
+ ivi = izsv
+ invn = 'ZS'
+ ip = inprojvstl1
+ icnf%inprojvstl1 = ip
+ inv = icnf%inNpvars(ip) + 1
+ icnf%invarns(ivi) = TRIM(invn)
+ icnf%inprojv(ivi) = ip
+ icnf%inNpvars(ip) = inv
+ icnf%inprojvars(ip,inv) = TRIM(invn)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ iiNp = icnf%inNpncids(ip) + 1
+ icnf%Nvarinfile(ivi) = Nfncid
+ icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
+ icnf%varinncid(ivi,1:Nfncid) = fncids(1:Nfncid)
+ icnf%varinfile(ivi,1:Nfncid) = fifiles(1:Nfncid)
+ DO iiv=1, Nfncid
+ icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " //ItoS(ip), " ncid:",&
+ fncids(iiv)
+ END IF
+ END IF
+ icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
+ END DO
+ END IF
+
+ ivi = idzsv
+ invn = 'DZS'
+ ip = inprojvstl1
+ icnf%inprojvstl1 = ip
+ inv = icnf%inNpvars(ip) + 1
+ icnf%invarns(ivi) = TRIM(invn)
+ icnf%inprojv(ivi) = ip
+ icnf%inNpvars(ip) = inv
+ icnf%inprojvars(ip,inv) = TRIM(invn)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ iiNp = icnf%inNpncids(ip) + 1
+ icnf%Nvarinfile(ivi) = Nfncid
+ icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
+ icnf%varinncid(ivi,1:Nfncid) = fncids(1:Nfncid)
+ icnf%varinfile(ivi,1:Nfncid) = fifiles(1:Nfncid)
+ DO iiv=1, Nfncid
+ icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
+ END IF
+ icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
+ END DO
+ END IF
END IF
- !swvl2
+ !29. swvl2
iv = iv + 1
icnf%invswvl2n = invswvl2n
- IF (TRIM(invswvl2n) /= 'None') THEN
+ IF (TRIM(invswvl2n) /= 'None' .AND. TRIM(invswvl2n) /= 'WRFswvl') THEN
invn = icnf%invswvl2n
ip = inprojvswvl2
icnf%inprojvswvl2 = ip
@@ -2259,7 +2920,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2267,23 +2928,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invswvl2n)
icnf%inprojv(iv) = -1
END IF
- !swvl3
+ !30. swvl3
iv = iv + 1
icnf%invswvl3n = invswvl3n
- IF (TRIM(invswvl3n) /= 'None') THEN
+ IF (TRIM(invswvl3n) /= 'None' .AND. TRIM(invswvl3n) /= 'WRFswvl') THEN
invn = icnf%invswvl3n
ip = inprojvswvl3
icnf%inprojvswvl3 = ip
@@ -2292,7 +2969,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2300,23 +2977,39 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
icnf%invarns(iv) = TRIM(invswvl3n)
icnf%inprojv(iv) = -1
END IF
- !swvl4
+ !31. swvl4
iv = iv + 1
icnf%invswvl4n = invswvl4n
- IF (TRIM(invswvl4n) /= 'None') THEN
+ IF (TRIM(invswvl4n) /= 'None' .AND. TRIM(invswvl4n) /= 'WRFswvl') THEN
invn = icnf%invswvl4n
ip = inprojvswvl4
icnf%inprojvswvl4 = ip
@@ -2325,7 +3018,7 @@ MODULE module_ncwps
icnf%inprojv(iv) = ip
icnf%inNpvars(ip) = inv
icnf%inprojvars(ip,inv) = TRIM(invn)
- CALL multisearch_var(dbg, nfiles, ncids, invn, Nfncid, fifiles, fncids)
+ CALL multisearch_var(dbg, fname, nfiles, ncids, invn, Nfncid, fifiles, fncids)
iiNp = icnf%inNpncids(ip) + 1
icnf%Nvarinfile(iv) = Nfncid
icnf%inNpncids(ip) = icnf%inNpncids(ip) + Nfncid
@@ -2333,13 +3026,29 @@ MODULE module_ncwps
icnf%varinfile(iv,1:Nfncid) = fifiles(1:Nfncid)
DO iiv=1, Nfncid
icnf%inNfvars(fifiles(iiv)) = icnf%inNfvars(fifiles(iiv)) + 1
- IF (icnf%infileproj(fifiles(iiv)) == -1) THEN
+ ! Assigning files per projection....
+ IF (icnf%inNpfile(ip) == 0) THEN
icnf%infileproj(fifiles(iiv)) = ip
- icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inNpfile(ip) = 1
icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ ELSE
+ Nfproj = icnf%inNpfile(ip)
+ IF (.NOT.isInlistS(Nfproj,icnf%inprojfilen(ip,1:Nfproj),filens(fifiles(iiv)))) THEN
+ icnf%infileproj(fifiles(iiv)) = ip
+ icnf%inNpfile(ip) = icnf%inNpfile(ip) + 1
+ icnf%inprojifile(ip,icnf%inNpfile(ip)) = fifiles(iiv)
+ icnf%inprojfilen(ip,icnf%inNpfile(ip)) = filens(fifiles(iiv))
+ icnf%inprojncid(ip,icnf%inNpfile(ip)) = fncids(iiv)
+ IF (dbg) PRINT *,' ' // TRIM(fname) // ": Adding file number: ", fifiles(iiv), &
+ " named '" // TRIM(filens(fifiles(iiv))) // "' in projection " // ItoS(ip), " ncid:", &
+ fncids(iiv)
+ END IF
END IF
- icnf%inprojfilen(ip,iiNp+iiv) = filens(fifiles(iiv))
icnf%filewithvar(fifiles(iiv),icnf%inNfvars(fifiles(iiv))) = TRIM(invn)
END DO
ELSE
@@ -2379,13 +3088,37 @@ MODULE module_ncwps
DO iv= 1, icnf%inNpfile(ip)
ncid = icnf%inprojncid(ip,iv)
IF (icnf%lonlenproj(ip) == -1) THEN
+ IF (.NOT. isdim_infile(filens(icnf%inprojifile(ip,iv)), indlonn(ip))) THEN
+ PRINT *,TRIM(errormsg)
+ PRINT *,' ' // TRIM(fname) // ": longitud dimension named '" // TRIM(indlonn(ip)) // &
+ "' does not exist in file'" // TRIM(filens(icnf%inprojifile(ip,iv))) // "' !!"
+ CALL all_dims(ncid, Nindims, indimns)
+ PRINT *,' available ones:', (TRIM(indimns(iind))//', ',iind=1,Nindims)
+ STOP -1
+ END IF
CALL read_dimlength (ncid, TRIM(indlonn(ip)), icnf%lonlenproj(ip))
+ IF (.NOT. isdim_infile(filens(icnf%inprojifile(ip,iv)), indlatn(ip))) THEN
+ PRINT *,TRIM(errormsg)
+ PRINT *,' ' // TRIM(fname) // ": latitud dimension named '" // TRIM(indlatn(ip)) // &
+ "' does not exist in file'" // TRIM(filens(icnf%inprojifile(ip,iv))) // "' !!"
+ CALL all_dims(ncid, Nindims, indimns)
+ PRINT *,' available ones:', (TRIM(indimns(iind))//', ',iind=1,Nindims)
+ STOP -1
+ END IF
CALL read_dimlength (ncid, TRIM(indlatn(ip)), icnf%latlenproj(ip))
END IF
! In order to avoid to miss the largest amount of time-steps, we need to loop over all variables
! IF ( (lonlenproj(ip) == -1) .AND. ((TRIM(indplevn) /= 'None') .AND. (plevlenproj(ip) == -1)) &
! .AND. ((TRIM(indmodlevn) /= 'None') .AND. (modlevlenproj(ip) == -1)) ) EXIT
+ IF (.NOT.isdim_infile(filens(icnf%inprojifile(ip,iv)), indtimen(ip))) THEN
+ PRINT *,TRIM(errormsg)
+ PRINT *,' ' // TRIM(fname) // ": time dimension named '" // TRIM(indtimen(ip)) // &
+ "' does not exist in file'" // TRIM(filens(icnf%inprojifile(ip,iv))) // "' !!"
+ CALL all_dims(ncid, Nindims, indimns)
+ PRINT *,' available ones:', (TRIM(indimns(iind))//', ',iind=1,Nindims)
+ STOP -1
+ END IF
CALL read_dimlength (ncid, TRIM(indtimen(ip)), dtimev)
IF (dtimev > icnf%timelenproj(ip)) THEN
icnf%timelenproj(ip) = dtimev
@@ -2431,19 +3164,19 @@ MODULE module_ncwps
END SUBROUTINE Init_projdims
- SUBROUTINE Init_values(inNskiplev, invmaskn, varVland, invhursn, invhussn, invqvsn, invuasn, &
- invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, invtdan, invstl1n, &
- tskextrap, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, invswvl4n, mrsosextrap, &
- inptua, inptva, inptta, inpttda, inpthur, inpthus, inptqv, inptzg, p_top, maxtimediff, &
- itpt, jtpt, ktpt, ltpt, dbg, iconf)
+ SUBROUTINE Init_values(inNskiplev, invmaskn, varVland, invorogn, invhursn, invhussn, invqvsn, &
+ invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, invtdan, &
+ invstl1n, tskextrap, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, invswvl4n, &
+ mrsosextrap, inptua, inptva, inptta, inpttda, inpthur, inpthus, inptqv, inptzg, p_top, &
+ maxtimediff, itpt, jtpt, ktpt, ltpt, dbg, iconf)
! Subroutine to initialize values
IMPLICIT NONE
- CHARACTER(len=*), INTENT(out) :: invmaskn, invhursn, invhussn, invqvsn, &
- invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, invtdan, &
- invstl1n, tskextrap, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, invswvl4n, &
- mrsosextrap
+ CHARACTER(len=*), INTENT(out) :: invmaskn, invorogn, invhursn, invhussn, &
+ invqvsn, invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, &
+ invtdan, invstl1n, tskextrap, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, &
+ invswvl4n, mrsosextrap
CHARACTER(len=*), INTENT(out) :: inptua, inptva, inptta, inpttda, inpthur, &
inpthus, inptqv, inptzg
INTEGER, INTENT(out) :: inNskiplev, p_top, maxtimediff, itpt, &
@@ -2458,6 +3191,7 @@ MODULE module_ncwps
inNskiplev = 0
invmaskn = 'None'
varVland = 'sst,1,-9999.,eq'
+ invorogn = 'None'
invhursn = 'None'
invhussn = 'None'
invqvsn = 'None'
@@ -2501,6 +3235,7 @@ MODULE module_ncwps
iconf%inNskiplev = 0
iconf%invmaskn = 'None'
iconf%varVland = 'sst,1,-9999.,eq'
+ iconf%invorogn = 'None'
iconf%invhursn = 'None'
iconf%invhussn = 'None'
iconf%invqvsn = 'None'
@@ -2546,10 +3281,10 @@ MODULE module_ncwps
END SUBROUTINE Init_values
SUBROUTINE Init_proj(version, xfcst, map_source, iproj, is_wind_grid_rel, startloc, NLg, &
- lonres, latres, centlon, truelat1, truelat2, earth_radius, inprojvmask, inprojvhurs, inprojvhuss, &
- inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, inprojvsst, inprojvps, &
- inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, inprojvta, inprojvtda, inprojvhur, &
- inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2, inprojvstl3, inprojvstl4, &
+ lonres, latres, centlon, truelat1, truelat2, earth_radius, inprojvmask, inprojvorog, inprojvhurs, &
+ inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, inprojvsst, &
+ inprojvps, inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, inprojvta, inprojvtda, &
+ inprojvhur, inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2, inprojvstl3, inprojvstl4, &
inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4, &
indtimen, indlatn, indlonn, indplevn, indmodlevn, invtimen, invlatn, invlonn, invplevn, &
invmodlevn, iconf)
@@ -2557,11 +3292,11 @@ MODULE module_ncwps
IMPLICIT NONE
- INTEGER, INTENT(out) :: inprojvmask, inprojvhurs, inprojvhuss, &
- inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, inprojvsst, inprojvps, &
- inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, inprojvta, inprojvtda, inprojvhur, &
- inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2, inprojvstl3, inprojvstl4, &
- inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4
+ INTEGER, INTENT(out) :: inprojvmask, inprojvorog, inprojvhurs, &
+ inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, inprojvsst, &
+ inprojvps, inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, inprojvta, inprojvtda, &
+ inprojvhur, inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2, inprojvstl3, &
+ inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4
CHARACTER(len=32), DIMENSION(maxNprojs), INTENT(out) :: map_source
CHARACTER(len=8), DIMENSION(maxNprojs), INTENT(out) :: startloc
INTEGER, DIMENSION(maxNprojs), INTENT(out) :: version, iproj, NLg
@@ -2577,6 +3312,7 @@ MODULE module_ncwps
fname = 'Init_proj'
inprojvmask = 1
+ inprojvorog = 1
inprojvhurs = 1
inprojvhuss = 1
inprojvqvs = 1
@@ -2631,6 +3367,7 @@ MODULE module_ncwps
invmodlevn = 'None'
iconf%inprojvmask = 1
+ iconf%inprojvorog = 1
iconf%inprojvhurs = 1
iconf%inprojvhuss = 1
iconf%inprojvqvs = 1
@@ -2839,9 +3576,9 @@ MODULE module_ncwps
fname = 'variable_units'
- availvars = 'hgt, hur, hurs, hus, huss, landsea, mrsos, press, ps, psl, qv, qvs, ci, snow, ' // &
- 'snowd, snowden, snowec, sst, stl1, stl2, stl3, stl4, swvl1, swvl2, swvl3, swvl4, ta, tas, ' // &
- 'tda, tds, tos, ts, tsl, uas, ua, vas, va, zg, zgs'
+ availvars = 'hgt, hur, hurs, hus, huss, landsea, mrsos, orog, pres, presb, press, ps, psl, ' // &
+ 'qv, qvs, ci, snow, snowd, snowden, snowec, sst, stl1, stl2, stl3, stl4, swvl1, swvl2, '// &
+ 'swvl3, swvl4, ta, tas, tda, tds, tos, ts, tsl, uas, ua, vas, va, zg, zgs'
variable: SELECT CASE (TRIM(varn))
CASE ('zg')
@@ -2886,6 +3623,12 @@ MODULE module_ncwps
variable_units = 'm' // TRIM(Nstrings(' ',29))
CASE ('hgt')
variable_units = 'm' // TRIM(Nstrings(' ',29))
+ CASE ('orog')
+ variable_units = 'm' // TRIM(Nstrings(' ',29))
+ CASE ('pres')
+ variable_units = 'Pa' // TRIM(Nstrings(' ',28))
+ CASE ('presb')
+ variable_units = 'Pa' // TRIM(Nstrings(' ',28))
CASE ('press')
variable_units = 'Pa' // TRIM(Nstrings(' ',28))
CASE ('ps')
@@ -2941,7 +3684,7 @@ MODULE module_ncwps
CHARACTER(len=Ss), INTENT(out) :: LVarn, fieldn, units, description
! Local
- CHARACTER(len=St), DIMENSION(38) :: availcfvarn
+ CHARACTER(len=St), DIMENSION(39) :: availcfvarn
CHARACTER(len=Ss) :: fname
!!!!!!!! Variables
@@ -2959,37 +3702,38 @@ MODULE module_ncwps
availcfvarn(5) = 'huss' // TRIM(Nstrings(' ',46))
availcfvarn(6) = 'landsea' // TRIM(Nstrings(' ',43))
availcfvarn(7) = 'mrsos' // TRIM(Nstrings(' ',45))
- availcfvarn(8) = 'press' // TRIM(Nstrings(' ',45))
- availcfvarn(9) = 'ps' // TRIM(Nstrings(' ',48))
- availcfvarn(10) = 'psl' // TRIM(Nstrings(' ',47))
- availcfvarn(11) = 'qv' // TRIM(Nstrings(' ',48))
- availcfvarn(12) = 'qvs' // TRIM(Nstrings(' ',47))
- availcfvarn(13) = 'ci' // TRIM(Nstrings(' ',48))
- availcfvarn(14) = 'snow' // TRIM(Nstrings(' ',46))
- availcfvarn(15) = 'snowd' // TRIM(Nstrings(' ',45))
- availcfvarn(16) = 'snowden' // TRIM(Nstrings(' ',43))
- availcfvarn(17) = 'snowec' // TRIM(Nstrings(' ',44))
- availcfvarn(18) = 'sst' // TRIM(Nstrings(' ',47))
- availcfvarn(19) = 'stl1' // TRIM(Nstrings(' ',46))
- availcfvarn(20) = 'stl2' // TRIM(Nstrings(' ',46))
- availcfvarn(21) = 'stl3' // TRIM(Nstrings(' ',46))
- availcfvarn(22) = 'stl4' // TRIM(Nstrings(' ',46))
- availcfvarn(23) = 'swvl1' // TRIM(Nstrings(' ',45))
- availcfvarn(24) = 'swvl2' // TRIM(Nstrings(' ',45))
- availcfvarn(25) = 'swvl3' // TRIM(Nstrings(' ',45))
- availcfvarn(26) = 'swvl4' // TRIM(Nstrings(' ',45))
- availcfvarn(27) = 'ta' // TRIM(Nstrings(' ',48))
- availcfvarn(28) = 'tas' // TRIM(Nstrings(' ',47))
- availcfvarn(29) = 'tda' // TRIM(Nstrings(' ',47))
- availcfvarn(30) = 'tds' // TRIM(Nstrings(' ',47))
- availcfvarn(31) = 'tos' // TRIM(Nstrings(' ',47))
- availcfvarn(32) = 'ts' // TRIM(Nstrings(' ',48))
- availcfvarn(33) = 'uas' // TRIM(Nstrings(' ',47))
- availcfvarn(34) = 'ua' // TRIM(Nstrings(' ',48))
- availcfvarn(35) = 'vas' // TRIM(Nstrings(' ',47))
- availcfvarn(36) = 'va' // TRIM(Nstrings(' ',48))
- availcfvarn(37) = 'zg' // TRIM(Nstrings(' ',48))
- availcfvarn(38) = 'zgs' // TRIM(Nstrings(' ',47))
+ availcfvarn(8) = 'orog' // TRIM(Nstrings(' ',46))
+ availcfvarn(9) = 'press' // TRIM(Nstrings(' ',45))
+ availcfvarn(10) = 'ps' // TRIM(Nstrings(' ',48))
+ availcfvarn(11) = 'psl' // TRIM(Nstrings(' ',47))
+ availcfvarn(12) = 'qv' // TRIM(Nstrings(' ',48))
+ availcfvarn(13) = 'qvs' // TRIM(Nstrings(' ',47))
+ availcfvarn(14) = 'ci' // TRIM(Nstrings(' ',48))
+ availcfvarn(15) = 'snow' // TRIM(Nstrings(' ',46))
+ availcfvarn(16) = 'snowd' // TRIM(Nstrings(' ',45))
+ availcfvarn(17) = 'snowden' // TRIM(Nstrings(' ',43))
+ availcfvarn(18) = 'snowec' // TRIM(Nstrings(' ',44))
+ availcfvarn(19) = 'sst' // TRIM(Nstrings(' ',47))
+ availcfvarn(20) = 'stl1' // TRIM(Nstrings(' ',46))
+ availcfvarn(21) = 'stl2' // TRIM(Nstrings(' ',46))
+ availcfvarn(22) = 'stl3' // TRIM(Nstrings(' ',46))
+ availcfvarn(23) = 'stl4' // TRIM(Nstrings(' ',46))
+ availcfvarn(24) = 'swvl1' // TRIM(Nstrings(' ',45))
+ availcfvarn(25) = 'swvl2' // TRIM(Nstrings(' ',45))
+ availcfvarn(26) = 'swvl3' // TRIM(Nstrings(' ',45))
+ availcfvarn(27) = 'swvl4' // TRIM(Nstrings(' ',45))
+ availcfvarn(28) = 'ta' // TRIM(Nstrings(' ',48))
+ availcfvarn(29) = 'tas' // TRIM(Nstrings(' ',47))
+ availcfvarn(30) = 'tda' // TRIM(Nstrings(' ',47))
+ availcfvarn(31) = 'tds' // TRIM(Nstrings(' ',47))
+ availcfvarn(32) = 'tos' // TRIM(Nstrings(' ',47))
+ availcfvarn(33) = 'ts' // TRIM(Nstrings(' ',48))
+ availcfvarn(34) = 'uas' // TRIM(Nstrings(' ',47))
+ availcfvarn(35) = 'ua' // TRIM(Nstrings(' ',48))
+ availcfvarn(36) = 'vas' // TRIM(Nstrings(' ',47))
+ availcfvarn(37) = 'va' // TRIM(Nstrings(' ',48))
+ availcfvarn(38) = 'zg' // TRIM(Nstrings(' ',48))
+ availcfvarn(39) = 'zgs' // TRIM(Nstrings(' ',47))
SELECT CASE(TRIM(cfvarn))
@@ -3034,6 +3778,12 @@ MODULE module_ncwps
fieldn = 'MRSOS'
units = 'kgm-2'
+ CASE ('orog')
+ Lvarn = 'Orography, height above geoide'
+ fieldn = 'SOILHGT'
+ units = 'm'
+ description = 'Orography'
+
CASE ('ps')
Lvarn = 'Surface Pressure'
fieldn = 'PSFC'
@@ -3333,7 +4083,7 @@ MODULE module_ncwps
fname = 'get_2Dfield'
- CALL multisearch_var(dbg, ncfiles, ncids, TRIM(varname), Nfvar, ffilens, fncids)
+ CALL multisearch_var(dbg, fname, ncfiles, ncids, TRIM(varname), Nfvar, ffilens, fncids)
IF (TRIM(vtimen) /= 'WRFtime') THEN
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), dtimen, vtimen, oDs, maxTdiff, ifile, ncid, &
@@ -3376,6 +4126,8 @@ MODULE module_ncwps
varvalues = newvarvalues
varu = variable_units(CFvarn)
CALL get_varattr(ncid, varname, 'units', 1, varinu)
+ IF (dbg) PRINT *," units of variable in file: '" // TRIM(varinu) // "' CF variable '" // &
+ TRIM(CFvarn) // "' units: '" // TRIM(varinu) // "'"
CALL equal_units3DR(varu, varinu, dx, dy, 1, varvalues, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=newvarvalues)
@@ -3425,7 +4177,7 @@ MODULE module_ncwps
fname = 'get_3Dfield'
- CALL multisearch_var(dbg, ncfiles, ncids, TRIM(varname), Nfvar, ffilens, fncids)
+ CALL multisearch_var(dbg, fname, ncfiles, ncids, TRIM(varname), Nfvar, ffilens, fncids)
IF (TRIM(vtimen) /= 'WRFtime') THEN
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), dtimen, vtimen, oDs, maxTdiff, ifile, ncid, &
@@ -3468,6 +4220,8 @@ MODULE module_ncwps
varvalues = newvarvalues
varu = variable_units(CFvarn)
CALL get_varattr(ncid, varname, 'units', 1, varinu)
+ IF (dbg) PRINT *," units of variable in file: '" // TRIM(varinu) // "' CF variable '" // &
+ TRIM(CFvarn) // "' units: '" // TRIM(varinu) // "'"
CALL equal_units4DR(varu, varinu, dx, dy, dz, 1, varvalues, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=newvarvalues)
@@ -3513,7 +4267,7 @@ MODULE module_ncwps
lon2D0 = 0.
lon3D0 = 0.
- ncid = search_var(ncfiles, ncids, TRIM(varlonn))
+ ncid = search_var(fname, ncfiles, ncids, TRIM(varlonn))
lonrank = inq_var_rank(ncid, TRIM(varlonn))
IF (lonrank == 1) THEN
@@ -3534,7 +4288,7 @@ MODULE module_ncwps
lat2D0 = 0.
lat3D0 = 0.
- ncid = search_var(ncfiles, ncids, TRIM(varlatn))
+ ncid = search_var(fname, ncfiles, ncids, TRIM(varlatn))
latrank = inq_var_rank(ncid, TRIM(varlatn))
IF (latrank == 1) THEN
diff --git a/nc2wps/module_netcdf_utils.f90 b/nc2wps/module_netcdf_utils.f90
index 2d0ec2c8653b65d15a88adac3e88aaff6c5ec94d..3477791d1b95ac41564121c8feabd5570ce04c79 100644
--- a/nc2wps/module_netcdf_utils.f90
+++ b/nc2wps/module_netcdf_utils.f90
@@ -15,15 +15,20 @@ MODULE module_netcdf_utils
! check_var_slice: Function to check if the amount of values to retrieve from a variable meet the
! shape of the variable
! compute_WRFgeop: Subroutine to compute geopotential values from WRF's PH & PHB variables
-! compute_WRFpress: Subroutine to compute pressure values from WRF's P & PB variables
+! compute_WRFpres: Subroutine to compute pressure values from WRF's P & PB variables
! compute_WRFswvl: Subroutine to compute the soil ground volumetric water from WRF to another set of
! ground layers
! compute_WRFstl: Subroutine to compute the soil ground temperature from WRF to another set of ground
! depths
+! compute_WRFta: Subroutine to compute temperature values from WRF's T, P, PB variables
! compute_WRFtimes: Subroutine to compute time values from WRFtime variable
! getattr0D_invar: Subroutine to retrieve a given scalar attribute from a variable from a given netCDF
! file
! get_equivmultitimes: Subroutine to provide the equivalent time-step from a seris of netCDF files
+! get_var_equivmultitimes: Subroutine to provide the equivalent time-step for a variable found in a
+! series of netCDF files at a given projection
+! get_var_equivmultiWRFtimes: Subroutine to provide the equivalent WRF time-step for a variable found
+! in a series of netCDF files at a given projection
! get_equivtimes: Subroutine to provide the equivalent time-step from a netCDF file
! get_equivWRFtimes: Subroutine to provide the equivalent time-step from a WRF netCDF file
! get_equivmultiWRFtimes: Subroutine to provide the equivalent time-step from a serie WRF netCDF files
@@ -63,6 +68,8 @@ MODULE module_netcdf_utils
! var[2/3/4]D_hur_p_ta_qv: Subroutine to compute 2/3/4D relative humidity following
! 'August - Roche - Magnus' formula
! var3D_qv_tda_pres: Subroutine to compute qv mixing ratio of water vapour from 3D td and pres
+! var_qv_rh: Subroutine to compute water vapour mixing ratio using August-Roche-Magnus approximation
+! from rh [1]
! write_ungrib2DRval: Subroutine to write 2D real data into file in ungrib format
! WRFtime_mat: Function to provide a matrix notation from a WRF type string date
! var_WRFtimes: Subroutine to transform from WRFtimes to CF-compilant time units
@@ -87,6 +94,7 @@ MODULE module_netcdf_utils
! freeunit: provides the number of a free unit in which open a file
! get_datetime: Subroutine to provide a date from a date-time String
! [Y][cd][M][cd][D][cs][H][ct][M][ct][S]
+! same_shape[1/2/3/4]DR: Subroutine to determine if 2 real arrays of rank 1/2/3/4 have the same length
! Swithin_csvStr: Function to provide an integer value from within a csv string
! Iwithin_csvStr: Function to provide an integer value from within a csv string
! Rwithin_csvStr: Function to provide a real value from within a csv string
@@ -94,6 +102,7 @@ MODULE module_netcdf_utils
! Index1DArrayI: Function to provide the first index of a given value inside a 1D intger array
! Index1DArrayR: Function to provide the first index of a given value inside a 1D real array
! Isin1DC: Function to say wether a given value is inside a 1D character array
+! isInlistS: Funtion to check is a given string is in a list of String values
! IsMiss: Funciton to determine if a given value is missing vaue or near by
! ItoS: Function to transform an integer to String
! JD: Fucntion to compute the julian date (JD) given a gregorian calendar
@@ -111,6 +120,7 @@ MODULE module_netcdf_utils
! split: Subroutine which provides the values from a string [String] which has been split by a given
! character [charv] a given number of values [Nvalues] is expected
! stoprun: Subroutine to stop running and print a message
+! stoprunfunc: Subroutine to stop running and print a message when function is called from another one
! stoprunAvail: Subroutine to stop running and print a message and showing available options
! SECTION -- section: netcdf
@@ -393,6 +403,8 @@ MODULE module_netcdf_utils
SUBROUTINE modify4D_fillValue(ncid, varn, missvalue, d1, d2, d3, d4, values, newvalues)
! Subroutine to modify the value of the '_FillValue' and 'missing_value' attributes of a 4D variable
+ USE netcdf
+
IMPLICIT NONE
INTEGER, INTENT(in) :: ncid, d1, d2, d3, d4
@@ -440,6 +452,8 @@ MODULE module_netcdf_utils
DO i=1, Nmissv
rcode = nf90_inquire_attribute(ncid, varid, fillmissns(i), xtype=xtype, len=Lattr)
+ ! Do nothing if the _FillValue or missing_Value does not exist as attribute
+ IF (rcode == NF90_ENOTATT) CYCLE
IF (rcode == 0) THEN
@@ -487,6 +501,8 @@ MODULE module_netcdf_utils
SUBROUTINE modify3D_fillValue(ncid, varn, missvalue, d1, d2, d3, values, newvalues)
! Subroutine to modify the value of the '_FillValue' and 'missing_value' attributes of a 3D variable
+ USE netcdf
+
IMPLICIT NONE
INTEGER, INTENT(in) :: ncid, d1, d2, d3
@@ -533,6 +549,8 @@ MODULE module_netcdf_utils
DO i=1, Nmissv
rcode = nf90_inquire_attribute(ncid, varid, fillmissns(i), xtype=xtype, len=Lattr)
+ ! Do nothing if the _FillValue or missing_Value does not exist as attribute
+ IF (rcode == NF90_ENOTATT) CYCLE
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
IF (rcode == 0) THEN
@@ -583,6 +601,8 @@ MODULE module_netcdf_utils
SUBROUTINE modify2D_fillValue(ncid, varn, missvalue, d1, d2, values, newvalues)
! Subroutine to modify the value of the '_FillValue' and 'missing_value' attributes of a 2D variable
+ USE netcdf
+
IMPLICIT NONE
INTEGER, INTENT(in) :: ncid, d1, d2
@@ -622,7 +642,9 @@ MODULE module_netcdf_utils
DO i=1, Nmissv
rcode = nf90_inquire_attribute(ncid, varid, fillmissns(i), xtype=xtype, len=Lattr)
-
+ ! Do nothing if the _FillValue or missing_Value does not exist as attribute
+ IF (rcode == NF90_ENOTATT) CYCLE
+
IF (rcode == 0) THEN
IF (xtype /= NF90_FLOAT) THEN
@@ -662,7 +684,7 @@ MODULE module_netcdf_utils
SUBROUTINE compute_extrapol_2varsm(id, dimx, dimy, dimt, vsinglen, dtimen, vmean, ncidmean, &
extraptype, Nnewlays, newlays, extrapv)
- ! Subroutine to compute the extrapolation from a single evel variable to variable with set of layers
+ ! Subroutine to compute the extrapolation from a single level variable to variable with set of layers
! using an additional mean variable (no time dependency)
IMPLICIT NONE
@@ -819,6 +841,9 @@ MODULE module_netcdf_utils
END IF
DEALLOCATE(singlevar)
+ IF (ALLOCATED(meanvar)) DEALLOCATE(meanvar)
+ IF (ALLOCATED(newmeanvar)) DEALLOCATE(newmeanvar)
+ IF (ALLOCATED(newsinglevar)) DEALLOCATE(newsinglevar)
RETURN
@@ -936,38 +961,48 @@ MODULE module_netcdf_utils
END DO
END DO
ELSE
- msg = "Extrapolation '" // TRIM(extrapvals(2)) // "' not ready !!"
+ msg = "Extrapolation '" // TRIM(extraptype) // "' not ready !!"
CALL stoprunAvail(fname, msg, Navailextraptype, availextraptype)
END IF
DEALLOCATE(singlevar)
+ IF (ALLOCATED(newsinglevar)) DEALLOCATE(newsinglevar)
RETURN
END SUBROUTINE compute_extrapol
- SUBROUTINE compute_WRFswvl(id, dimx, dimy, dimt, Nnewlays, newlays, swvl)
+ SUBROUTINE compute_WRFswvl(nfs, ids, id, dimx, dimy, dimt, dimtn, Nnewlays, newlays, swvl)
! Subroutine to compute the soil ground volumetric water from WRF to another set of ground layers
IMPLICIT NONE
- INTEGER, INTENT(in) :: id, dimx, dimy, dimt, Nnewlays
+ INTEGER, INTENT(in) :: nfs, id, dimx, dimy, dimt, Nnewlays
+ CHARACTER(len=Sl), INTENT(in) :: dimtn
+ INTEGER, DIMENSION(nfs), INTENT(in) :: ids
REAL, DIMENSION(2,Nnewlays), INTENT(in) :: newlays
REAL, DIMENSION(dimx, dimy, Nnewlays, dimt), &
INTENT(out) :: swvl
! Local
- INTEGER :: ix, iy, iz, it, dimz, dimt0
+ INTEGER :: i, ix, iy, iz, it, dimz, dimt0
+ INTEGER :: Nfvar, idzs, iddzs
INTEGER, DIMENSION(2) :: istart2d
INTEGER, DIMENSION(4) :: istart
+ INTEGER, DIMENSION(nfs) :: foundf, foundids
+ REAL, DIMENSION(:), ALLOCATABLE :: zvarvals
REAL, DIMENSION(:,:), ALLOCATABLE :: zs, dzs, WRFlays
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: smois
REAL, DIMENSION(3) :: intpvals
+ CHARACTER(len=Sl) :: invn
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
+! nfs: amount of open files
+! ids: ids of all the connections to the opened NetrCDF files
! id: number of connection to the NetCDF file
! dimx, dimy, dimt: dimensions of the WRF soil volumetric water content
+! dimtn: name of the temporal dimension
! WRFlays: WRF ground layers [beginning, end]
! WRFwvsoil: WRF soil volumetric water content
! Nnewlays: Amount of new soil layers
@@ -976,25 +1011,77 @@ MODULE module_netcdf_utils
fname = 'copute_WRFswvl'
- ! Number of depths of WRF
- CALL read_dimlength (id, 'soil_layers_stag', dimz)
- CALL read_dimlength (id, 'Time', dimt0)
+ ! Looking for 'ZS' and 'DZS'
+ invn = 'ZS'
+ CALL multisearch_var(.FALSE., fname, nfs, ids, TRIM(invn), Nfvar, foundf, foundids)
+
+ ! Looking for the file with the right amount of temporal values
+ idzs = -1
+ DO i=1, Nfvar
+ CALL read_dimlength (foundids(i), dimtn, dimt0)
+ IF (dimt0 == dimt) THEN
+ idzs = foundids(i)
+ EXIT
+ END IF
+ END DO
+ IF (idzs == -1) THEN
+ PRINT *, TRIM(errormsg)
+ PRINT *, ' ' // TRIM(fname) // ": there is no file with 'ZS' variable with " // TRIM(ItoS(dimt))//&
+ " time steps !!"
+ PRINT *," Values found [id] [dimt] _______"
+ DO i=1, Nfvar
+ CALL read_dimlength (foundids(i), dimtn, dimt0)
+ PRINT *,' ', foundids(i), dimt0
+ END DO
+ PRINT *,'FATAL ERROR'
+ END IF
+
+ invn = 'DZS'
+ CALL multisearch_var(.FALSE., fname, nfs, ids, TRIM(invn), Nfvar, foundf, foundids)
+ ! Looking for the file with the right amount of temporal values
+ iddzs = -1
+ DO i=1, Nfvar
+ CALL read_dimlength (foundids(i), dimtn, dimt0)
+ IF (dimt0 == dimt) THEN
+ iddzs = foundids(i)
+ ! Number of depths of WRF
+ CALL read_dimlength (foundids(i), 'soil_layers_stag', dimz)
+ EXIT
+ END IF
+ END DO
+ IF (iddzs == -1) THEN
+ PRINT *, TRIM(errormsg)
+ PRINT *, ' ' // TRIM(fname) // ": there is no file with 'DZS' variable with " // TRIM(ItoS(dimt))//&
+ " time steps !!"
+ PRINT *," Values found [id] [dimt] _______"
+ DO i=1, Nfvar
+ CALL read_dimlength (foundids(i), dimtn, dimt0)
+ PRINT *,' ', foundids(i), dimt0
+ END DO
+ PRINT *,'FATAL ERROR'
+ END IF
IF (ALLOCATED(zs)) DEALLOCATE(zs)
- ALLOCATE(zs(dimz,dimt0))
+ ALLOCATE(zs(dimz,dimt))
IF (ALLOCATED(dzs)) DEALLOCATE(dzs)
- ALLOCATE(dzs(dimz,dimt0))
+ ALLOCATE(dzs(dimz,dimt))
IF (ALLOCATED(WRFlays)) DEALLOCATE(WRFlays)
ALLOCATE(WRFlays(2,dimz))
+ IF (ALLOCATED(zvarvals)) DEALLOCATE(zvarvals)
+ ALLOCATE(zvarvals(dimz))
istart2d = (/ 1, 1 /)
- CALL get_var2D_slice(id, dimz, dimt, istart2d, 'ZS', zs)
+ CALL get_var2D_slice(idzs, dimz, dimt, istart2d, 'ZS', zs)
istart2d = (/ 1, 1 /)
- CALL get_var2D_slice(id, dimz, dimt, istart2d, 'DZS', dzs)
+ CALL get_var2D_slice(iddzs, dimz, dimt, istart2d, 'DZS', dzs)
+ !!!! Check (NoahMP)
+ ! ZS "DEPTHS OF CENTERS OF SOIL LAYERS": 0.005, 0.02, 0.05, 0.11, 0.23
+ ! DZS "THICKNESSES OF SOIL LAYERS": 0.01, 0.02, 0.04, 0.08, 0.16
+
DO iz=1, dimz
- WRFlays(1,iz) = zs(iz,1) - dzs(iz,1)
- WRFlays(2,iz) = zs(iz,1) + dzs(iz,1)
+ WRFlays(1,iz) = zs(iz,1) - dzs(iz,1)/2.
+ WRFlays(2,iz) = zs(iz,1) + dzs(iz,1)/2
END DO
IF (ALLOCATED(smois)) DEALLOCATE(smois)
ALLOCATE(smois(dimx,dimy,dimz,dimt))
@@ -1005,47 +1092,83 @@ MODULE module_netcdf_utils
DO ix=1,dimx
DO iy=1,dimy
DO it=1,dimt
+ zvarvals = smois(ix,iy,:,it)
DO iz=1, Nnewlays
- swvl(ix,iy,iz,it)= linear_interp_densbars(dimz, WRFlays, smois(ix,iy,:,it), newlays(:,iz))
+ swvl(ix,iy,iz,it)= linear_interp_densbars(dimz, WRFlays, zvarvals, newlays(:,iz))
END DO
END DO
END DO
END DO
- DEALLOCATE(zs)
- DEALLOCATE(dzs)
- DEALLOCATE(WRFlays)
- DEALLOCATE(smois)
+ IF (ALLOCATED(zs)) DEALLOCATE(zs)
+ IF (ALLOCATED(dzs)) DEALLOCATE(dzs)
+ IF (ALLOCATED(WRFlays)) DEALLOCATE(WRFlays)
+ IF (ALLOCATED(smois)) DEALLOCATE(smois)
+ IF (ALLOCATED(zvarvals)) DEALLOCATE(zvarvals)
END SUBROUTINE compute_WRFswvl
- SUBROUTINE compute_WRFstl(id, dimx, dimy, dimt, Nnewdpths, newdpths, stl)
+ SUBROUTINE compute_WRFstl(nfs, ids, id, dimx, dimy, dimt, dimtn, Nnewdpths, newdpths, stl)
! Subroutine to compute the soil ground temperature from WRF to another set of ground depths
IMPLICIT NONE
- INTEGER, INTENT(in) :: id, dimx, dimy, dimt, Nnewdpths
+ INTEGER, INTENT(in) :: nfs, id, dimx, dimy, dimt, Nnewdpths
+ CHARACTER(len=Sl), INTENT(in) :: dimtn
+ INTEGER, DIMENSION(nfs), INTENT(in) :: ids
REAL, DIMENSION(Nnewdpths), INTENT(in) :: newdpths
REAL, DIMENSION(dimx, dimy, Nnewdpths, dimt), &
INTENT(out) :: stl
! Local
- INTEGER :: ix, iy, iz, it, dimz
+ INTEGER :: i, ix, iy, iz, it, dimz, dimt0
+ INTEGER :: Nfvar, idzs
INTEGER, DIMENSION(2) :: istart2d
INTEGER, DIMENSION(4) :: istart
+ INTEGER, DIMENSION(nfs) :: foundf, foundids
+ REAL, DIMENSION(:), ALLOCATABLE :: zvarvals
REAL, DIMENSION(:,:), ALLOCATABLE :: zs
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tslb
REAL, DIMENSION(3) :: intpvals
+ CHARACTER(len=Sl) :: invn
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
-! id: number of connection to the NetCDF file with 'DZS' and 'TSLB' variables
+! nfs: amount of open files
+! ids: ids of all the connections to the opened NetrCDF files
+! id: number of connection to the NetCDF file with 'TSLB' variable
! dimx, dimy, dimt: dimensions of WRF data
+! dimtn: name of the temporal dimension
! Nnewdpths: Amount of new soil depths
! newdpths: values of the new soil depths
! stl: soil temperature at the new depths
fname = 'compute_WRFstl'
+
+ ! Looking for 'ZS'
+ invn = 'ZS'
+ CALL multisearch_var(.FALSE., fname, nfs, ids, TRIM(invn), Nfvar, foundf, foundids)
+
+ ! Looking for the file with the right amount of temporal values
+ idzs = -1
+ DO i=1, Nfvar
+ CALL read_dimlength (foundids(i), dimtn, dimt0)
+ IF (dimt0 == dimt) THEN
+ idzs = foundids(i)
+ EXIT
+ END IF
+ END DO
+ IF (idzs == -1) THEN
+ PRINT *, TRIM(errormsg)
+ PRINT *, ' ' // TRIM(fname) // ": there is no file with 'ZS' variable with " // TRIM(ItoS(dimt))//&
+ " time steps !!"
+ PRINT *," Values found [id] [dimt] _______"
+ DO i=1, Nfvar
+ CALL read_dimlength (foundids(i), dimtn, dimt0)
+ PRINT *,' ', foundids(i), dimt0
+ END DO
+ PRINT *,'FATAL ERROR'
+ END IF
! Number of depths of WRF
CALL read_dimlength (id, 'soil_layers_stag', dimz)
@@ -1054,17 +1177,20 @@ MODULE module_netcdf_utils
ALLOCATE(zs(dimz,dimt))
IF (ALLOCATED(tslb)) DEALLOCATE(tslb)
ALLOCATE(tslb(dimx,dimy,dimz,dimt))
+ IF (ALLOCATED(zvarvals)) DEALLOCATE(zvarvals)
+ ALLOCATE(zvarvals(dimz))
istart2d = (/ 1, 1 /)
- CALL get_var2D_slice(id, dimz, dimt, istart2d, 'ZS', zs)
+ CALL get_var2D_slice(idzs, dimz, dimt, istart2d, 'ZS', zs)
istart = (/ 1, 1, 1, 1 /)
- CALL get_var4D_slice(id, dimx, dimy, dimz, dimt, istart, 'TSLB', tslb)
+ CALL get_var4D_slice(id, dimx, dimy, dimz, dimt, istart, 'TSLB', tslb)
DO ix=1,dimx
DO iy=1,dimy
DO it=1,dimt
+ zvarvals = tslb(ix,iy,:,it)
DO iz=1, Nnewdpths
- intpvals = linear_interp1D(dimz, zs(:,1), tslb(ix,iy,:,it), newdpths(iz))
+ intpvals = linear_interp1D(dimz, zs(:,1), zvarvals, newdpths(iz))
stl(ix,iy,iz,it) = intpvals(1)
END DO
END DO
@@ -1073,10 +1199,11 @@ MODULE module_netcdf_utils
DEALLOCATE(zs)
DEALLOCATE(tslb)
+ DEALLOCATE(zvarvals)
END SUBROUTINE compute_WRFstl
- SUBROUTINE compute_WRFpress(id, dimx, dimy, dimz, dimt, press)
+ SUBROUTINE compute_WRFpres(id, dimx, dimy, dimz, dimt, press)
! Subroutine to compute pressure values from WRF's P & PB variables
USE netcdf
@@ -1097,7 +1224,7 @@ MODULE module_netcdf_utils
! dimx, dimy, dimz, dimt: size of values
! press: pressure values
- fname = 'compute_WRFpress'
+ fname = 'compute_WRFpres'
rcode = nf90_inq_varid(id, 'P', varid)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
@@ -1111,7 +1238,7 @@ MODULE module_netcdf_utils
press = p + pb
- END SUBROUTINE compute_WRFpress
+ END SUBROUTINE compute_WRFpres
SUBROUTINE compute_WRFgeop(id, dimx, dimy, dimz, dimt, geop)
! Subroutine to compute geopotential values from WRF's PH & PHB variables
@@ -1185,6 +1312,65 @@ MODULE module_netcdf_utils
END SUBROUTINE compute_WRFtimes
+ SUBROUTINE compute_WRFta(id, dimx, dimy, dimz, dimt, ta)
+ ! Subroutine to compute temperature values from WRF's T, P, PB variables
+
+ USE netcdf
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(in) :: id, dimx, dimy, dimz, dimt
+ REAL, DIMENSION(dimx,dimy,dimz,dimt), INTENT(out) :: ta
+
+ ! Local
+ INTEGER :: i,j,k,l
+ INTEGER :: rcode, varid
+ INTEGER, DIMENSION(4) :: istart
+ REAL, DIMENSION(dimx,dimy,dimz,dimt) :: tapot, p, pb, pres
+ CHARACTER(len=Sm) :: fname
+
+!!!!!!! Variables
+! id: unit number to the netCDF file
+! dimx, dimy, dimz, dimt: size of values
+! ta: air temperature values
+
+ fname = 'compute_WRFta'
+
+ ta = Rfillvalue
+
+ rcode = nf90_inq_varid(id, 'T', varid)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inq_varid(id, 'P', varid)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inq_varid(id, 'PB', varid)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ istart = (/ 1, 1, 1, 1 /)
+ CALL get_var4D_slice(id, dimx, dimy, dimz, dimt, istart, 'T', tapot)
+ CALL get_var4D_slice(id, dimx, dimy, dimz, dimt, istart, 'P', p)
+ CALL get_var4D_slice(id, dimx, dimy, dimz, dimt, istart, 'PB', pb)
+
+ tapot = tapot + 300.
+ pres = p + pb
+ ta = tapot*(pres/p0)**(rcp)
+
+ DO i=1,dimx
+ DO j=1,dimy
+ DO k=1,dimz
+ DO l=1,dimt
+ IF (ta(i,j,k,l) <= epsilonv) THEN
+ PRINT *,' 0.0 found !!'
+ PRINT *,i,j,k,l,' tapot:', tapot(i,j,k,l), ' pres:', pres(i,j,k,l), ' ta:', ta(i,j,k,l)
+ END IF
+ END DO
+ END DO
+ END DO
+ END DO
+
+ RETURN
+
+ END SUBROUTINE compute_WRFta
+
SUBROUTINE get_varattr_nfiles(dbg, ncfiles, ncids, varn, attrn, Nattrv, attrv)
! Subroutine to get an attribute from avariable looking within mutliple netCDF files
@@ -1214,7 +1400,7 @@ MODULE module_netcdf_utils
fname = 'get_varattr_nfiles'
- CALL multisearch_var(dbg, ncfiles, ncids, TRIM(varn), Nfvar, ffilens, fncids)
+ CALL multisearch_var(dbg, fname, ncfiles, ncids, TRIM(varn), Nfvar, ffilens, fncids)
! Getting just the first one
ncid = fncids(1)
@@ -1244,6 +1430,8 @@ MODULE module_netcdf_utils
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
!PRINT *,' ' // TRIM(fname) // ": attr '" // TRIM(attrv) // "'"
+ DEALLOCATE(readattrv)
+
RETURN
END SUBROUTINE get_varattr_nfiles
@@ -1282,6 +1470,9 @@ MODULE module_netcdf_utils
! ... get the length of the "valid_range" attribute...
rcode = nf90_inquire_attribute(ncid, varid, attrn, Lattrv)
+ ! Equivalencies at netcdf90/f90/netcdf_constants.f90
+ IF (rcode == NF90_ENOTATT) PRINT *, ' ' // TRIM(fname) // ": attribute '" // TRIM(attrn) // &
+ "' not found in variable '" // TRIM(varn) // "'"
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
!PRINT *, TRIM(fname) // ': Lattrv:', Lattrv
@@ -1298,6 +1489,8 @@ MODULE module_netcdf_utils
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
!PRINT *,' ' // TRIM(fname) // ": attr '" // TRIM(attrv) // "'"
+ DEALLOCATE(readattrv)
+
RETURN
END SUBROUTINE get_varattr
@@ -1347,6 +1540,8 @@ MODULE module_netcdf_utils
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ DEALLOCATE(readattrv)
+
RETURN
END SUBROUTINE get_varattrI
@@ -1396,6 +1591,8 @@ MODULE module_netcdf_utils
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ DEALLOCATE(readattrv)
+
RETURN
END SUBROUTINE get_varattrR
@@ -1688,7 +1885,7 @@ MODULE module_netcdf_utils
END SUBROUTINE get_var1D_slice
- INTEGER FUNCTION search_var(Nncids, ncids, vname)
+ INTEGER FUNCTION search_var(funcname, Nncids, ncids, vname)
! Function to provide at which netCDF connector a variable is found
USE netcdf
@@ -1697,7 +1894,7 @@ MODULE module_netcdf_utils
INTEGER, INTENT(IN) :: Nncids
INTEGER, DIMENSION(Nncids), INTENT(IN) :: ncids
- CHARACTER(LEN=*), INTENT(IN) :: vname
+ CHARACTER(LEN=*), INTENT(IN) :: vname, funcname
! Local
INTEGER :: i, j, Nvars, inc, varid, rcode
@@ -1706,6 +1903,7 @@ MODULE module_netcdf_utils
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
+! funcname: name of the function from which this function is used
! Nncid: number of netCDF connections
! ncid: vector with netCDF file identifier
! vname: name of the variable
@@ -1727,12 +1925,12 @@ MODULE module_netcdf_utils
PRINT *, inc, 'In ncid', ncids(inc), ' variables:',((TRIM(varns(j)) // ', '), j=1, Nvars)
END DO
msg = "Variable '" // TRIM(vname) // "' not found !!"
- CALL stoprun(msg, fname)
+ CALL stoprunfunc(msg, funcname, fname)
END IF
END FUNCTION search_var
- SUBROUTINE multisearch_var(dbg, Nncids, ncids, vname, Nncid, foundfiles, foundncids)
+ SUBROUTINE multisearch_var(dbg, funcname, Nncids, ncids, vname, Nncid, foundfiles, foundncids)
! Subroutine to provide at which netCDF connectors a variable is found
USE netcdf
@@ -1742,7 +1940,7 @@ MODULE module_netcdf_utils
LOGICAL, INTENT(in) :: dbg
INTEGER, INTENT(IN) :: Nncids
INTEGER, DIMENSION(Nncids), INTENT(IN) :: ncids
- CHARACTER(LEN=*), INTENT(IN) :: vname
+ CHARACTER(LEN=*), INTENT(IN) :: funcname, vname
INTEGER, INTENT(out) :: Nncid
INTEGER, DIMENSION(Nncids), INTENT(out) :: foundfiles, foundncids
@@ -1753,6 +1951,7 @@ MODULE module_netcdf_utils
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
+! funcname: variable from which is called
! Nncid: number of netCDF connections
! ncid: vector with netCDF file identifier
! vname: name of the variable
@@ -1779,7 +1978,7 @@ MODULE module_netcdf_utils
PRINT *, inc, 'In ncid', ncids(inc), ' variables:',((TRIM(varns(j)) // ', '), j=1, Nvars)
END DO
msg = "Variable '" // TRIM(vname) // "' not found !!"
- CALL stoprun(msg, fname)
+ CALL stoprunfunc(msg, funcname, fname)
END IF
IF (dbg) THEN
@@ -1878,6 +2077,8 @@ MODULE module_netcdf_utils
varns(i) = vname
END DO
+ DEALLOCATE(varids)
+
END SUBROUTINE all_vars
SUBROUTINE all_dims(ncid, Ndims, dimns)
@@ -1917,6 +2118,8 @@ MODULE module_netcdf_utils
dimns(i) = dname
END DO
+ DEALLOCATE(dimids)
+
END SUBROUTINE all_dims
SUBROUTINE get_var4D(ncid, d1, d2, d3, d4, vname, vals)
@@ -1933,8 +2136,13 @@ MODULE module_netcdf_utils
! Local
INTEGER :: funit, i, idvarnew, ios
INTEGER :: Nvals, rcode, varid
+ INTEGER :: dim1, dim2, dim3, dim4
+ INTEGER, DIMENSION(4) :: dimids
CHARACTER(len=Sg) :: line
CHARACTER(len=Sl), DIMENSION(6) :: valsline
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: arraytest
+ LOGICAL :: testres
+ CHARACTER(len=Sm) :: ivarn1,ivarn2
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
@@ -1947,10 +2155,31 @@ MODULE module_netcdf_utils
rcode = nf90_inq_varid(ncid, vname, varid)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ rcode = nf90_inquire_variable(ncid, varid, dimids=dimids)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ rcode = nf90_inquire_dimension(ncid, dimids(1), len = dim1)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_dimension(ncid, dimids(2), len = dim2)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_dimension(ncid, dimids(3), len = dim3)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_dimension(ncid, dimids(4), len = dim4)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ ALLOCATE(arraytest(dim1,dim2,dim3,dim4))
+ ivarn1 = 'destiny array'
+ ivarn2 = 'source in file'
+ CALL same_shape4DR(d1,d2,d3,d4,dim1,dim2,dim3,dim4,vals,arraytest,ivarn1,ivarn2,.TRUE.,testres)
rcode = nf90_get_var(ncid, varid, vals)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ DEALLOCATE(arraytest)
+
+ RETURN
+
END SUBROUTINE get_var4D
SUBROUTINE get_var3D(ncid, d1, d2, d3, vname, vals)
@@ -1967,8 +2196,13 @@ MODULE module_netcdf_utils
! Local
INTEGER :: funit, i, idvarnew, ios
INTEGER :: Nvals, rcode, varid
+ INTEGER :: dim1, dim2, dim3
+ INTEGER, DIMENSION(3) :: dimids
CHARACTER(len=Sg) :: line
CHARACTER(len=Sl), DIMENSION(6) :: valsline
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: arraytest
+ LOGICAL :: testres
+ CHARACTER(len=Sm) :: ivarn1,ivarn2
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
@@ -1981,10 +2215,28 @@ MODULE module_netcdf_utils
rcode = nf90_inq_varid(ncid, vname, varid)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_variable(ncid, varid, dimids=dimids)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ rcode = nf90_inquire_dimension(ncid, dimids(1), len = dim1)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_dimension(ncid, dimids(2), len = dim2)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_dimension(ncid, dimids(3), len = dim3)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ ALLOCATE(arraytest(dim1,dim2,dim3))
+ ivarn1 = 'destiny array'
+ ivarn2 = 'source in file'
+ CALL same_shape3DR(d1,d2,d3,dim1,dim2,dim3,vals,arraytest,ivarn1,ivarn2,.TRUE.,testres)
rcode = nf90_get_var(ncid, varid, vals)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ DEALLOCATE(arraytest)
+
+ RETURN
+
END SUBROUTINE get_var3D
SUBROUTINE get_var2D(ncid, d1, d2, vname, vals)
@@ -2001,8 +2253,13 @@ MODULE module_netcdf_utils
! Local
INTEGER :: funit, i, idvarnew, ios
INTEGER :: Nvals, rcode, varid
+ INTEGER :: dim1, dim2
+ INTEGER, DIMENSION(2) :: dimids
CHARACTER(len=Sg) :: line
CHARACTER(len=Sl), DIMENSION(6) :: valsline
+ REAL, DIMENSION(:,:), ALLOCATABLE :: arraytest
+ LOGICAL :: testres
+ CHARACTER(len=Sm) :: ivarn1,ivarn2
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
@@ -2015,10 +2272,26 @@ MODULE module_netcdf_utils
rcode = nf90_inq_varid(ncid, vname, varid)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_variable(ncid, varid, dimids=dimids)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ rcode = nf90_inquire_dimension(ncid, dimids(1), len = dim1)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_dimension(ncid, dimids(2), len = dim2)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ ALLOCATE(arraytest(dim1,dim2))
+ ivarn1 = 'destiny array'
+ ivarn2 = 'source in file'
+ CALL same_shape2DR(d1,d2,dim1,dim2,vals,arraytest,ivarn1,ivarn2,.TRUE.,testres)
rcode = nf90_get_var(ncid, varid, vals)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ DEALLOCATE(arraytest)
+
+ RETURN
+
END SUBROUTINE get_var2D
SUBROUTINE get_var1D(ncid, d1, vname, vals)
@@ -2035,8 +2308,13 @@ MODULE module_netcdf_utils
! Local
INTEGER :: funit, i, idvarnew, ios
INTEGER :: Nvals, rcode, varid
+ INTEGER :: dim1
+ INTEGER, DIMENSION(1) :: dimids
CHARACTER(len=Sg) :: line
CHARACTER(len=Sl), DIMENSION(6) :: valsline
+ REAL, DIMENSION(:), ALLOCATABLE :: arraytest
+ LOGICAL :: testres
+ CHARACTER(len=Sm) :: ivarn1, ivarn2
CHARACTER(len=Sm) :: fname
!!!!!!! Variables
@@ -2049,10 +2327,24 @@ MODULE module_netcdf_utils
rcode = nf90_inq_varid(ncid, vname, varid)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ rcode = nf90_inquire_variable(ncid, varid, dimids=dimids)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ rcode = nf90_inquire_dimension(ncid, dimids(1), len = dim1)
+ IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+
+ ALLOCATE(arraytest(dim1))
+ ivarn1 = 'destiny array'
+ ivarn2 = 'source in file'
+ CALL same_shape1DR(d1,dim1,vals,arraytest,ivarn1,ivarn2,.TRUE.,testres)
rcode = nf90_get_var(ncid, varid, vals)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
+ DEALLOCATE(arraytest)
+
+ RETURN
+
END SUBROUTINE get_var1D
LOGICAL FUNCTION isdim_inncid(incid, dimname)
@@ -2107,7 +2399,7 @@ MODULE module_netcdf_utils
CHARACTER(LEN=*), INTENT(in) :: filename, dimname
! Local
- INTEGER :: nid, did, Ndims
+ INTEGER :: nid, iid, Ndims
INTEGER :: rcode
CHARACTER(len=Sg) :: diminfile
CHARACTER(len=Ss) :: fname
@@ -2126,8 +2418,8 @@ MODULE module_netcdf_utils
rcode = nf90_inquire(nid, Ndims)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
- Do nid=1, Ndims
- rcode = nf90_inquire_dimension(nid, nid, name=diminfile)
+ DO iid=1, Ndims
+ rcode = nf90_inquire_dimension(nid, iid, name=diminfile)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
IF (TRIM(diminfile) == TRIM(dimname)) THEN
isdim_infile = .TRUE.
@@ -2167,6 +2459,7 @@ MODULE module_netcdf_utils
fname = 'isin_file'
! Opening creation status
+
rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
IF (rcode /= NF90_NOERR) CALL handle_err(rcode, fname)
@@ -2303,8 +2596,13 @@ MODULE module_netcdf_utils
convtosec=86400.0
ENDIF
tmpatt =TRIM(tmpatt(INDEX(tmpatt,'since')+6:LEN_TRIM(tmpatt)))
-
- CALL get_datetime(tmpatt, '-', ' ', ':', iiDT)
+
+ IF (INDEX(tmpatt,'T') > 0) THEN
+ ! Date as [YYYY]-[MM]-[DD]T[HH]:[MI]:[SS]
+ CALL get_datetime(tmpatt, '-', 'T', ':', iiDT)
+ ELSE
+ CALL get_datetime(tmpatt, '-', ' ', ':', iiDT)
+ END IF
sec0RK = iiDT(4)*3600. + iiDT(5)*60. + iiDT(6)
!PRINT*, 'TOTAL SECONDS = ',sec0RK
@@ -2446,7 +2744,7 @@ MODULE module_netcdf_utils
END SUBROUTINE get_equivtimes
SUBROUTINE get_equivmultitimes(Nnc, ncids, indtimen, invtimen, obstime, maxTdiff, inc, ncid, ncit, dbg)
- ! Subroutine to provide the equivalent time-step from a seris of netCDF files
+ ! Subroutine to provide the equivalent time-step from a series of netCDF files
IMPLICIT NONE
@@ -2550,6 +2848,140 @@ MODULE module_netcdf_utils
RETURN
END SUBROUTINE get_equivmultitimes
+
+ SUBROUTINE get_var_equivmultitimes(dbg, icnf, varn, iproj, obstime, maxTdiff, inc, ncid, ncit, &
+ foundfilen)
+ ! Subroutine to provide the equivalent time-step for a variable found in a series of netCDF files at
+ ! a given projection
+
+ IMPLICIT NONE
+
+ TYPE(infconfig), INTENT(in) :: icnf
+ INTEGER, INTENT(in) :: iproj, maxTdiff
+ CHARACTER(len=St), INTENT(in) :: varn
+ INTEGER, DIMENSION(6), INTENT(in) :: obstime
+ LOGICAL, OPTIONAL, INTENT(in) :: dbg
+ INTEGER, INTENT(out) :: inc, ncid, ncit
+ CHARACTER(len=Sl), INTENT(out) :: foundfilen
+
+ ! Local
+ INTEGER :: ifile, it
+ INTEGER :: timelen
+ REAL, DIMENSION(:), ALLOCATABLE :: time
+ INTEGER, DIMENSION(6) :: intime
+ INTEGER, DIMENSION(:,:), ALLOCATABLE :: intimemat
+ CHARACTER(len=St) :: indtimen, invtimen
+ CHARACTER(len=4) :: cyy
+ CHARACTER(len=2) :: cmm, cdd, chh, chh1, mii, sii
+ REAL(r_k) :: RK1, RK2, jud1, jud2
+ LOGICAL :: db
+ CHARACTER(len=Sm) :: fname
+
+!!!!!!! Variables
+! icnf: structure with all the information about files, variables and their projections
+! obstime: matrix representation of the date to search equivalency
+! maxTdiff: allowed maximum time-difference in seconds to check for same times
+! inc: temporal value in the file
+! ncid: netCDF unit where the time is found
+! ncit: equivalent time-step from netCDF file
+
+ fname = 'get_var_equivmultitimes'
+
+ db = .FALSE.
+ IF (PRESENT(dbg)) db = dbg
+
+ ! Looping in files with the same projection
+ DO inc=1, icnf%inNpfile(iproj)
+
+ IF (isin_file(icnf%inprojfilen(iproj,inc), varn)) THEN
+
+ indtimen = icnf%indtimen(iproj)
+ invtimen = icnf%invtimen(iproj)
+
+ ncid = -1
+ ncit = -1
+
+ CALL read_dimlength (icnf%inprojncid(iproj,inc), TRIM(indtimen), timelen)
+
+ IF (ALLOCATED(time)) DEALLOCATE(time)
+ ALLOCATE(time(timelen))
+ IF (ALLOCATED(intimemat)) DEALLOCATE(intimemat)
+ ALLOCATE(intimemat(6,timelen))
+
+ CALL get_var1D(icnf%inprojncid(iproj,inc), timelen, invtimen, time)
+
+ CALL transform_ncdates(icnf%inprojncid(iproj,inc), timelen, invtimen, time, intimemat, db)
+
+ ncit = -1
+ DO it=1,timelen
+ intime = intimemat(:,it)
+
+ IF (same_datetime(intime, obstime, maxTdiff)) THEN
+ ncit = it
+ ncid = icnf%inprojncid(iproj,inc)
+ foundfilen = icnf%inprojfilen(iproj,inc)
+ IF (dbg) THEN
+ WRITE(cyy,'(i4.4)') obstime(1)
+ WRITE(cmm,'(i2.2)') obstime(2)
+ WRITE(cdd,'(i2.2)') obstime(3)
+ WRITE(chh1,'(i2.2)') obstime(4)
+ WRITE(mii,'(i2.2)') obstime(5)
+ WRITE(sii,'(i2.2)') obstime(6)
+ PRINT *, ' ' // TRIM(fname) // ": in projection " // ItoS(iproj) // "' variable '" // &
+ TRIM(varn) // "' at time step: " // cyy // '/' // cmm // '/' // cdd // " " // chh1 // &
+ ":" // mii // ":" // sii // " found in file '" //TRIM(foundfilen) // "' unit: " // &
+ ItoS(ncid) // " time-step: " // ItoS(ncit)
+ END IF
+ EXIT
+ END IF
+ END DO
+
+ END IF
+
+ IF (ncid /= -1) EXIT
+ END DO
+
+ IF (ncit == -1) THEN
+ WRITE(cyy,'(i4.4)') obstime(1)
+ WRITE(cmm,'(i2.2)') obstime(2)
+ WRITE(cdd,'(i2.2)') obstime(3)
+ WRITE(chh1,'(i2.2)') obstime(4)
+ WRITE(mii,'(i2.2)') obstime(5)
+ WRITE(sii,'(i2.2)') obstime(6)
+ msg = " No equivalence found for date '" // cyy // cmm // cdd // chh1 // mii // sii // "'" &
+ // " and variable '" // TRIM(varn) // "' in projection: " // ItoS(iproj) // "!!"
+ DO inc=1, icnf%inNpncids(iproj)
+ CALL read_dimlength (icnf%inprojncid(iproj,inc), TRIM(indtimen), timelen)
+
+ IF (ALLOCATED(time)) DEALLOCATE(time)
+ ALLOCATE(time(timelen))
+ IF (ALLOCATED(intimemat)) DEALLOCATE(intimemat)
+ ALLOCATE(intimemat(6,timelen))
+
+ CALL get_var1D(icnf%inprojncid(iproj,inc), timelen, invtimen, time)
+ CALL transform_ncdates(icnf%inprojncid(iproj,inc), timelen, invtimen, time, intimemat)
+
+ PRINT *,' Time in file _______', inc, ' id', icnf%inprojncid(iproj,inc)
+ DO it=1,timelen
+ intime = intimemat(:,it)
+ WRITE(cyy,'(i4.4)') intime(1)
+ WRITE(cmm,'(i2.2)') intime(2)
+ WRITE(cdd,'(i2.2)') intime(3)
+ WRITE(chh1,'(i2.2)') intime(4)
+ WRITE(mii,'(i2.2)') intime(5)
+ WRITE(sii,'(i2.2)') intime(6)
+ PRINT *,' ',it, ': ', cyy // cmm // cdd // chh1 // mii // sii
+ END DO
+ END DO
+ CALL stoprun(msg, fname)
+ END IF
+
+ IF (ALLOCATED(time)) DEALLOCATE(time)
+ IF (ALLOCATED(intimemat)) DEALLOCATE(intimemat)
+
+ RETURN
+
+ END SUBROUTINE get_var_equivmultitimes
SUBROUTINE get_equivWRFtimes(ncid, obstime, ncit, maxTdiff)
! Subroutine to provide the equivalent time-step from a WRF netCDF file
@@ -2627,13 +3059,14 @@ MODULE module_netcdf_utils
INTEGER, INTENT(out) :: inc, ncid, ncit
! Local
- INTEGER :: it
+ INTEGER :: it, ic
INTEGER :: rcode, varid
INTEGER :: timelen
INTEGER, DIMENSION(2) :: istart
CHARACTER(len=1), DIMENSION(:,:), ALLOCATABLE :: wrftime
CHARACTER(len=4) :: cyy
CHARACTER(len=2) :: cmm, cdd, chh, chh1, mii, sii
+ CHARACTER(len=19) :: dateS
CHARACTER(len=Su) :: indtimen, invtimen
CHARACTER(len=Sm) :: fname
@@ -2652,6 +3085,7 @@ MODULE module_netcdf_utils
invtimen = 'Times'
ncid = -1
+ ncit = -1
DO inc=1, Nnc
CALL read_dimlength (ncids(inc), TRIM(indtimen), timelen)
@@ -2662,7 +3096,6 @@ MODULE module_netcdf_utils
istart = (/ 1, 1 /)
CALL get_var2DC_slice(ncids(inc), 19, timelen, istart, invtimen, wrftime)
- ncit = -1
DO it=1,timelen
IF (same_datetime(WRFtime_mat(wrftime(:,it)), obstime, maxTdiff)) THEN
ncit = it
@@ -2673,6 +3106,130 @@ MODULE module_netcdf_utils
IF (ncit /= -1) EXIT
END DO
+ IF (ncit == -1) THEN
+ DO inc=1, Nnc
+
+ CALL read_dimlength (ncids(inc), TRIM(indtimen), timelen)
+
+ IF (ALLOCATED(wrftime)) DEALLOCATE(wrftime)
+ ALLOCATE(wrftime(19,timelen))
+
+ istart = (/ 1, 1 /)
+ CALL get_var2DC_slice(ncids(inc), 19, timelen, istart, invtimen, wrftime)
+
+ PRINT *,' ' // TRIM(fname) // ": available times found in file: ", inc, " unit file: ", &
+ ncids(inc), " _______"
+ dateS = ''
+ DO it=1, timelen
+ DO ic=1, 19
+ dateS(ic:ic) = wrftime(ic,it)
+ END DO
+ PRINT *,' ', it, ' : ' // TRIM(dateS)
+ END DO
+ WRITE(cyy,'(i4.4)') obstime(1)
+ WRITE(cmm,'(i2.2)') obstime(2)
+ WRITE(cdd,'(i2.2)') obstime(3)
+ WRITE(chh1,'(i2.2)') obstime(4)
+ WRITE(mii,'(i2.2)') obstime(5)
+ WRITE(sii,'(i2.2)') obstime(6)
+ msg = " No equivalence found for date '" // cyy // cmm // cdd // chh1 // mii // sii // "'"
+
+ END DO
+ CALL stoprun(msg, fname)
+ END IF
+
+ DEALLOCATE(wrftime)
+
+ RETURN
+
+ END SUBROUTINE get_equivmultiWRFtimes
+
+ SUBROUTINE get_var_equivmultiWRFtimes(dbg, icnf, varn, iproj, obstime, maxTdiff, inc, ncid, ncit, &
+ foundfilen)
+ ! Subroutine to provide the equivalent WRF time-step for a variable found in a series of netCDF
+ ! files at a given projection
+
+ IMPLICIT NONE
+
+ TYPE(infconfig), INTENT(in) :: icnf
+ INTEGER, INTENT(in) :: iproj, maxTdiff
+ CHARACTER(len=St), INTENT(in) :: varn
+ INTEGER, DIMENSION(6), INTENT(in) :: obstime
+ LOGICAL, OPTIONAL, INTENT(in) :: dbg
+ INTEGER, INTENT(out) :: inc, ncid, ncit
+ CHARACTER(len=Sl), INTENT(out) :: foundfilen
+
+ ! Local
+ INTEGER :: ifile, it, ic
+ INTEGER :: rcode, varid
+ INTEGER :: timelen
+ INTEGER, DIMENSION(2) :: istart
+ CHARACTER(len=1), DIMENSION(:,:), ALLOCATABLE :: wrftime
+ CHARACTER(len=4) :: cyy
+ CHARACTER(len=2) :: cmm, cdd, chh, chh1, mii, sii
+ CHARACTER(len=19) :: dateS
+ CHARACTER(len=Su) :: indtimen, invtimen
+ LOGICAL :: db
+ CHARACTER(len=Sm) :: fname
+
+!!!!!!! Variables
+! icnf: structure with all the information about files, variables and their projections
+! indtimen: name of the dimension time ('Time')
+! invtimen: name of the variable time ('Times')
+! obstime: matrix representation of the date to search equivalency
+! maxTdiff: allowed maximum time-difference in seconds to check for same times
+! inc: temporal value in the file
+! ncid: netCDF unit where the time is found
+! ncit: equivalent time-step from netCDF file
+
+ fname = 'get_equivmultiWRFtimes'
+ indtimen = 'Time'
+ invtimen = 'Times'
+
+ db = .FALSE.
+ IF (PRESENT(dbg)) db = dbg
+
+ ! Looping in files with the same projection
+ DO inc=1, icnf%inNpfile(iproj)
+
+ IF (isin_file(icnf%inprojfilen(iproj,inc), varn)) THEN
+
+ ncid = -1
+ ncit = -1
+
+ CALL read_dimlength (icnf%inprojncid(iproj,inc), TRIM(indtimen), timelen)
+
+ IF (ALLOCATED(wrftime)) DEALLOCATE(wrftime)
+ ALLOCATE(wrftime(19,timelen))
+
+ istart = (/ 1, 1 /)
+ CALL get_var2DC_slice(icnf%inprojncid(iproj,inc), 19, timelen, istart, invtimen, wrftime)
+
+ DO it=1,timelen
+ IF (same_datetime(WRFtime_mat(wrftime(:,it)), obstime, maxTdiff)) THEN
+ ncit = it
+ ncid = icnf%inprojncid(iproj,inc)
+ foundfilen = icnf%inprojfilen(iproj,inc)
+ IF (dbg) THEN
+ WRITE(cyy,'(i4.4)') obstime(1)
+ WRITE(cmm,'(i2.2)') obstime(2)
+ WRITE(cdd,'(i2.2)') obstime(3)
+ WRITE(chh1,'(i2.2)') obstime(4)
+ WRITE(mii,'(i2.2)') obstime(5)
+ WRITE(sii,'(i2.2)') obstime(6)
+ PRINT *, ' ' // TRIM(fname) // ": in projection " // ItoS(iproj) // "' variable '" // &
+ TRIM(varn) // "' at time step: " // cyy // '/' // cmm // '/' // cdd // " " // chh1 // &
+ ":" // mii // ":" // sii // " found in file '" //TRIM(foundfilen) // "' unit: " // &
+ ItoS(ncid) // " time-step: " // ItoS(ncit)
+ END IF
+ EXIT
+ END IF
+ END DO
+ END IF
+
+ IF (ncit /= -1) EXIT
+ END DO
+
IF (ncit == -1) THEN
WRITE(cyy,'(i4.4)') obstime(1)
WRITE(cmm,'(i2.2)') obstime(2)
@@ -2680,16 +3237,36 @@ MODULE module_netcdf_utils
WRITE(chh1,'(i2.2)') obstime(4)
WRITE(mii,'(i2.2)') obstime(5)
WRITE(sii,'(i2.2)') obstime(6)
- msg = " No equivalence found for date '" // cyy // cmm // cdd // chh1 // mii // sii // "'"
+ msg = " No equivalence found for date '" // cyy // cmm // cdd // chh1 // mii // sii // "'" &
+ // " and variable '" // TRIM(varn) // "' in projection: " // ItoS(iproj) // "!!"
+ DO inc=1, icnf%inNpncids(iproj)
+ CALL read_dimlength (icnf%inprojncid(iproj,inc), TRIM(indtimen), timelen)
+
+ IF (ALLOCATED(wrftime)) DEALLOCATE(wrftime)
+ ALLOCATE(wrftime(19,timelen))
+
+ istart = (/ 1, 1 /)
+ CALL get_var2DC_slice(icnf%inprojncid(iproj,inc), 19, timelen, istart, invtimen, wrftime)
+
+ PRINT *,' ' // TRIM(fname) // ": available times found in file: ", inc, " unit file: ", &
+ icnf%inprojncid(iproj,inc), " _______"
+ dateS = ''
+ DO it=1, timelen
+ DO ic=1, 19
+ dateS(ic:ic) = wrftime(ic,it)
+ END DO
+ PRINT *,' ', it, ' : ' // TRIM(dateS)
+ END DO
+ END DO
CALL stoprun(msg, fname)
END IF
- DEALLOCATE(wrftime)
+ IF (ALLOCATED(wrftime)) DEALLOCATE(wrftime)
RETURN
- END SUBROUTINE get_equivmultiWRFtimes
-
+ END SUBROUTINE get_var_equivmultiWRFtimes
+
! SECTION -- section: other
!!
@@ -2785,18 +3362,18 @@ MODULE module_netcdf_utils
! Formula is pres = [varn1](k) + [varn2](k)*[varn3](i,j,t)
! First variable
- ncid = search_var(nfiles, ncids, TRIM(varns(1)))
+ ncid = search_var(fname, nfiles, ncids, TRIM(varns(1)))
CALL get_var1D(ncid, dz, varns(1), var1)
CALL get_varattr(ncid, varns(1), 'units', 1, var1u)
! Second variable
- ncid = search_var(nfiles, ncids, TRIM(varns(2)))
+ ncid = search_var(fname, nfiles, ncids, TRIM(varns(2)))
CALL get_var1D(ncid, dz, varns(2), var2)
! Third variable
- ncid = search_var(nfiles, ncids, TRIM(varns(3)))
+ ncid = search_var(fname, nfiles, ncids, TRIM(varns(3)))
- CALL multisearch_var(.FALSE., nfiles, ncids, TRIM(varns(3)), Nfvar, ffilens, fncids)
+ CALL multisearch_var(.FALSE., fname, nfiles, ncids, TRIM(varns(3)), Nfvar, ffilens, fncids)
IF (TRIM(vtimen) /= 'WRFtime') THEN
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), dtimen, vtimen, oDs, maxTdiff, ifile, ncid, &
@@ -2964,24 +3541,23 @@ MODULE module_netcdf_utils
END IF
! Extrapolation of zg_pl
- tvu = tu * ( 1. + 0.608 * qu )
- IF ( zu .GT. zshul ) THEN
- tvd = tvu + zu * 6.5E-3
- IF ( tvd .GT. tvshul ) THEN
- IF ( tvu .GT. tvshul) THEN
- tvd = tvshul - 5.E-3 * ( tvu - tvshul ) ** 2
- ELSE
- tvd = tvshul
+ IF (PRESENT(ght_pl)) THEN
+ tvu = tu * ( 1. + 0.608 * qu )
+ IF ( zu .GT. zshul ) THEN
+ tvd = tvu + zu * 6.5E-3
+ IF ( tvd .GT. tvshul ) THEN
+ IF ( tvu .GT. tvshul) THEN
+ tvd = tvshul - 5.E-3 * ( tvu - tvshul ) ** 2
+ ELSE
+ tvd = tvshul
+ ENDIF
ENDIF
+ gammas = ( tvu - tvd ) / zu
+ ELSE
+ gammas = 0.
ENDIF
- gammas = ( tvu - tvd ) / zu
- ELSE
- gammas = 0.
- ENDIF
- part = ( r_d / g ) * ( ALOG(pm) - ALOG(pd) )
- zg_pl = zu - tvu * part / ( 1. + 0.5 * gammas * part )
-
- IF (PRESENT(ght_pl)) THEN
+ part = ( r_d / g ) * ( ALOG(pm) - ALOG(pd) )
+ zg_pl = zu - tvu * part / ( 1. + 0.5 * gammas * part )
ght_pl(i,j,kp) = zg_pl
END IF
@@ -3034,11 +3610,11 @@ MODULE module_netcdf_utils
END IF
! 7. Dewpoint (K) - Use Bolton's approximation
- IF (PRESENT(qv_pl)) THEN
+ IF (PRESENT(qv_pl) .AND. PRESENT(td_pl)) THEN
ed = qv_pl(i,j,kp) * pm * 0.01 / ( eps + qv_pl(i,j,kp) )
ed = max(ed, 0.001) ! water vapor pressure in mb.
td_pl(i,j,kp) = t_kelvin + (s1 / ((s2 / log(ed/s3)) - 1.0))
- ELSE
+ ELSE IF (PRESENT(tda)) THEN
td_pl(i,j,kp) = tda(i,j,ke)
END IF
@@ -3065,14 +3641,14 @@ MODULE module_netcdf_utils
! Now we just put in a list of diagnostics for this level.
! 1. geopotential (m2s-2)
- IF (PRESENT(z)) THEN
+ IF (PRESENT(z) .AND. PRESENT(ght_pl)) THEN
zu = z(i,j,ke+1)
zd = z(i,j,ke)
ght_pl(i,j,kp) = ( zu * (pm-pd) + zd * (pu-pm) ) / (pu-pd)
END IF
! 2. Temperature (K)
- IF (PRESENT(t)) THEN
+ IF (PRESENT(t) .AND. PRESENT(t_pl)) THEN
tu = t(i,j,ke+1)
td = t(i,j,ke)
t_pl(i,j,kp) = ( tu * (pm-pd) + td * (pu-pm) ) / (pu-pd)
@@ -3092,7 +3668,7 @@ MODULE module_netcdf_utils
END IF
! 4. Mixing ratio (kg/kg)
- IF (PRESENT(qv)) THEN
+ IF (PRESENT(qv) .AND. PRESENT(qv_pl)) THEN
qu = MAX(qv(i,j,ke+1),0.)
qd = MAX(qv(i,j,ke),0.)
qv_pl(i,j,kp) = ( qu * (pm-pd) + qd * (pu-pm) ) / (pu-pd)
@@ -3668,10 +4244,298 @@ MODULE module_netcdf_utils
END SUBROUTINE compute_rh_spechumd_2D
+ SUBROUTINE var_qv_rh(dx, dy, dz, dt, t, press, hur, qv)
+! Subroutine to compute water vapour mixing ratio using August-Roche-Magnus approximation from rh [1]
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(in) :: dx, dy, dz, dt
+ REAL, DIMENSION(dx,dy,dz,dt), INTENT(in) :: t, hur
+ REAL, DIMENSION(dz), INTENT(in) :: press
+ REAL, DIMENSION(dx,dy,dz,dt), INTENT(out) :: qv
+
+! Local
+ INTEGER :: i,j,k,l
+ REAL, DIMENSION(dx,dy,dz,dt) :: tC, es, ws
+ CHARACTER(len=50) :: fname
+
+!!!!!!! Variables
+! t: temperature [K]
+! press: pressure [Pa]
+! dz: vertical extension
+! hur: relative humidity [1]
+! qv: mixing ratio [kgkg-1]
+
+ fname = 'var_qv'
+
+ ! August - Roche - Magnus formula (Avoiding overflow on last level)
+ tC = t - SVPT0
+
+ es = ARM1 * exp(ARM2*tC/(tC+ARM3))
+ ! Saturated mixing ratio
+ DO i=1,dx
+ DO j=1,dy
+ DO k=1,dz
+ DO l=1,dt
+! IF (es(i,j,k,l) == 0.01*press(k)) THEN
+! ws(i,j,k,l) = mol_watdry*es(i,j,k,l)
+! ELSE
+ ws(i,j,k,l) = mol_watdry*es(i,j,k,l)/(0.01*press(k)-es(i,j,k,l))
+ ! Removing wrong values
+ IF (ws(i,j,k,l) < 0.) ws(i,j,k,l) = 0.
+
+ ! Water vapour mixing ratio
+ IF (hur(i,j,k,l) > 100.) THEN
+ qv(i,j,k,l) = 100.*ws(i,j,k,l)
+ ELSE
+ qv(i,j,k,l) = hur(i,j,k,l)*ws(i,j,k,l)
+ END IF
+! END IF
+ END DO
+ END DO
+ END DO
+ END DO
+
+ RETURN
+
+ END SUBROUTINE var_qv_rh
! SECTION -- section: generic
!!
+ LOGICAL FUNCTION isInlistS(Nlist, listS, srtingS)
+ ! Funtion to check is a given string is in a list of String values
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(in) :: Nlist
+ CHARACTER(len=*), INTENT(in) :: srtingS
+ CHARACTER(len=*), DIMENSION(Nlist), INTENT(in) :: listS
+
+! Local
+ INTEGER :: i
+ CHARACTER(len=50) :: fname
+
+ fname = 'isInlist'
+
+ isInlistS = .FALSE.
+
+ DO i=1, Nlist
+ IF (TRIM(listS(i)) == TRIM(srtingS)) THEN
+ isInlistS = .TRUE.
+ EXIT
+ END IF
+ END DO
+
+ RETURN
+
+ END FUNCTION isInlistS
+
+ SUBROUTINE same_shape1DR(d1, d2, vec1, vec2, varn1, varn2, iserror, same)
+ ! Subroutine to determine if 2 real vectors have the same length
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(in) :: d1, d2
+ REAL, DIMENSION(d1), INTENT(in) :: vec1
+ REAL, DIMENSION(d2), INTENT(in) :: vec2
+ CHARACTER(len=Sm), INTENT(in) :: varn1, varn2
+ LOGICAL, INTENT(in) :: iserror
+ LOGICAL, INTENT(out) :: same
+
+ ! Local
+ INTEGER :: i
+ CHARACTER(len=Ss) :: fname
+
+!!!!!!! Variables
+! d1: length of vector 1
+! d2: length of vector 2
+! vec1: first vector to compare
+! vec2: second vector to compare
+! varn[1/2]: names of the vector 1 and 2
+! iserror: whether in case vectors have different sizes, and error should be arise
+
+ fname = 'smae_shape1DR'
+
+ same = .TRUE.
+
+ IF ( d1 /= d2) THEN
+ same = .FALSE.
+ IF (iserror) THEN
+ PRINT *, TRIM(fname) // ": vectors have different sizes !!"
+ PRINT *, " vector 1: '" // TRIM(varn1) // "' has size ", d1
+ PRINT *, " vector 2: '" // TRIM(varn2) // "' has size ", d2
+ RETURN
+ END IF
+ END IF
+
+ RETURN
+
+ END SUBROUTINE same_shape1DR
+
+ SUBROUTINE same_shape2DR(d1a, d1b, d2a, d2b, arr1, arr2, varn1, varn2, iserror, same)
+ ! Subroutine to determine if 2 real arrays of rank 2 have the same length
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(in) :: d1a, d1b, d2a, d2b
+ REAL, DIMENSION(d1a,d1b), INTENT(in) :: arr1
+ REAL, DIMENSION(d2a,d2b), INTENT(in) :: arr2
+ CHARACTER(len=Sm), INTENT(in) :: varn1, varn2
+ LOGICAL, INTENT(in) :: iserror
+ LOGICAL, INTENT(out) :: same
+
+ ! Local
+ INTEGER :: i, d1, d2, Ntotdim
+ INTEGER, DIMENSION(2) :: dima1, dima2
+ CHARACTER(len=Ss) :: fname
+
+!!!!!!! Variables
+! d1a,d1b: extent of array 1
+! d2a,d2b: extent of array 2
+! arr1: first array to compare
+! arr2: second array to compare
+! varn[1/2]: names of the array 1 and 2
+! iserror: whether in case vectors have different sizes, and error should be arise
+
+ fname = 'same_shape2DR'
+
+ ! Shapes
+ dima1 = UBOUND(arr1)
+ dima2 = UBOUND(arr2)
+
+ Ntotdim = 2
+
+ same = .TRUE.
+ DO i=1, Ntotdim
+ d1 = dima1(i)
+ d2 = dima2(i)
+ IF ( d1 /= d2) THEN
+ same = .FALSE.
+ IF (iserror) THEN
+ PRINT *, TRIM(fname) // ": arrays at dimension ", i ," have different sizes !!"
+ PRINT *, " array 1: '" // TRIM(varn1) // "' has size ", d1
+ PRINT *, " array 2: '" // TRIM(varn2) // "' has size ", d2
+ PRINT *, " shape array 1: ", dima1
+ PRINT *, " shape array 2: ", dima2
+ RETURN
+ END IF
+ END IF
+ END DO
+
+ RETURN
+
+ END SUBROUTINE same_shape2DR
+
+ SUBROUTINE same_shape3DR(d1a, d1b, d1c, d2a, d2b, d2c, arr1, arr2, varn1, varn2, iserror, same)
+ ! Subroutine to determine if 2 real arrays of rank 3 have the same length
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(in) :: d1a, d1b, d1c, d2a, d2b, d2c
+ REAL, DIMENSION(d1a,d1b,d1c), INTENT(in) :: arr1
+ REAL, DIMENSION(d2a,d2b,d2c), INTENT(in) :: arr2
+ CHARACTER(len=Sm), INTENT(in) :: varn1, varn2
+ LOGICAL, INTENT(in) :: iserror
+ LOGICAL, INTENT(out) :: same
+
+ ! Local
+ INTEGER :: i, d1, d2, Ntotdim
+ INTEGER, DIMENSION(3) :: dima1, dima2
+ CHARACTER(len=Ss) :: fname
+
+!!!!!!! Variables
+! d1a,d1b,d1c: extent of array 1
+! d2a,d2b,d2c: extent of array 2
+! arr1: first array to compare
+! arr2: second array to compare
+! varn[1/2]: names of the array 1 and 2
+! iserror: whether in case vectors have different sizes, and error should be arise
+
+ fname = 'same_shape3DR'
+
+ ! Shapes
+ dima1 = UBOUND(arr1)
+ dima2 = UBOUND(arr2)
+
+ Ntotdim = 3
+
+ same = .TRUE.
+ DO i=1, Ntotdim
+ d1 = dima1(i)
+ d2 = dima2(i)
+ IF ( d1 /= d2) THEN
+ same = .FALSE.
+ IF (iserror) THEN
+ PRINT *, TRIM(fname) // ": arrays at dimension ", i ," have different sizes !!"
+ PRINT *, " array 1: '" // TRIM(varn1) // "' has size ", d1
+ PRINT *, " array 2: '" // TRIM(varn2) // "' has size ", d2
+ PRINT *, " shape array 1: ", dima1
+ PRINT *, " shape array 2: ", dima2
+ RETURN
+ END IF
+ END IF
+ END DO
+
+ RETURN
+
+ END SUBROUTINE same_shape3DR
+
+ SUBROUTINE same_shape4DR(d1a, d1b, d1c, d1d, d2a, d2b, d2c, d2d, arr1, arr2, varn1, varn2, iserror, &
+ same)
+ ! Subroutine to determine if 2 real arrays of rank 4 have the same length
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(in) :: d1a, d1b, d1c, d1d, d2a, d2b, d2c, d2d
+ REAL, DIMENSION(d1a,d1b,d1c,d1d), INTENT(in) :: arr1
+ REAL, DIMENSION(d2a,d2b,d2c,d2d), INTENT(in) :: arr2
+ CHARACTER(len=Sm), INTENT(in) :: varn1, varn2
+ LOGICAL, INTENT(in) :: iserror
+ LOGICAL, INTENT(out) :: same
+
+ ! Local
+ INTEGER :: i, d1, d2, Ntotdim
+ INTEGER, DIMENSION(4) :: dima1, dima2
+ CHARACTER(len=Ss) :: fname
+
+!!!!!!! Variables
+! d1a,d1b,d1c,d1d: extent of array 1
+! d2a,d2b,d2c,d2d: extent of array 2
+! arr1: first array to compare
+! arr2: second array to compare
+! varn[1/2]: names of the array 1 and 2
+! iserror: whether in case vectors have different sizes, and error should be arise
+
+ fname = 'same_shape4DR'
+
+ ! Shapes
+ dima1 = UBOUND(arr1)
+ dima2 = UBOUND(arr2)
+
+ Ntotdim = 4
+
+ same = .TRUE.
+ DO i=1, Ntotdim
+ d1 = dima1(i)
+ d2 = dima2(i)
+ IF ( d1 /= d2) THEN
+ same = .FALSE.
+ IF (iserror) THEN
+ PRINT *, TRIM(fname) // ": arrays at dimension ", i ," have different sizes !!"
+ PRINT *, " array 1: '" // TRIM(varn1) // "' has size ", d1
+ PRINT *, " array 2: '" // TRIM(varn2) // "' has size ", d2
+ PRINT *, " shape array 1: ", dima1
+ PRINT *, " shape array 2: ", dima2
+ RETURN
+ END IF
+ END IF
+ END DO
+
+ RETURN
+
+ END SUBROUTINE same_shape4DR
+
LOGICAL FUNCTION IsMiss(val, missv)
! Funciton to determine if a given value is missing vaue or near by
@@ -4322,6 +5186,20 @@ MODULE module_netcdf_utils
END FUNCTION same_datetime
+ SUBROUTINE stoprunfunc(msg, funcname, fname)
+! Subroutine to stop running and print a message when function is called from another one
+
+ IMPLICIT NONE
+
+ CHARACTER(LEN=*), INTENT(IN) :: funcname, fname
+ CHARACTER(LEN=*), INTENT(IN) :: msg
+
+ PRINT *, TRIM(errormsg)
+ PRINT *, ' From ' // TRIM(funcname) // ' when using ' // TRIM(fname) // ': ' // TRIM(msg)
+ STOP -1
+
+ END SUBROUTINE stoprunfunc
+
SUBROUTINE stoprun(msg, fname)
! Subroutine to stop running and print a message
@@ -4450,7 +5328,7 @@ MODULE module_netcdf_utils
! Local
INTEGER :: ic, Lunits
CHARACTER(len=Ss) :: str, units
- CHARACTER(len=Ss), DIMENSION(33) :: fixedunits
+ CHARACTER(len=Ss), DIMENSION(34) :: fixedunits
CHARACTER(len=Ss) :: fname
!!!!!!! Variables
@@ -4502,12 +5380,15 @@ MODULE module_netcdf_utils
fixedunits(31) = 'y' // TRIM(Nstrings(' ', 49))
fixedunits(32) = 'year' // TRIM(Nstrings(' ', 46))
fixedunits(33) = '-' // TRIM(Nstrings(' ', 49))
+ fixedunits(34) = '%' // TRIM(Nstrings(' ', 49))
homunits: IF (Index1DArrayS(fixedunits, 33, TRIM(units)) /= -1) THEN
genunits = TRIM(units)
ELSE
IF (TRIM(units) == '') THEN
genunits = '-'
+ ELSE IF (TRIM(units) == '%') THEN
+ genunits = '%'
ELSE IF (TRIM(units) == '1') THEN
genunits = '1'
ELSE IF (TRIM(units) == 'C') THEN
@@ -4826,7 +5707,7 @@ MODULE module_netcdf_utils
! Local
INTEGER :: i
INTEGER :: Navail, Navail1
- CHARACTER(len=Ss), DIMENSION(13) :: availunits
+ CHARACTER(len=Ss), DIMENSION(14) :: availunits
CHARACTER(len=Ss), DIMENSION(:), ALLOCATABLE :: availunits1
CHARACTER(len=Ss) :: fname
!!!!!!! Variables
@@ -4851,7 +5732,9 @@ MODULE module_netcdf_utils
availunits(11) = 'Pa' // TRIM(Nstrings(' ', 47))
availunits(12) = 'rad' // TRIM(Nstrings(' ', 47))
availunits(13) = '-' // TRIM(Nstrings(' ', 49))
- Navail = 13
+ availunits(14) = '%' // TRIM(Nstrings(' ', 49))
+
+ Navail = 14
! Comes out, that TRIM does not caputre ICHAR=0, some files might have this character in the units
@@ -4889,9 +5772,25 @@ MODULE module_netcdf_utils
PRINT *,' available ones: ', (TRIM(availunits1(i)), i=1, Navail1)
STOP
END IF
+
+ ELSE IF (eqstr(units1,'%')) THEN
+ Navail1 = 1
+ IF (ALLOCATED(availunits1)) DEALLOCATE(availunits1)
+ ALLOCATE (availunits1(Navail1))
+ availunits1(1) = '1' // TRIM(Nstrings(' ', 49))
+ IF (eqstr(units2,'1')) THEN
+ oper = 'mulc'
+ factor = 100.
+ ELSE
+ PRINT *,TRIM(errormsg)
+ msg = "for ref. units '" // TRIM(units1) // "' not available '" // TRIM(units2) // "' !!"
+ PRINT *,' ' // TRIM(fname) // ": " // TRIM(msg)
+ PRINT *,' available ones: ', (TRIM(availunits1(i)), i=1, Navail1)
+ STOP
+ END IF
ELSE IF (eqstr(units1,'1')) THEN
- Navail1 = 1
+ Navail1 = 2
IF (ALLOCATED(availunits1)) DEALLOCATE(availunits1)
ALLOCATE (availunits1(Navail1))
availunits1(1) = '-' // TRIM(Nstrings(' ', 49))
@@ -5119,6 +6018,8 @@ MODULE module_netcdf_utils
END IF changingunits
+ IF (ALLOCATED(availunits1)) DEALLOCATE(availunits1)
+
RETURN
END SUBROUTINE equal_units_operfactor
@@ -5141,8 +6042,6 @@ MODULE module_netcdf_utils
INTEGER :: i
INTEGER :: Navail, Navail1
CHARACTER(len=St) :: genunits2
- CHARACTER(len=Ss), DIMENSION(10) :: availunits
- CHARACTER(len=Ss), DIMENSION(:), ALLOCATABLE :: availunits1
CHARACTER(len=Ss) :: fname
!!!!!!! Variables
@@ -5200,8 +6099,6 @@ MODULE module_netcdf_utils
INTEGER :: i, j
INTEGER :: Navail, Navail1
CHARACTER(len=St) :: genunits2
- CHARACTER(len=Ss), DIMENSION(10) :: availunits
- CHARACTER(len=Ss), DIMENSION(:), ALLOCATABLE :: availunits1
CHARACTER(len=Ss) :: fname
!!!!!!! Variables
@@ -5265,8 +6162,6 @@ MODULE module_netcdf_utils
INTEGER :: i, j, k
INTEGER :: Navail, Navail1
CHARACTER(len=St) :: genunits2
- CHARACTER(len=Ss), DIMENSION(10) :: availunits
- CHARACTER(len=Ss), DIMENSION(:), ALLOCATABLE :: availunits1
CHARACTER(len=Ss) :: fname
!!!!!!! Variables
@@ -5336,8 +6231,6 @@ MODULE module_netcdf_utils
INTEGER :: i, j, k, l
INTEGER :: Navail, Navail1
CHARACTER(len=St) :: genunits2
- CHARACTER(len=Ss), DIMENSION(10) :: availunits
- CHARACTER(len=Ss), DIMENSION(:), ALLOCATABLE :: availunits1
CHARACTER(len=Ss) :: fname
!!!!!!! Variables
@@ -5356,13 +6249,39 @@ MODULE module_netcdf_utils
CALL equal_units_operfactor(units1, genunits2, ext, oper, factor)
newvals2 = fillvalue
-
+
+! See erro message below
+! PRINT *,' Lluis units2 ', TRIM(units2), ' genunits2 ', TRIM(genunits2), ' units1 ', TRIM(units1)
+! PRINT *,' Lluis oper ', TRIM(oper), ' factor ', factor, ' fillvalue ', fillvalue
+
! Changing values
IF (TRIM(oper) == 'addc') THEN
DO i=1, d1
DO j=1, d2
DO k=1, d3
DO l=1, d4
+! L. Fita
+! When compiling in debug mode this gave an error message this is why the print, but
+! no clue was found, QVAPOR variable
+! (...)
+! 2 2 30 1 : 4.99659063E-06 | -1.00000002E+30 <> T
+!Program received signal SIGFPE: Floating-point exception - erroneous arithmetic operation.
+!
+!Backtrace for this error:
+!#0 0x7fd25e15abd0 in ???
+!#1 0x7fd25e159e25 in ???
+!#2 0x7fd25de5bdcf in ???
+! at ./signal/../sysdeps/unix/sysv/linux/x86_64/sigaction.c:0
+!#3 0x5635de6a48f4 in __module_netcdf_utils_MOD_equal_units4dr
+! at /home/lluis/estudios/RegIPSL/tools/nc2wps/module_netcdf_utils.f90:5894
+!#4 0x5635de6d65c4 in __module_ncwps_MOD_get_3dfield
+! at /home/lluis/estudios/RegIPSL/tools/nc2wps/module_ncwps.f90:3652
+!#5 0x5635de73e314 in netcdf2wps
+! at /home/lluis/estudios/RegIPSL/tools/nc2wps/netcdf2wps.f90:2395
+!#6 0x5635de7637f5 in main
+! at /home/lluis/estudios/RegIPSL/tools/nc2wps/netcdf2wps.f90:69
+! IF (TRIM(units2) == 'kg kg-1') PRINT *,i,j,k,l, ':', vals2(i,j,k,l), '|', &
+! newvals2(i,j,k,l), ' <> ', vals2(i,j,k,l) /= fillvalue
IF (vals2(i,j,k,l) /= fillvalue) newvals2(i,j,k,l) = vals2(i,j,k,l) + factor
END DO
END DO
@@ -5502,7 +6421,7 @@ MODULE module_netcdf_utils
! dx: distance of the x-axis differentials
fname = 'linear_interp_densbars'
-
+
linear_interp_densbars = 0.
minxdiff = 0.
@@ -5546,6 +6465,15 @@ MODULE module_netcdf_utils
END DO
END IF
+
+ IF (iminxdiff(1) == -1) THEN
+ PRINT *, ' ' // TRIM(fname) // ' _______'
+ PRINT *, ' layers:', (i, ':', xvals(1,i), ',', xvals(2,i), i=1,d1)
+ PRINT *, ' y values:', yvals
+ PRINT *, ' layer to interpolate:', xsearch
+ msg = 'I can not interpolate at passed the location'
+ CALL stoprun(msg, fname)
+ END IF
newbaramount = 0.
IF (iminxdiff(2) - iminxdiff(1) > 0) THEN
diff --git a/nc2wps/namelist.nc2wps_rawWRF-example b/nc2wps/namelist.nc2wps_rawWRF-example
new file mode 100644
index 0000000000000000000000000000000000000000..859c84dea7c00181bc943ca586bb74a05abf3138
--- /dev/null
+++ b/nc2wps/namelist.nc2wps_rawWRF-example
@@ -0,0 +1,79 @@
+&indata
+ nfiles = 1
+ infilens = '/home/lluis/PY/wrfout_d01_2015-11-10_00:00:00',
+ Nintpres = 23
+ intpres = 100000,97500,95000,92500,90000,87500,85000,82500,80000,75000,70000,65000,60000,55000,50000,45000,40000,35000,30000,25000,20000,15000,10000,
+ invmaskn = 'LANDMASK'
+ invorogn = 'HGT'
+ invhursn = 'None'
+ invhussn = 'None'
+ invqvsn = 'Q2'
+ invtdsn = 'None'
+ invuasn = 'U10'
+ invvasn = 'V10'
+ invtasn = 'T2'
+ invtsn = 'TSK'
+ invsstn = 'SST'
+ invpsn = 'PSFC'
+ invpsln = 'None'
+ invstl1n = 'WRFstl'
+ invstl2n = 'WRFstl'
+ invstl3n = 'WRFstl'
+ invstl4n = 'WRFstl'
+ invswvl1n = 'WRFswvl'
+ invswvl2n = 'WRFswvl'
+ invswvl3n = 'WRFswvl'
+ invswvl4n = 'WRFswvl'
+ invuan = 'U'
+ inptua = 'modlev'
+ invvan = 'V'
+ inptva = 'modlev'
+ invtan = 'WRFta'
+ inptta = 'modlev'
+ invtdan = 'None'
+ invhurn = 'None'
+ invqvn = 'QVAPOR'
+ inptqv = 'modlev'
+ invhusn = 'None'
+ invzgn = 'WRFgeop'
+ inptzg = 'modlev'
+ p_top = 10000
+ itpt = 12
+ jtpt = 12
+ ktpt = 5
+ ltpt = 1
+ debug = .T.
+/
+
+&projection
+ nprojs = 1
+ version = 5
+ xfcst = 0.
+ map_source = 'WRF simulation'
+ iproj = 3
+ is_wind_grid_rel = .false.
+ startloc = 'SWCORNER'
+ lonres = 100000.
+ latres = 100000.
+ centlon = -68.
+ truelat1 = -32.5
+ truelat2 = -44.5
+ earth_radius = 6370000.
+ indtimen = 'Time'
+ indlatn = 'south_north'
+ indlonn = 'west_east'
+ indplevn = 'None'
+ indmodlevn = 'bottom_top'
+ invtimen = 'WRFtime'
+ invlatn = 'XLAT'
+ invlonn = 'XLONG'
+ invplevn = 'None'
+ invmodlevn = 'WRFpress'
+/
+
+&ungrib
+ Houtfilen = 'FILEtest'
+ iodate = '2015-11-10_00:00:00'
+ eodate = '2015-11-10_12:00:00'
+ ofreq = 10800
+/
diff --git a/nc2wps/namelist_nc2wps_CMIP6 b/nc2wps/namelist_nc2wps_CMIP6
new file mode 100644
index 0000000000000000000000000000000000000000..56ca54c9ba1ce5f9003cd49775f3d8001c935855
--- /dev/null
+++ b/nc2wps/namelist_nc2wps_CMIP6
@@ -0,0 +1,79 @@
+&indata
+ nfiles = 13,
+ infilens = '/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/ta/gn/latest/ta_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrLev/ua/gn/latest/ua_6hrLev_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1Byrendchk1Bmnendchk1Bda0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrLev/va/gn/latest/va_6hrLev_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1Byrendchk1Bmnendchk1Bda0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/hus/gn/latest/hus_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/zg/gn/latest/zg_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/psl/gn/latest/psl_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/uas/gn/latest/uas_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/vas/gn/latest/vas_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/tas/gn/latest/tas_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/tsl/gn/latest/tsl_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/huss/gn/latest/huss_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/mrsos/gn/latest/mrsos_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc','/bdd/CMIP6/ScenarioMIP/DKRZ/MPI-ESM1-2-HR/ssp370/r1i1p1f1/6hrPlevPt/ts/gn/latest/ts_6hrPlevPt_MPI-ESM1-2-HR_ssp370_r1i1p1f1_gn_-99999000600-endchk1yrendchk1mnendchk1da0000.nc',
+ inNskiplev = 0
+ invmaskn = 'varVland'
+ varVland = 'mrsos,1,-9999.,neq'
+ invhursn = 'None'
+ invhussn = 'huss'
+ invqvsn = 'None'
+ invtdsn = 'None'
+ invuasn = 'uas'
+ invvasn = 'vas'
+ invtasn = 'tas'
+ invtsn = 'ts'
+ invsstn = 'ts'
+ invpsn = 'None'
+ invpsln = 'psl'
+ invstl1n = 'tskextrap'
+ tskextrap = 'extrap,ts,1,linear;0.95'
+ invstl2n = 'None'
+ invstl3n = 'None'
+ invstl4n = 'None'
+ invswvl1n = 'mrsosextrap'
+ mrsosextrap = 'extrap,mrsos,1,linear;1.1'
+ invswvl2n = 'None'
+ invswvl3n = 'None'
+ invswvl4n = 'None'
+ invuan = 'ua'
+ inptua = 'modlev'
+ invvan = 'va'
+ inptva = 'modlev'
+ invtan = 'ta'
+ inptta = 'plev'
+ invtdan = 'None'
+ invhurn = 'None'
+ invqvn = 'None'
+ invhusn = 'hus'
+ inpthus = 'plev'
+ invzgn = 'zg'
+ p_top = 800
+ inptzg = 'plev'
+ maxtimediff = 21600,
+ itpt = 23
+ jtpt = 17
+ ktpt = 5
+ ltpt = 1
+/
+
+&projection
+ nprojs = 1
+ version = 5
+ xfcst = 0.
+ map_source = 'ECMWF'
+ iproj = 0
+ is_wind_grid_rel = .false.
+ startloc = 'SWCORNER'
+ lonres = 0.9375
+ latres = 0.9346333772438982
+ centlon = 0.
+ earth_radius = 6370000.
+ indtimen = 'time'
+ indlatn = 'lat'
+ indlonn = 'lon'
+ indplevn = 'plev'
+ indmodlevn = 'lev'
+ invtimen = 'time'
+ invlatn = 'lat'
+ invlonn = 'lon'
+ invplevn = 'plev'
+ invmodlevn = 'hybrid:ap,b,ps'
+/
+
+&ungrib
+ Houtfilen = 'FILE'
+ iodate = '2072-01-01_00:00:00'
+ eodate = '2071-12-31_23:59:59'
+ofreq = 21600
+/
+
diff --git a/nc2wps/netcdf2wps.f90 b/nc2wps/netcdf2wps.f90
index 06b5ff3189ca22bbca10e2d62f6231c03dc80511..476a0b021fca4d104d8a5bfbc767dc1d6c4cabd6 100644
--- a/nc2wps/netcdf2wps.f90
+++ b/nc2wps/netcdf2wps.f90
@@ -33,6 +33,17 @@ PROGRAM netcdf2wps
! computed following geostrophic balance. Humidity values are taken from the highest level of
! the input data.
! NOTE: This only works if all 3D-fields are at the same projection
+! 14.- Adding more WRF-derived variables to be able to directly process raw WRF output to create new
+! forcing (with 3D variables at model levels)
+! 'WRFpres': to use P+PB as input variable for 3D pressure
+! 'WRFgeop': to use PH+PHB as input variable for 3D geopotential
+! 'WRFta': to use potT_to_temp(T+300) as input variable for 3D temperature
+! 15.- Adding computation of slp (mean sea-level pressure) if psfc and orog are provided
+! NOTE: real.exe is only available to interpolate psfc (see in dyn_em/module_initialieze_real.F,
+! SUBROUTINE init_domain_rk) if the following input data is provided:
+! - ps, orog, psl
+! - ps, orog
+! - psl
! In case of hurs or q2 and hur or q are 'None' tds, td becomes is mandatory. In that case hur/s is
! retrieved following Magnus formula with D. Bolton, 1980, Mon. Wea. Rev. values
! In case 'huss' and 'hus' are provided, qvs, and qv are computed from them accordingly to:
@@ -64,7 +75,7 @@ PROGRAM netcdf2wps
IMPLICIT NONE
- INTEGER :: ncid, ierr
+ INTEGER :: ncid, ncidfound, ncid0, ierr
INTEGER :: timelen, lonlen, latlen, levellen, &
depthlen, modlevellen
INTEGER :: k, i, j, t
@@ -72,14 +83,14 @@ PROGRAM netcdf2wps
INTEGER, DIMENSION(2) :: start2d
INTEGER, DIMENSION(3) :: count3d
INTEGER, DIMENSION(4) :: count4d
- REAL, DIMENSION(:,:,:), ALLOCATABLE :: hurs, huss, qvs, uas, vas, tas, tds
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: orog, hurs, huss, qvs, uas, vas, tas, tds
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ts, sst, ps, psl, snd, sn, snh, ci
REAL, DIMENSION(:,:,:), ALLOCATABLE :: stl1, stl2, stl3, stl4, swvl1, swvl2, &
swvl3, swvl4
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ua_pl, va_pl, ta_pl, tda_pl, hur_pl, &
hus_pl, qv_pl, zg_pl
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ua_ml, va_ml, ta_ml, tda_ml, hur_ml, &
- hus_ml, qv_ml, zg_ml, p_ml, modpres
+ hus_ml, qv_ml, zg_ml, p_ml, pb_ml, modpres, geop3D
REAL, DIMENSION(:,:), ALLOCATABLE :: sst_mask
REAL, DIMENSION(:), ALLOCATABLE :: time
REAL, DIMENSION(:), ALLOCATABLE :: level, level2, lon, lat, lat2, modlevel, &
@@ -99,7 +110,8 @@ PROGRAM netcdf2wps
character (len=46) :: desc
! L. Fita
- INTEGER :: ip, iv, iit, nfs
+ INTEGER :: ip, iv, iit, nfs, ncit
+ INTEGER :: Ival
INTEGER :: idnamelist, idout, ioerr
INTEGER :: nfiles, itpt, jtpt, ktpt, ltpt, &
maxtimediff, inNskiplev, Nintpres, nprojs
@@ -136,21 +148,21 @@ PROGRAM netcdf2wps
indmodlevn
CHARACTER(len=St), DIMENSION(maxNprojs) :: invtimen, invlatn, invlonn, invplevn, &
invmodlevn, invpresn
- CHARACTER(len=St) :: invmaskn, invhursn, invhussn, invqvsn, &
- invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin
+ CHARACTER(len=St) :: invmaskn, invorogn, invhursn, invhussn, &
+ invqvsn, invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin
CHARACTER(len=St) :: invuan, invvan, invtan, invtdan, invhurn, &
invhusn, invqvn, invzgn
CHARACTER(len=St) :: invstl1n, invstl2n, invstl3n, invstl4n, &
invswvl1n, invswvl2n, invswvl3n, invswvl4n
- INTEGER :: inprojvmask, inprojvhurs, inprojvhuss, &
- inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, inprojvsst, &
- inprojvps, inprojvpsl, inprojvsnd, inprojvci
+ INTEGER :: inprojvmask, inprojvorog, inprojvhurs, &
+ inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, &
+ inprojvsst, inprojvps, inprojvpsl, inprojvsnd, inprojvci
INTEGER :: inprojvua, inprojvva, inprojvta, &
inprojvtda, inprojvhur, inprojvhus, inprojvqv, inprojvzg, inprojvpres
INTEGER :: inprojvstl1, inprojvstl2, inprojvstl3, &
inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4
CHARACTER(len=Sl), DIMENSION(:), ALLOCATABLE :: pfiles
- CHARACTER(len=Sl) :: indnB, invnA
+ CHARACTER(len=Sl) :: indnB, invnA, foundfilen
CHARACTER(len=St) :: attrn
CHARACTER(len=St) :: varu, varinu
CHARACTER(len=15) :: op
@@ -198,15 +210,16 @@ PROGRAM netcdf2wps
LOGICAL :: debug, file_exist
NAMELIST /indata/ nfiles, infilens, inNskiplev, inskiplev, Nintpres, intpres, invmaskn, &
- inprojvmask, varVland, invhursn, inprojvhurs, invhussn, inprojvhuss, invqvsn, inprojvqvs, &
- invuasn, inprojvuas, invvasn, inprojvvas, invtasn, inprojvtas, invtdsn, inprojvtds, invtsn, &
- inprojvts, invsstn, inprojvsst, invpsn, inprojvps, invpsln, inprojvpsl, invsndn, inprojvsnd, &
- invcin, inprojvci, invuan, inptua, inprojvua, invvan, inptva, inprojvva, invtan, inptta, &
- inprojvta, invtdan, inpttda, inprojvtda, invhurn, inpthur, inprojvhur, invhusn, inpthus, &
- inprojvhus, invqvn, inptqv, inprojvqv, invzgn, inptzg, inprojvzg, invpresn, inprojvpres, &
- invstl1n, inprojvstl1, tskextrap, invstl2n, inprojvstl2, invstl3n, inprojvstl3, invstl4n, &
- inprojvstl4, invswvl1n, inprojvswvl1, mrsosextrap, invswvl2n, inprojvswvl2, invswvl3n, &
- inprojvswvl3, invswvl4n, inprojvswvl4, p_top, maxtimediff, itpt, jtpt, ktpt, ltpt, debug
+ inprojvmask, varVland, invorogn, inprojvorog,invhursn, inprojvhurs, invhussn, inprojvhuss, &
+ invqvsn, inprojvqvs, invuasn, inprojvuas, invvasn, inprojvvas, invtasn, inprojvtas, invtdsn, &
+ inprojvtds, invtsn, inprojvts, invsstn, inprojvsst, invpsn, inprojvps, invpsln, inprojvpsl, &
+ invsndn, inprojvsnd, invcin, inprojvci, invuan, inptua, inprojvua, invvan, inptva, inprojvva,&
+ invtan, inptta, inprojvta, invtdan, inpttda, inprojvtda, invhurn, inpthur, inprojvhur, &
+ invhusn, inpthus, inprojvhus, invqvn, inptqv, inprojvqv, invzgn, inptzg, inprojvzg, invpresn,&
+ inprojvpres, invstl1n, inprojvstl1, tskextrap, invstl2n, inprojvstl2, invstl3n, inprojvstl3, &
+ invstl4n, inprojvstl4, invswvl1n, inprojvswvl1, mrsosextrap, invswvl2n, inprojvswvl2, &
+ invswvl3n, inprojvswvl3, invswvl4n, inprojvswvl4, p_top, maxtimediff, itpt, jtpt, ktpt, &
+ ltpt, debug
NAMELIST /projection/ nprojs, version, xfcst, map_source, iproj, is_wind_grid_rel, startloc, &
NLg, lonres, latres, centlon, truelat1, truelat2, earth_radius, indtimen, indlatn, indlonn, &
@@ -234,6 +247,8 @@ PROGRAM netcdf2wps
! ne: all values equal to the value will be considered land ([varname] != [value]; land)
! lt: all values below to the value will be considered land ([varname] < [value]; land)
! gt: all values greater to the value will be considered land ([varname] > [value]; land)
+! invorogn: name of the variable orography height within any flle in [infilens]
+! inprojvorog: number of projection of orog (accordingly to nprojs, 1 default)
! invhursn: name of the variable 2-m relative humidity within any flle in [infilens]
! inprojvhurs: number of projection of hurs (accordingly to nprojs, 1 default)
! invhussn: name of the variable 2-m specific water vapor content within any flle in [infilens]
@@ -267,7 +282,8 @@ PROGRAM netcdf2wps
! invvan: name of the variable air northward wind within any flle in [infilens]
! inptva: type of vertical level ('plev' or 'modlev') of the northward wind ('plev', default)
! inprojvva: number of projection of va (accordingly to nprojs, 1 default)
-! invtan: name of the variable air temperature within any flle in [infilens]
+! invtan: name of the variable air temperature within any flle in [infilens] ('WRFta' for temperature
+! from WRF raw output, where temperature is computed from WRF's 'T' variable)
! inptta: type of vertical level ('plev' or 'modlev') of the temperature ('plev', default)
! inprojvta: number of projection of ta (accordingly to nprojs, 1 default)
! invtdan: name of the variable air dew-point temperature within any flle in [infilens]
@@ -282,10 +298,12 @@ PROGRAM netcdf2wps
! invqvn: name of the variable air water vapor mixing ratio within any flle in [infilens]
! inptqv: type of vertical level ('plev' or 'modlev') of the mixing ratio ('plev', default)
! inprojvqv: number of projection of qv (accordingly to nprojs, 1 default)
-! invzgn: name of the variable air geopotential height within any flle in [infilens]
+! invzgn: name of the variable air geopotential height within any flle in [infilens] ('WRFgeop', to
+! be computed as PH+PHB from WRF output)
! inptzg: type of vertical level ('plev' or 'modlev') of the geopotential ('plev', default)
! inprojvzg: number of projection of zg (accordingly to nprojs, 1 default)
-! invpresn: name of the variable pressure (at model-level) within any file in [infilens]
+! invpresn: name of the variable pressure (at model-level) within any file in [infilens] ('WRFpres', to
+! be computed as P+PB from WRF output)
! inprojvpres: number of projection of pres (accordingly to nprojs, 1 default)
! invstl1n: name of the variable 1st layer (0-7 cm) ground temperature within any flle in [infilens]
! if invstl1n = 'WRFstl', soil temperatures will be computed using WRF's 'TSLB' variable
@@ -392,6 +410,7 @@ PROGRAM netcdf2wps
! 'hybrid:[modpvn1],[modpvn2],[modpvn3]' names of the variables used to compute pressure given by
! its hybdrid formula as:
! pres = [modpvn1]+[modpvn2]*[modpvn3]
+! 'WRFpres' pressure computed from WRF's output as P+PB
! ------- Output information -------
! Houtfilen: header of the name of the output files. Name of files as [Houtfilen]_[YYYY]-[MM]-[DD]_[HH]
! (in mulitple projections different files per projection will be generated as `Houtfilen[nproj]`)
@@ -411,17 +430,17 @@ PROGRAM netcdf2wps
infilens = '--'
! Providing default values for non-mandatory variables
- CALL Init_values(inNskiplev, invmaskn, varVland, invhursn, invhussn, invqvsn, invuasn, &
- invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, invtdan, &
- invstl1n, tskextrap, invstl2n, invstl3n, invstl4n, invswvl1n, mrsosextrap, invswvl2n, &
- invswvl3n, invswvl4n, inptua, inptva, inptta, inpttda, inpthur, inpthus, inptqv, inptzg, &
- p_top, maxtimediff, itpt, jtpt, ktpt, ltpt, debug, infconf)
+ CALL Init_values(inNskiplev, invmaskn, varVland, invorogn, invhursn, invhussn, invqvsn, &
+ invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, invpsn, invpsln, invsndn, invcin, &
+ invtdan, invstl1n, tskextrap, invstl2n, invstl3n, invstl4n, invswvl1n, mrsosextrap, &
+ invswvl2n, invswvl3n, invswvl4n, inptua, inptva, inptta, inpttda, inpthur, inpthus, inptqv, &
+ inptzg, p_top, maxtimediff, itpt, jtpt, ktpt, ltpt, debug, infconf)
CALL Init_proj(version, xfcst, map_source, iproj, is_wind_grid_rel, startloc, NLg, &
- lonres, latres, centlon, truelat1, truelat2, earth_radius, inprojvmask, inprojvhurs, &
- inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, inprojvts, &
- inprojvsst, inprojvps, inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, inprojvta, &
- inprojvtda, inprojvhur, inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2, &
+ lonres, latres, centlon, truelat1, truelat2, earth_radius, inprojvmask, inprojvorog, &
+ inprojvhurs, inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, inprojvtds, &
+ inprojvts, inprojvsst, inprojvps, inprojvpsl, inprojvsnd, inprojvci, inprojvua, inprojvva, &
+ inprojvta, inprojvtda, inprojvhur, inprojvhus, inprojvqv, inprojvzg, inprojvstl1, inprojvstl2,&
inprojvstl3, inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3, inprojvswvl4, &
indtimen, indlatn, indlonn, indplevn, indmodlevn, invtimen, invlatn, invlonn, invplevn, &
invmodlevn, infconf)
@@ -448,7 +467,7 @@ PROGRAM netcdf2wps
PRINT *," Read projection values from 'namelist.nc2wps' _______"
PRINT *,' nrpojs', nprojs
DO ip=1, nprojs
- PRINT *,' values for proejction:', ip
+ PRINT *,' values for projection:', ip
PRINT *,' version: ', version(ip)
PRINT *,' xfcst: ', xfcst(ip)
PRINT *,' map_source: ', TRIM(map_source(ip)), ' iproj: ', iproj(ip)
@@ -575,13 +594,14 @@ PROGRAM netcdf2wps
invlonn, invlatn, invtimen, invplevn, invmodlevn, &
version, xfcst, map_source, iproj, is_wind_grid_rel, startloc, NLg, lonres, latres, centlon, &
truelat1, truelat2, earth_radius, &
- invmaskn, invhursn, invhussn, invqvsn, invuasn, invvasn, invtasn, invtdsn, invtsn, invsstn, &
- invpsn, invpsln, invsndn, invcin, invuan, invvan, invtan, invtdan, invhurn, invhusn, invqvn, &
- invzgn, invstl1n, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, invswvl4n, &
- inprojvmask, inprojvhurs, inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, inprojvtas, &
- inprojvtds, inprojvts, inprojvsst, inprojvps, inprojvpsl, inprojvsnd, inprojvci, inprojvua, &
- inprojvva, inprojvta, inprojvtda, inprojvhur, inprojvhus,inprojvqv, inprojvzg, inprojvstl1, &
- inprojvstl2, inprojvstl3, inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3, &
+ invmaskn, invorogn, invhursn, invhussn, invqvsn, invuasn, invvasn, invtasn, invtdsn, invtsn, &
+ invsstn, invpsn, invpsln, invsndn, invcin, invuan, invvan, invtan, invtdan, invhurn, invhusn,&
+ invqvn, invzgn, invstl1n, invstl2n, invstl3n, invstl4n, invswvl1n, invswvl2n, invswvl3n, &
+ invswvl4n, inptua, inptva, inptta, inpttda, inptqv, inpthur, inpthus, inptzg, &
+ inprojvmask, inprojvorog, inprojvhurs, inprojvhuss, inprojvqvs, inprojvuas, inprojvvas, &
+ inprojvtas, inprojvtds, inprojvts, inprojvsst, inprojvps, inprojvpsl, inprojvsnd, inprojvci, &
+ inprojvua, inprojvva, inprojvta, inprojvtda, inprojvhur, inprojvhus,inprojvqv, inprojvzg, &
+ inprojvstl1, inprojvstl2, inprojvstl3, inprojvstl4, inprojvswvl1, inprojvswvl2, inprojvswvl3,&
inprojvswvl4, infconf, debug)
IF (debug) THEN
@@ -592,7 +612,7 @@ PROGRAM netcdf2wps
!! Looping over projections
!!!!!!!
Multiproj: DO ip=1, nprojs
- PRINT *,' * Processing files in ', ip, ' projection'
+ PRINT *,' * Processing files in ', ip, ' projection, amount of files', infconf%inNpfile(ip)
CALL InitRun(infconf, ip, infexec)
@@ -638,7 +658,10 @@ PROGRAM netcdf2wps
maxalldimt = MAXVAL(alldimts)
PRINT *,' Total amount of times:', tottimes, 'Largest time-values in file: ', maxalldimt
- timelen = infconf%timelenproj(ip)
+ ! Temporal-dependent variables will have timelen depending in which file the time-step is
+ ! found
+ !timelen = infconf%timelenproj(ip)
+ !timelen = maxalldimt
latlen = infconf%latlenproj(ip)
lonlen = infconf%lonlenproj(ip)
IF (infconf%plevlenproj(ip) /= -1) THEN
@@ -675,10 +698,6 @@ PROGRAM netcdf2wps
IF (ALLOCATED(sst_mask)) DEALLOCATE(sst_mask)
ALLOCATE(sst_mask(lonlen,latlen))
sst_mask = metfillvalue
- IF (ALLOCATED(time)) DEALLOCATE(time)
- ALLOCATE(time(timelen))
- IF (ALLOCATED(intimemat)) DEALLOCATE(intimemat)
- ALLOCATE(intimemat(6,timelen))
IF (ALLOCATED(level2Dh)) DEALLOCATE(level2Dh)
ALLOCATE(level2Dh(lonlen, latlen))
@@ -688,6 +707,10 @@ PROGRAM netcdf2wps
IF (ALLOCATED(sst_mask)) DEALLOCATE(sst_mask)
ALLOCATE(sst_mask(lonlen,latlen))
END IF
+ IF (infexec%computeorog) THEN
+ IF (ALLOCATED(orog)) DEALLOCATE(orog)
+ ALLOCATE(orog(lonlen,latlen,1))
+ END IF
IF (infexec%computehurs) THEN
IF (ALLOCATED(hurs)) DEALLOCATE(hurs)
ALLOCATE(hurs(lonlen,latlen,1))
@@ -735,6 +758,10 @@ PROGRAM netcdf2wps
IF (ALLOCATED(psl)) DEALLOCATE(psl)
ALLOCATE(psl(lonlen,latlen,1))
END IF
+ IF (infexec%computeorog .AND. infexec%computeps) THEN
+ IF (ALLOCATED(psl)) DEALLOCATE(psl)
+ ALLOCATE(psl(lonlen,latlen,1))
+ END IF
IF (infexec%computesnd) THEN
IF (ALLOCATED(snd)) DEALLOCATE(snd)
ALLOCATE(snd(lonlen,latlen,1))
@@ -840,176 +867,31 @@ PROGRAM netcdf2wps
IF (ALLOCATED(new3d)) DEALLOCATE(new3d)
ALLOCATE(new3d(lonlen,latlen,levellen,1))
- PRINT*,'***********************************************************'
- PRINT*,'*************** Getting variable-dimensions ***************'
- nx=lonlen
- ny=latlen
-
- attrn = 'units' // TRIM(Nstrings(' ', 25))
- !Reading Latitude
- PRINT *,' Latitude'
- ncid = search_var(nfs, ncids, TRIM(infconf%invlatn(ip)))
- vrank = inq_var_rank(ncid, TRIM(infconf%invlatn(ip)))
- IF (vrank == 1) THEN
- CALL get_var1D(ncid, latlen, infconf%invlatn(ip), lat)
- !Checking Latitude order in the dataset
- PRINT*,'Lat(1): ', lat(1)
- PRINT*,'lat(',ny,'):', lat(latlen)
- startlat=lat(1)
- ELSE IF (vrank == 2) THEN
- IF (ALLOCATED(var2dA)) DEALLOCATE(var2dA)
- ALLOCATE(var2dA(lonlen,latlen))
- CALL get_var2D(ncid, lonlen, latlen, infconf%invlatn(ip), var2dA)
- !Checking Latitude order in the dataset
- PRINT*,'Lat(1,1): ', var2dA(1,1)
- PRINT*,'Lat(',nx,',',ny,'): ',var2dA(lonlen,latlen)
- startlat=var2dA(1,1)
- ELSE IF (vrank == 3) THEN
- IF (ALLOCATED(var3dA)) DEALLOCATE(var3dA)
- ALLOCATE(var3dA(lonlen,latlen,timelen))
- CALL get_var3D(ncid, lonlen, latlen, timelen, infconf%invlatn(ip), var3dA)
- PRINT*,'lat(1,1,1): ', var3dA(1,1,1)
- PRINT*,'lat(',nx,',',ny,',1): ',var3dA(lonlen,latlen,1)
- startlat=var3dA(1,1,1)
- ELSE
- PRINT *, TRIM(errormsg)
- PRINT *," latgitude variable '" // TRIM(infconf%invlatn(ip)) // "' of rank:", vrank, &
- "' not ready !!"
- PRINT *,' available ones: 1, 2, 3'
- STOP "FATAL ERROR"
- END IF
-
- !Reading Longitude
- PRINT *,' Longitude'
- ncid = search_var(nfs, ncids, TRIM(infconf%invlonn(ip)))
- CALL read_dimlength (ncid, TRIM(infconf%indtimen(ip)), timelen)
- vrank = inq_var_rank(ncid, TRIM(infconf%invlonn(ip)))
- IF (vrank == 1) THEN
- CALL get_var1D(ncid, lonlen, infconf%invlonn(ip), lon)
- !Checking Latitude order in the dataset
- PRINT*,'Lon(1): ', lon(1)
- PRINT*,'Lon(',nx,'): ',lon(lonlen)
- startlon=lon(1)
- ELSE IF (vrank == 2) THEN
- CALL get_var2D(ncid, lonlen, latlen, infconf%invlonn(ip), var2dA)
- !Checking Latitude order in the dataset
- PRINT*,'Lon(1,1): ', var2dA(1,1)
- PRINT*,'Lon(',nx,',',ny,'): ',var2dA(lonlen,latlen)
- startlon=var2dA(1,1)
- ELSE IF (vrank == 3) THEN
- CALL get_var3D(ncid, lonlen, latlen, timelen, infconf%invlonn(ip), var3dA)
- PRINT*,'Lon(1,1,1): ', var3dA(1,1,1)
- PRINT*,'Lon(',nx,',',ny,',1): ',var3dA(lonlen,latlen,1)
- startlon=var3dA(1,1,1)
- ELSE
- PRINT *, TRIM(errormsg)
- PRINT *," Longitude variable '" // TRIM(infconf%invlonn(ip)) // "' of rank:", vrank, &
- "' not ready !!"
- PRINT *,' available ones: 1, 2, 3'
- STOP "FATAL ERROR"
- END IF
-
-!Reading Level
- PRINT *,'Level'
- IF (ALLOCATED(new1d)) DEALLOCATE(new1d)
- ALLOCATE(new1d(levellen))
- IF (TRIM(infconf%indplevn(ip)) /= 'None') THEN
- ncid = search_var(nfs, ncids, TRIM(infconf%invplevn(ip)))
- CALL read_dimlength (ncid, TRIM(infconf%indtimen(ip)), timelen)
- ! Pressure levels might come from wrfpress files with variable name 'P_PL'
- IF (infconf%invplevn(ip) == 'P_PL') THEN
- IF (ALLOCATED(var2dA)) DEALLOCATE(var2dA)
- ALLOCATE(var2dA(levellen, timelen))
- CALL get_var2D(ncid, levellen, timelen, infconf%invplevn(ip), var2dA)
- level = var2dA(:,1)
- ELSE
- CALL get_var1D(ncid, levellen, infconf%invplevn(ip), level)
- END IF
- ! Converting to common CF-conventions p-level units
- varu = variable_units('press')
- CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invplevn(ip), attrn, 1, varinu)
- CALL equal_units1DR(varu, varinu, levellen, level, oper=op, factor=fact, &
- fillvalue=metfillvalue, newvals2=new1d)
- level = new1d
-
- ! Checking for the presence of p_top
- computeptop = .FALSE.
- IF (p_top /= -9999) THEN
- leveln = MINVAL(level)
- IF (REAL(p_top) /= leveln) THEN
- computeptop = .TRUE.
- iptop = Index1DArrayR(level, levellen, leveln)
- PRINT *," 'p_top' =", p_top, ' higher than the latest level of data in input !!'
- PRINT *,' increasing amounf of vertical levels, by introducing p_top'
- PRINT *,' 3D variables at pres=', p_top, ' Pa will be filled by actual values at ' // &
- 'the last vertical level ', iptop, ' of the input data at: ', leveln
- IF (ALLOCATED(levelptop)) DEALLOCATE(levelptop)
- ALLOCATE(levelptop(levellen+1))
- levelptop(1:levellen) = level
- levelptop(levellen+1) = p_top*1. + 1.
-
- IF (ALLOCATED(lon2D)) DEALLOCATE(lon2D)
- ALLOCATE(lon2D(lonlen,latlen))
- IF (ALLOCATED(lat2D)) DEALLOCATE(lat2D)
- ALLOCATE(lat2D(lonlen,latlen))
-
- CALL get_lonlat2D(lonlen, latlen, timelen, nfs, ncids, infconf%invlonn(ip), &
- infconf%invlatn(ip), lon2D, lat2D, debug)
-
- END IF
- END IF
- ELSE
- ! intpres is only used if there is not a 'indplevn'
- level = intpres(1:Nintpres)
- END IF
-
-! PRINT *,'mod-level'
-! IF (TRIM(indmodlevn) /= 'None') THEN
-! IF (ALLOCATED(modpres)) DEALLOCATE(modpres)
-! ALLOCATE(modpres(lonlen, latlen, modlevellen, timelen))
-! ! Different options
-! modplev: IF (invmodlevn(1:7) == 'hybrid:') THEN
-! CALL compute_hybridp(lonlen, latlen, modlevellen, timelen, invmodlevn, nfs, ncids, &
-! modpres)
-! ELSE
-! ncid = search_var(nfs, ncids, TRIM(invmodlevn))
-! CALL read_dimlength (ncid, TRIM(indtimen), timelen)
-! CALL get_var4D(ncid, lonlen, latlen, modlevellen, timelen, invmodlevn, modpres)
-! CALL get_varattr_nfiles(debug, nfs, ncids, invmodlevn, attrn, 1, varu)
-! END IF modplev
-! !Checking levels order in the dataset
-! PRINT*,'MOD-L(1):', modlevel(1)
-! PRINT*,'MODL(', modlevellen, '):', modlevel(levellen)
-! END IF
-
-!Checking model-levels order in the dataset
-! PRINT*,'L(', itpt, jtpt, 1, 1, '):', level(itpt,jtpt,1,1)
-! PRINT*,'L(', itpt, jtpt, levellen, 1, '):', level(itpt,jtpt,levellen,1)
-
!Reading Time
PRINT *,' Time information _______'
IF (ALLOCATED(alltimes)) DEALLOCATE(alltimes)
ALLOCATE(alltimes(tottimes))
iit = 1
- DO i=1, nfs
- CALL read_dimlength (ncids(i), TRIM(infconf%indtimen(ip)), timelen)
- DEALLOCATE(time)
+ DO i=1, infconf%inNpfile(ip)
+ CALL read_dimlength (infconf%inprojncid(ip,i), TRIM(infconf%indtimen(ip)), timelen)
+ IF (ALLOCATED(time)) DEALLOCATE(time)
ALLOCATE(time(timelen))
start1d(1) = 1
count1d(1) = timelen
PRINT *,'Time'
IF (TRIM(invtimen(ip)) /= 'WRFtime') THEN
- !ncid = search_var(nfs, ncids, TRIM(invtimen(ip)))
- CALL get_var1D(ncids(i), timelen, infconf%invtimen(ip), time)
+ !ncid = search_var(main, nfs, ncids, TRIM(invtimen(ip)))
+ CALL get_var1D(infconf%inprojncid(ip,i), timelen, infconf%invtimen(ip), time)
ELSE
PRINT *, TRIM(InfMsg)
PRINT *,' ' // TRIM(main) // ": getting time values from WRF's 'Times' variable !!"
invnA = 'Times'
- ncid = search_var(nfs, ncids, TRIM(invnA))
- IF (ALLOCATED(inWRFtimes)) DEALLOCATE(inWRFtimes)
- ALLOCATE(inWRFtimes(timelen))
- CALL compute_WRFtimes(ncid, timelen, inWRFtimes)
- time = inWRFtimes
+ IF (isin_file(infconf%inprojfilen(ip,i), invnA)) THEN
+ IF (ALLOCATED(inWRFtimes)) DEALLOCATE(inWRFtimes)
+ ALLOCATE(inWRFtimes(timelen))
+ CALL compute_WRFtimes(infconf%inprojncid(ip,i), timelen, inWRFtimes)
+ time = inWRFtimes
+ END IF
END IF
!Checking time format in the dataset
PRINT *,' ', i, " File: '" // TRIM(infconf%infilens(i)) // "' T(1):", time(1), ' T(', &
@@ -1019,26 +901,6 @@ PROGRAM netcdf2wps
END DO
PRINT *,' Total times T(1):', alltimes(1), ' T(',tottimes,'):', alltimes(tottimes)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- PRINT*, '**** Output File Parameters ****'
- PRINT*, ' version = ',version(ip)
- PRINT*, ' xfcst = ',xfcst(ip)
- PRINT*, ' map_source = ',TRIM(map_source(ip))
- PRINT*, ' nx = ',nx
- PRINT*, ' ny = ',ny
- PRINT*, ' iproj = ',iproj(ip)
- PRINT*, ' startloc = ',TRIM(startloc(ip))
- PRINT*, ' startlat = ',startlat
- PRINT*, ' startlon = ',startlon
- PRINT*, ' NLg = ',NLg(ip)
- PRINT*, ' lonres = ',lonres(ip)
- PRINT*, ' latres = ',latres(ip)
- PRINT*, ' central longitude =', centlon(ip)
- PRINT*, ' truelat1 = ',truelat1(ip)
- PRINT*, ' truelat2 = ',truelat2(ip)
- PRINT*, ' earth_radius = ',earth_radius(ip)
- PRINT*, ' wind_rotation= ',is_wind_grid_rel(ip)
-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! !
@@ -1059,6 +921,8 @@ PROGRAM netcdf2wps
!output="/homedata/snamendra/WPS/data/FILE:"//date_out1
! Soil temperature, we want to compute (if necessary) it only once (not memory efficient !!)
+ attrn = 'units' // TRIM(Nstrings(' ', 25))
+
IF (infexec%computestl1) THEN
IF (TRIM(infconf%invstl1n) == 'WRFstl') THEN
Ndpths = 4
@@ -1067,7 +931,7 @@ PROGRAM netcdf2wps
dpths = (/ 0.035, 0.385, 0.64, 1.775 /)
invnA = 'TSLB'
- CALL multisearch_var(debug, nfs, ncids, TRIM(invnA), Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, TRIM(invnA), Nfvar, ffilens, fncids)
PRINT *, TRIM(infmsg)
PRINT *, " Computing 'stl' from WRF's 'TSLB' found at units ", fncids(1:Nfvar)
IF (ALLOCATED(dimts)) DEALLOCATE(dimts)
@@ -1086,7 +950,8 @@ PROGRAM netcdf2wps
ALLOCATE(WRFstl(lonlen, latlen, Ndpths, dimts(i)))
IF (ALLOCATED(new4d)) DEALLOCATE(new4d)
ALLOCATE(new4d(lonlen, latlen, Ndpths, dimts(i)))
- CALL compute_WRFstl(fncids(i), lonlen, latlen, dimts(i), Ndpths, dpths, WRFstl)
+ CALL compute_WRFstl(nfs, ncids, fncids(i), lonlen, latlen, dimts(i), indnB, Ndpths, dpths, &
+ WRFstl)
CALL get_varattr(fncids(i), invnA, attrn, 1, varinu)
CALL equal_units4DR(varu, varinu, lonlen, latlen, Ndpths, dimts(i), WRFstl, oper=op, &
@@ -1117,7 +982,7 @@ PROGRAM netcdf2wps
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, TRIM(invnA), Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, TRIM(invnA), Nfvar, ffilens, fncids)
indnB = indtimen(ip)
IF (ALLOCATED(dimts)) DEALLOCATE(dimts)
@@ -1188,7 +1053,7 @@ PROGRAM netcdf2wps
lays(:,4) = (/ 1.00, 2.55 /)
invnA = 'SMOIS'
- CALL multisearch_var(debug, nfs, ncids, TRIM(invnA), Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, TRIM(invnA), Nfvar, ffilens, fncids)
PRINT *, TRIM(infmsg)
PRINT *, " Computing 'swvl' from WRF's 'SMOIS' found at unit ", fncids(1:Nfvar)
IF (ALLOCATED(dimts)) DEALLOCATE(dimts)
@@ -1207,7 +1072,8 @@ PROGRAM netcdf2wps
IF (ALLOCATED(new4d)) DEALLOCATE(new4d)
ALLOCATE(new4d(lonlen, latlen, Ndpths, dimts(i)))
- CALL compute_WRFswvl(fncids(i), lonlen, latlen, dimts(i), Ndpths, lays, WRFswvl)
+ CALL compute_WRFswvl(nfs, ncids,fncids(i), lonlen, latlen, dimts(i), indnB,Ndpths, &
+ lays, WRFswvl)
varu = variable_units('swvl1')
CALL get_varattr(fncids(i), invnA, attrn, dimts(i), varinu)
CALL equal_units4DR(varu, varinu, lonlen, latlen, Ndpths, dimts(i), WRFswvl, oper=op, &
@@ -1237,7 +1103,7 @@ PROGRAM netcdf2wps
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, TRIM(invnA), Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, TRIM(invnA), Nfvar, ffilens, fncids)
indnB = indtimen(ip)
IF (ALLOCATED(dimts)) DEALLOCATE(dimts)
@@ -1308,7 +1174,14 @@ PROGRAM netcdf2wps
CALL stoprun(msg, main)
END IF
+ nx=lonlen
+ ny=latlen
+
+ !!
+ ! Temporal loop
+ !!
ALLOCATE(slab(nx,ny))
+ PRINT *," ******* Starting temporal loop ****** ***** **** *** ** *"
time_steps: DO t=1,Nodates
WRITE(cyy,'(i4.4)') oDs(t,1)
@@ -1320,10 +1193,238 @@ PROGRAM netcdf2wps
date_out1 = cyy//'-'//cmm//'-'//cdd//'_'//chh1
date_out = cyy//'-'//cmm//'-'//cdd//'_'//chh1//':'//mii//':'//sii
+ IF (TRIM(invtimen(ip)) /= 'WRFtime') THEN
+ CALL get_var_equivmultitimes(debug, infconf, infconf%inprojvars(ip,1), ip, oDs(t,:), &
+ maxtimediff, inc, ncid, ncit, foundfilen)
+ ELSE
+ CALL get_var_equivmultiWRFtimes(debug, infconf, infconf%inprojvars(ip,1), ip, oDs(t,:), &
+ maxtimediff, inc, ncidfound, ncit, foundfilen)
+ END IF
+ CALL read_dimlength (ncidfound, TRIM(indtimen(ip)), timelen)
+ PRINT *, t, ':', TRIM(date_out), " file name '" // TRIM(foundfilen) // "' unit: " // &
+ ItoS(ncidfound) // " time-step: " // ItoS(ncit)
+
+ IF (ALLOCATED(time)) DEALLOCATE(time)
+ ALLOCATE(time(timelen))
+ IF (ALLOCATED(intimemat)) DEALLOCATE(intimemat)
+ ALLOCATE(intimemat(6,timelen))
+
+ PRINT*,'***********************************************************'
+ PRINT*,'*************** Getting variable-dimensions ***************'
+
+ PRINT *,' Dimensions dx, dy, dz, dt:', nx, ny, levellen, timelen
+
+ !Reading Latitude
+ PRINT *,' Latitude'
+ IF (.NOT.isin_file(foundfilen, TRIM(infconf%invlatn(ip)) )) THEN
+ ncid0 = search_var(main, nfs, ncids, TRIM(infconf%invlatn(ip)))
+ CALL read_dimlength (ncid0, TRIM(infconf%indtimen(ip)), timelen)
+ ncid = ncid0
+ PRINT *, ' ' // ": latitude named '" // TRIM(infconf%invlatn(ip)) // &
+ "' not found in '" // TRIM(foundfilen) // "' !!"
+ PRINT *, ' ' // " using netcdf id " // TRIM(ItoS(ncid0)) // " time length: ", timelen
+ ELSE
+ ncid = ncidfound
+ END IF
+ PRINT *,' Lluis getting rank ....'
+ vrank = inq_var_rank(ncid, TRIM(infconf%invlatn(ip)))
+ PRINT *,' vrank:', vrank
+ IF (vrank == 1) THEN
+ CALL get_var1D(ncid, latlen, infconf%invlatn(ip), lat)
+ !Checking Latitude order in the dataset
+ PRINT*,'Lat(1): ', lat(1)
+ PRINT*,'lat(',ny,'):', lat(latlen)
+ startlat=lat(1)
+ ELSE IF (vrank == 2) THEN
+ IF (ALLOCATED(var2dA)) DEALLOCATE(var2dA)
+ ALLOCATE(var2dA(lonlen,latlen))
+ CALL get_var2D(ncid, lonlen, latlen, infconf%invlatn(ip), var2dA)
+ !Checking Latitude order in the dataset
+ PRINT*,'Lat(1,1): ', var2dA(1,1)
+ PRINT*,'Lat(',nx,',',ny,'): ',var2dA(lonlen,latlen)
+ startlat=var2dA(1,1)
+ ELSE IF (vrank == 3) THEN
+ IF (ALLOCATED(var3dA)) DEALLOCATE(var3dA)
+ ALLOCATE(var3dA(lonlen,latlen,timelen))
+ CALL get_var3D(ncid, lonlen, latlen, timelen, infconf%invlatn(ip), var3dA)
+ PRINT*,'lat(1,1,1): ', var3dA(1,1,1)
+ PRINT*,'lat(',nx,',',ny,',1): ',var3dA(lonlen,latlen,1)
+ startlat=var3dA(1,1,1)
+ ELSE
+ PRINT *, TRIM(errormsg)
+ PRINT *," latgitude variable '" // TRIM(infconf%invlatn(ip)) // "' of rank:", vrank, &
+ "' not ready !!"
+ PRINT *,' available ones: 1, 2, 3'
+ STOP "FATAL ERROR"
+ END IF
+
+ !Reading Longitude
+ PRINT *,' Longitude'
+ IF (.NOT.isin_file(foundfilen, TRIM(infconf%invlatn(ip)) )) THEN
+ ncid0 = search_var(main, nfs, ncids, TRIM(infconf%invlonn(ip)))
+ CALL read_dimlength (ncid0, TRIM(infconf%indtimen(ip)), timelen)
+ ncid = ncid0
+ ELSE
+ ncid = ncidfound
+ END IF
+ vrank = inq_var_rank(ncid, TRIM(infconf%invlonn(ip)))
+ IF (vrank == 1) THEN
+ CALL get_var1D(ncid, lonlen, infconf%invlonn(ip), lon)
+ !Checking Longitude order in the dataset
+ PRINT*,'Lon(1): ', lon(1)
+ PRINT*,'Lon(',nx,'): ',lon(lonlen)
+ startlon=lon(1)
+ ELSE IF (vrank == 2) THEN
+ CALL get_var2D(ncid, lonlen, latlen, infconf%invlonn(ip), var2dA)
+ !Checking Longitude order in the dataset
+ PRINT*,'Lon(1,1): ', var2dA(1,1)
+ PRINT*,'Lon(',nx,',',ny,'): ',var2dA(lonlen,latlen)
+ startlon=var2dA(1,1)
+ ELSE IF (vrank == 3) THEN
+ CALL get_var3D(ncid, lonlen, latlen, timelen, infconf%invlonn(ip), var3dA)
+ PRINT*,'Lon(1,1,1): ', var3dA(1,1,1)
+ PRINT*,'Lon(',nx,',',ny,',1): ',var3dA(lonlen,latlen,1)
+ startlon=var3dA(1,1,1)
+ ELSE
+ PRINT *, TRIM(errormsg)
+ PRINT *," Longitude variable '" // TRIM(infconf%invlonn(ip)) // "' of rank:", vrank, &
+ "' not ready !!"
+ PRINT *,' available ones: 1, 2, 3'
+ STOP "FATAL ERROR"
+ END IF
+
+!Reading Level
+ PRINT *,'Level'
+ IF (ALLOCATED(new1d)) DEALLOCATE(new1d)
+ ALLOCATE(new1d(levellen))
+ IF (TRIM(infconf%indplevn(ip)) /= 'None') THEN
+ IF (.NOT.isin_file(foundfilen, TRIM(infconf%invplevn(ip)) )) THEN
+ ncid0 = search_var(main, nfs, ncids, TRIM(infconf%invplevn(ip)))
+ CALL read_dimlength (ncid0, TRIM(infconf%indtimen(ip)), timelen)
+ ELSE
+ ncid = ncidfound
+ END IF
+ ! Pressure levels might come from wrfpress files with variable name 'P_PL'
+ IF (infconf%invplevn(ip) == 'P_PL') THEN
+ IF (ALLOCATED(var2dA)) DEALLOCATE(var2dA)
+ ALLOCATE(var2dA(levellen, timelen))
+ CALL get_var2D(ncid, levellen, timelen, infconf%invplevn(ip), var2dA)
+ level = var2dA(:,1)
+ ELSE
+ CALL get_var1D(ncid, levellen, infconf%invplevn(ip), level)
+ END IF
+ ! Converting to common CF-conventions p-level units
+ varu = variable_units('press')
+ CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invplevn(ip), attrn, 1, varinu)
+ CALL equal_units1DR(varu, varinu, levellen, level, oper=op, factor=fact, &
+ fillvalue=metfillvalue, newvals2=new1d)
+ level = new1d
+
+ ! Checking for the presence of p_top
+ computeptop = .FALSE.
+ IF (p_top /= -9999) THEN
+ leveln = MINVAL(level)
+ IF (REAL(p_top) /= leveln) THEN
+ computeptop = .TRUE.
+ iptop = Index1DArrayR(level, levellen, leveln)
+ PRINT *," 'p_top' =", p_top, ' higher than the latest level of data in input !!'
+ PRINT *,' increasing amounf of vertical levels, by introducing p_top'
+ PRINT *,' 3D variables at pres=', p_top, ' Pa will be filled by actual values at ' // &
+ 'the last vertical level ', iptop, ' of the input data at: ', leveln
+ IF (ALLOCATED(levelptop)) DEALLOCATE(levelptop)
+ ALLOCATE(levelptop(levellen+1))
+ levelptop(1:levellen) = level
+ levelptop(levellen+1) = p_top*1. + 1.
+
+ IF (ALLOCATED(lon2D)) DEALLOCATE(lon2D)
+ ALLOCATE(lon2D(lonlen,latlen))
+ IF (ALLOCATED(lat2D)) DEALLOCATE(lat2D)
+ ALLOCATE(lat2D(lonlen,latlen))
+
+ CALL get_lonlat2D(lonlen, latlen, timelen, nfs, ncids, infconf%invlonn(ip), &
+ infconf%invlatn(ip), lon2D, lat2D, debug)
+
+ END IF
+ END IF
+ ELSE
+ ! intpres is only used if there is not a 'indplevn'
+ level = intpres(1:Nintpres)
+ END IF
+
+! PRINT *,'mod-level'
+! IF (TRIM(indmodlevn) /= 'None') THEN
+! IF (ALLOCATED(modpres)) DEALLOCATE(modpres)
+! ALLOCATE(modpres(lonlen, latlen, modlevellen, timelen))
+! ! Different options
+! modplev: IF (invmodlevn(1:7) == 'hybrid:') THEN
+! CALL compute_hybridp(lonlen, latlen, modlevellen, timelen, invmodlevn, nfs, ncids, &
+! modpres)
+! ELSE
+! ncid = search_var(main, nfs, ncids, TRIM(invmodlevn))
+! CALL read_dimlength (ncid, TRIM(indtimen), timelen)
+! CALL get_var4D(ncid, lonlen, latlen, modlevellen, timelen, invmodlevn, modpres)
+! CALL get_varattr_nfiles(debug, nfs, ncids, invmodlevn, attrn, 1, varu)
+! END IF modplev
+! !Checking levels order in the dataset
+! PRINT*,'MOD-L(1):', modlevel(1)
+! PRINT*,'MODL(', modlevellen, '):', modlevel(levellen)
+! END IF
+
+!Checking model-levels order in the dataset
+! PRINT*,'L(', itpt, jtpt, 1, 1, '):', level(itpt,jtpt,1,1)
+! PRINT*,'L(', itpt, jtpt, levellen, 1, '):', level(itpt,jtpt,levellen,1)
- PRINT *, t, ':', TRIM(date_out)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ IF (t == 1) THEN
+ PRINT*, '**** Output File Parameters ****'
+ PRINT*, ' version = ',version(ip)
+ PRINT*, ' xfcst = ',xfcst(ip)
+ PRINT*, ' map_source = ',TRIM(map_source(ip))
+ PRINT*, ' nx = ',nx
+ PRINT*, ' ny = ',ny
+ PRINT*, ' iproj = ',iproj(ip)
+ PRINT*, ' startloc = ',TRIM(startloc(ip))
+ PRINT*, ' startlat = ',startlat
+ PRINT*, ' startlon = ',startlon
+ PRINT*, ' NLg = ',NLg(ip)
+ PRINT*, ' lonres = ',lonres(ip)
+ PRINT*, ' latres = ',latres(ip)
+ PRINT*, ' central longitude =', centlon(ip)
+ PRINT*, ' truelat1 = ',truelat1(ip)
+ PRINT*, ' truelat2 = ',truelat2(ip)
+ PRINT*, ' earth_radius = ',earth_radius(ip)
+ PRINT*, ' wind_rotation= ',is_wind_grid_rel(ip)
+
+ ! Checking consistency of debugging grid points
+ IF (itpt > lonlen) THEN
+ msg='Testing itpt: ' // TRIM(ItoS(itpt)) // ' to large for dimx: ' // TRIM(ItoS(lonlen))
+ CALL stoprun(msg, main)
+ END IF
+ IF (jtpt > latlen) THEN
+ msg='Testing jtpt: ' // TRIM(ItoS(jtpt)) // ' to large for dimy: ' // TRIM(ItoS(latlen))
+ CALL stoprun(msg, main)
+ END IF
+ IF (TRIM(infconf%indplevn(ip)) /= 'None') THEN
+ IF (ktpt > levellen) THEN
+ msg='Testing ktpt: '//TRIM(ItoS(ktpt))//' to large for dimz: ' // TRIM(ItoS(levellen))
+ CALL stoprun(msg, main)
+ END IF
+ ELSE
+ IF (ktpt > modlevellen) THEN
+ msg='Testing ktpt: '//TRIM(ItoS(ktpt))//' to large for dimz: '//TRIM(ItoS(modlevellen))
+ CALL stoprun(msg, main)
+ END IF
+ END IF
+ IF (ltpt > timelen) THEN
+ msg='Testing ltpt: ' // TRIM(ItoS(ltpt)) // ' to large for dimt: ' // TRIM(ItoS(timelen))
+ CALL stoprun(msg, main)
+ END IF
+ END IF
+ ncid = ncidfound
+
IF (infexec%computemask) sst_mask = 0.
+ IF (infexec%computeorog) orog = 0.
IF (infexec%computehurs) hurs = 0.
IF (infexec%computehuss) huss = 0.
IF (infexec%computeqvs) qvs = 0.
@@ -1367,24 +1468,46 @@ PROGRAM netcdf2wps
PRINT*,'**************************************************'
PRINT*,'******* Reading 3D Variables(lon,lat,time) *******'
+ IF (infexec%computeorog) THEN
+ PRINT *,'Orography'
+ ncid = search_var(main, nfs, ncids, TRIM(infconf%invorogn))
+ vrank = inq_var_rank(ncid, TRIM(infconf%invorogn))
+ IF (vrank == 2) THEN
+ CALL get_var2D(ncid, lonlen, latlen, infconf%invorogn, var2dA)
+ orog(:,:,1) = var2dA
+ ELSE IF (vrank == 3) THEN
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invorogn, 'orog', infconf%indtimen(ip), &
+ infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, orog)
+ varu = variable_units('orog')
+ CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invorogn, attrn, 1, varinu)
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, orog, oper=op, factor=fact, &
+ fillvalue=metfillvalue, newvals2=new2d)
+ orog = new2d
+ ELSE
+ msg = "Orography variable '" // TRIM(infconf%invorogn) // "' of rank: " // &
+ TRIM(ItoS(vrank)) // " not ready !! Only 2D and 3D are available"
+ CALL StopRun(msg, main)
+ END IF
+ END IF
+
IF (infexec%computehurs) THEN
PRINT *,'2m relative humidity'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invhursn, 'hurs', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invhursn, 'hurs', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, hurs)
varu = variable_units('hurs')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invhursn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, hurs, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, hurs, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
hurs = new2d
END IF
IF (infexec%computehuss) THEN
PRINT *,'2m specific humidity'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invhussn, 'huss', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invhussn, 'huss', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, huss)
varu = variable_units('huss')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invhussn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, huss, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, huss, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
huss = new2d
IF (TRIM(infconf%invqvsn) == 'None') THEN
@@ -1404,55 +1527,55 @@ PROGRAM netcdf2wps
IF (infexec%computeqvs) THEN
PRINT *,'2m water vapour mixing ratio'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invqvsn, 'qvs', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invqvsn, 'qvs', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, qvs)
varu = variable_units('qvs')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invqvsn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, qvs, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, qvs, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
qvs = new2d
END IF
IF (infexec%computeuas) THEN
PRINT *,'10m eastward wind speed'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invuasn, 'uas', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invuasn, 'uas', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, uas)
varu = variable_units('uas')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invuasn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, uas, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, uas, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
uas = new2d
END IF
IF (infexec%computevas) THEN
PRINT *,'10m northward wind speed'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invvasn, 'vas', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invvasn, 'vas', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, vas)
varu = variable_units('vas')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invvasn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, vas, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, vas, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
vas = new2d
END IF
IF (infexec%computetas) THEN
PRINT *,'2m air-temperature'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invtasn, 'tas', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invtasn, 'tas', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, tas)
varu = variable_units('tas')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invtasn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, tas, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, tas, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
tas = new2d
END IF
IF (infexec%computetds) THEN
PRINT *,'2m dew-point temperature'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invtdsn, 'tds', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invtdsn, 'tds', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, tds)
varu = variable_units('tds')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invtdsn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, tds, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, tds, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
tds = new2d
! Imposing the computation of the hurss / qvs
@@ -1466,55 +1589,55 @@ PROGRAM netcdf2wps
IF (infexec%computets) THEN
PRINT *,'skin temperature'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invtsn, 'ts', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invtsn, 'ts', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, ts)
varu = variable_units('ts')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invtsn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, ts, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, ts, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
ts = new2d
END IF
IF (infexec%computesst) THEN
PRINT *,'sea surface temperature'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invsstn, 'sst', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invsstn, 'sst', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, sst)
varu = variable_units('sst')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invsstn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, sst, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, sst, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
sst = new2d
END IF
IF (infexec%computeps) THEN
PRINT *,'surface pressure'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invpsn, 'ps', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invpsn, 'ps', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, ps)
varu = variable_units('ps')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invpsn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, ps, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, ps, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
ps = new2d
END IF
IF (infexec%computepsl) THEN
PRINT *,'sea-level pressure'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invpsln, 'psl', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invpsln, 'psl', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, psl)
varu = variable_units('psl')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invpsln, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, psl, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, psl, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
psl = new2d
END IF
IF (infexec%computesnd) THEN
PRINT *,'snow thickness'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invsndn, 'snd', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invsndn, 'snd', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, snd)
varu = variable_units('snd')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invsndn, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, snd, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, snd, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
snd = new2d
! Computing various diagnostics after ungrib/src/rrpr.F
@@ -1529,7 +1652,7 @@ PROGRAM netcdf2wps
END IF
snh = sn*0.005
ELSE
- msg = "I do not know how to compute now height using map_source= '" // &
+ msg = "I do not know how to compute now height using map_source= '" // &
TRIM(map_source(ip)) // "' "
PRINT *,TRIM(msg)
END IF
@@ -1537,11 +1660,11 @@ PROGRAM netcdf2wps
IF (infexec%computeci) THEN
PRINT *,'sea-ice cover'
- CALL get_2Dfield(debug, nfs, ncids, infconf%invcin, 'ci', infconf%indtimen(ip), &
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invcin, 'ci', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, ci)
varu = variable_units('ci')
CALL get_varattr_nfiles(debug, nfs, ncids, infconf%invcin, attrn, 1, varinu)
- CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, ci, oper=op, factor=fact, &
+ CALL equal_units3DR(varu, varinu, lonlen, latlen, 1, ci, oper=op, factor=fact, &
fillvalue=metfillvalue, newvals2=new2d)
ci = new2d
END IF
@@ -1552,16 +1675,25 @@ PROGRAM netcdf2wps
IF (infexec%computemask) THEN
PRINT *,'land/sea mask (1: land, 0: sea)'
IF (TRIM(infconf%invmaskn) /= 'varVland') THEN
- IF (vrank == 3) THEN
- CALL get_3Dfield(debug, nfs, ncids, infconf%invmaskn, 'landseamask', &
- infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
- timelen, var3dA)
+ ncid = search_var(main, nfiles, allncids, TRIM(infconf%invmaskn))
+ vrank = inq_var_rank(ncid, TRIM(infconf%invmaskn))
+ IF (vrank == 4) THEN
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invmaskn, 'landsea', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ timelen, var4dA)
+ sst_mask = var4dA(:,:,1,1)
+ ELSE IF (vrank == 3) THEN
+ CALL get_2Dfield(debug, nfs, ncids, infconf%invmaskn, 'landsea', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ var3dA)
sst_mask = var3dA(:,:,1)
ELSE
start2d = (/ 1, 1 /)
CALL get_var2D_slice(ncid, lonlen, latlen, start2d, invmaskn, sst_mask)
END IF
! Modifying_FillValue
+ IF (ALLOCATED(new2d1)) DEALLOCATE(new2d1)
+ ALLOCATE(new2d1(lonlen,latlen))
CALL modify2D_fillValue(ncid, invmaskn, metfillvalue, lonlen, latlen, sst_mask, new2d1)
sst_mask = new2d1
varu = variable_units('landsea')
@@ -1583,7 +1715,7 @@ PROGRAM netcdf2wps
READ(landvvals(3), '(F20.10)')landvvalue
landoper = TRIM(landvvals(4))
- ncid = search_var(nfiles, allncids, TRIM(landvname))
+ ncid = search_var(main, nfiles, allncids, TRIM(landvname))
PRINT *, ' Creation of land/sea mask from variable values'
vrank = inq_var_rank(ncid, TRIM(landvname))
IF (vrank == 4) THEN
@@ -1605,7 +1737,7 @@ PROGRAM netcdf2wps
PRINT *,' Using fillvalue as land point'
END IF
- PRINT *," Using '", TRIM(landvname), "' as land point with " // TRIM(landoper) // &
+ PRINT *," Using '", TRIM(landvname), "' as land point with " // TRIM(landoper) // &
' ', landvvalue
IF (TRIM(landoper) == 'eq') THEN
DO i=1,lonlen
@@ -1666,7 +1798,7 @@ PROGRAM netcdf2wps
count4d = (/ lonlen, latlen, 1, 1 /)
PRINT *,'Soil temperature layer 1'
IF (TRIM(infconf%invstl1n) == 'WRFstl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1676,7 +1808,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(tskextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(tskextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'stl1' with extrapolated values from ts labelled '" &
@@ -1707,7 +1839,7 @@ PROGRAM netcdf2wps
count4d = (/ lonlen, latlen, 1, 1 /)
PRINT *,'Soil temperature layer 2'
IF (TRIM(infconf%invstl1n) == 'WRFstl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1717,7 +1849,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(tskextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(tskextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'stl2' with extrapolated values from ts labelled '" &
@@ -1737,7 +1869,7 @@ PROGRAM netcdf2wps
count4d = (/ lonlen, latlen, 1, 1 /)
PRINT *,'Soil temperature layer 3'
IF (TRIM(infconf%invstl1n) == 'WRFstl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1747,7 +1879,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(tskextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(tskextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'stl3' with extrapolated values from ts labelled '" &
@@ -1767,7 +1899,7 @@ PROGRAM netcdf2wps
count4d = (/ lonlen, latlen, 1, 1 /)
PRINT *,'Soil temperature layer 4'
IF (TRIM(infconf%invstl1n) == 'WRFstl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'TSLB', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1777,7 +1909,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(tskextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(tskextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'stl4' with extrapolated values from ts labelled '" &
@@ -1796,7 +1928,7 @@ PROGRAM netcdf2wps
IF (infexec%computeswvl1) THEN
PRINT *,'Volumetric soil water layer 1'
IF (TRIM(infconf%invswvl1n) == 'WRFswvl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1806,7 +1938,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(mrsosextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(mrsosextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'swvl1' with extrapolated values from mrsos " // &
@@ -1834,7 +1966,7 @@ PROGRAM netcdf2wps
IF (infexec%computeswvl2) THEN
PRINT *,'Volumetric soil water layer 2'
IF (TRIM(infconf%invswvl1n) == 'WRFswvl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1844,7 +1976,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(mrsosextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(mrsosextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'swvl2' with extrapolated values from mrsos " // &
@@ -1862,7 +1994,7 @@ PROGRAM netcdf2wps
IF (infexec%computeswvl3) THEN
PRINT *,'Volumetric soil water layer 3'
IF (TRIM(infconf%invswvl1n) == 'WRFswvl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1872,7 +2004,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(mrsosextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(mrsosextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'swvl3' with extrapolated values from mrsos " // &
@@ -1890,7 +2022,7 @@ PROGRAM netcdf2wps
IF (infexec%computeswvl4) THEN
PRINT *,'Volumetric soil water layer 4'
IF (TRIM(infconf%invswvl1n) == 'WRFswvl') THEN
- CALL multisearch_var(debug, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfs, ncids, 'SMOIS', Nfvar, ffilens, fncids)
CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
indate)
inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
@@ -1900,7 +2032,7 @@ PROGRAM netcdf2wps
landproj = Iwithin_csvStr(mrsosextrap, ',', 3)
invnA = TRIM(Swithin_csvStr(mrsosextrap, ',', 2))
IF (landproj == ip) THEN
- CALL multisearch_var(debug, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
+ CALL multisearch_var(debug, main, nfiles, allncids, invnA, Nfvar, ffilens, fncids)
CALL get_equivmultitimes(Nfvar, fncids(1:Nfvar), infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, inc, ncid, indate, debug)
IF (debug) PRINT *," Filling 'swvl4' with extrapolated values from mrsos " // &
@@ -1944,6 +2076,14 @@ PROGRAM netcdf2wps
CALL var3D_qv_tda_pres(lonlen, latlen, 1, tds, ps, qvs)
END IF
END IF
+
+ IF (.NOT.infexec%computepsl .AND. infexec%computeorog .AND. infexec%computeps .AND. &
+ ALLOCATED(qvs)) THEN
+ PRINT *,'Hydrostatic extrapolation of sea-level pressure (psl) using orog, ts, qvs and ps'
+ PRINT *,' psl = ps * exp(g*orog/(Rd*tvs))'
+ var2Db = ts(:,:,1) * (1. + 0.608 * qvs(:,:,1))
+ psl(:,:,1) = ps(:,:,1) * EXP(grav*orog(:,:,1)/(Rd*var2Db))
+ END IF
!!!!!!!!!!!!!!!!!!!!!!!!!! Printing some examples
IF (t == ltpt) THEN
@@ -1961,6 +2101,12 @@ PROGRAM netcdf2wps
mask=mamask1D)
PRINT *, ' mean:', SUM(sst_mask, mask=mamask1D)/(COUNT(mamask1D))
END IF
+ IF (infexec%computeorog) THEN
+ mamask2D = orog /= metfillvalue
+ PRINT *, ' orog =', orog(itpt,jtpt,1)
+ PRINT *, ' min:', MINVAL(orog, mask=mamask2D), ' max:', MAXVAL(orog, mask=mamask2D)
+ PRINT *, ' mean:', SUM(orog, mask=mamask2D)/(COUNT(mamask2D))
+ END IF
IF (infexec%computehurs .OR. ALLOCATED(hurs)) THEN
mamask2D = hurs /= metfillvalue
PRINT *, ' hurs =', hurs(itpt,jtpt,1)
@@ -2021,7 +2167,7 @@ PROGRAM netcdf2wps
PRINT *, ' min:', MINVAL(ps, mask=mamask2D), ' max:', MAXVAL(ps, mask=mamask2D)
PRINT *, ' mean:', SUM(ps, mask=mamask2D)/(COUNT(mamask2D))
END IF
- IF (infexec%computepsl) THEN
+ IF (infexec%computepsl .OR. ALLOCATED(psl)) THEN
mamask2D = psl /= metfillvalue
PRINT *, ' psl =', psl(itpt,jtpt,1)
PRINT *, ' min:', MINVAL(psl, mask=mamask2D), ' max:', MAXVAL(psl, mask=mamask2D)
@@ -2089,6 +2235,7 @@ PROGRAM netcdf2wps
END IF
ELSE
IF (infexec%computemask) PRINT *, 'sst_mask =', sst_mask(itpt,jtpt)
+ IF (infexec%computeorog) PRINT *, 'orog =', orog(itpt,jtpt,1)
IF (infexec%computehurs .OR. ALLOCATED(hurs)) PRINT *, 'hurs =', hurs(itpt,jtpt,1)
IF (infexec%computehuss) PRINT *, 'huss =', huss(itpt,jtpt,1)
IF (infexec%computeqvs .OR. ALLOCATED(qvs)) PRINT *, 'qvs =', qvs(itpt,jtpt,1)
@@ -2099,7 +2246,7 @@ PROGRAM netcdf2wps
IF (infexec%computets) PRINT *, ' ts =', ts(itpt,jtpt,1)
IF (infexec%computesst) PRINT *, 'sst =', sst(itpt,jtpt,1)
IF (infexec%computeps) PRINT *, 'ps =', ps(itpt,jtpt,1)
- IF (infexec%computepsl) PRINT *, 'psl =', psl(itpt,jtpt,1)
+ IF (infexec%computepsl .OR. ALLOCATED(psl)) PRINT *, 'psl =', psl(itpt,jtpt,1)
IF (infexec%computesnd) PRINT *, 'snd =', snd(itpt,jtpt,1)
IF (infexec%computeci) PRINT *, 'ci =', ci(itpt,jtpt,1)
IF (infexec%computestl1) PRINT *, 'stl1 =', stl1(itpt,jtpt,1)
@@ -2121,12 +2268,17 @@ PROGRAM netcdf2wps
! First get the variables without p-level extrapolation
IF (infexec%computeua) THEN
+ PRINT *,'westward wind speed'
IF (TRIM(infconf%inptua) == 'plev') THEN
- PRINT *,'westward wind speed'
CALL get_3Dfield(debug, nfs, ncids, infconf%invuan, 'ua', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, ua_pl)
ELSE IF (TRIM(infconf%inptua) == 'modlev') THEN
- !CONTINUE
+ PRINT *,' from model-levels'
+ IF (ALLOCATED(ua_ml)) DEALLOCATE(ua_ml)
+ ALLOCATE(ua_ml(lonlen,latlen,modlevellen,1))
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invuan, 'ua', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ modlevellen, ua_ml)
ELSE
msg = "Vertical level type for 'ua' as '" // TRIM(infconf%inptua) // "' not ready !!"
CALL stoprunAvail(msg, main, Navailinpt, availinpt)
@@ -2134,25 +2286,85 @@ PROGRAM netcdf2wps
END IF
IF (infexec%computeva) THEN
+ PRINT *,'northward wind speed'
IF (TRIM(infconf%inptva) == 'plev') THEN
- PRINT *,'northward wind speed'
CALL get_3Dfield(debug, nfs, ncids, infconf%invvan, 'va', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, va_pl)
ELSE IF (TRIM(infconf%inptva) == 'modlev') THEN
- !CONTINUE
+ PRINT *,' from model-levels'
+ IF (ALLOCATED(va_ml)) DEALLOCATE(va_ml)
+ ALLOCATE(va_ml(lonlen,latlen,modlevellen,1))
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invvan, 'va', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ modlevellen, va_ml)
ELSE
msg = "Vertical level type for 'va' as '" // TRIM(infconf%inptva) // "' not ready !!"
CALL stoprunAvail(msg, main, Navailinpt, availinpt)
END IF
END IF
+ IF (infexec%computezg) THEN
+ PRINT *,'Geopotential'
+ IF (TRIM(infconf%inptzg) == 'plev') THEN
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'zg', infconf%indtimen(ip), &
+ infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, zg_pl)
+ ELSE IF (TRIM(infconf%inptzg) == 'modlev') THEN
+ PRINT *,' from model-levels'
+ IF (ALLOCATED(zg_ml)) DEALLOCATE(zg_ml)
+ ALLOCATE(zg_ml(lonlen,latlen,modlevellen,1))
+ zg_ml = Rfillvalue
+ IF (TRIM(infconf%invzgn) == 'WRFgeop') THEN
+ PRINT *, ' Computing geopotential from WRF output PH+PHB'
+ CALL multisearch_var(debug, main, nfs, ncids, 'PH', Nfvar, ffilens, fncids)
+ CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, &
+ ncid, indate)
+ IF (ALLOCATED(geop3D)) DEALLOCATE(geop3D)
+ ALLOCATE(geop3D(lonlen,latlen,modlevellen,alldimts(ifile)))
+ CALL compute_WRFgeop(ncid, lonlen, latlen, modlevellen, alldimts(ifile), geop3D)
+ inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
+ zg_ml(:,:,:,1) = geop3D(:,:,:,indate)
+ IF (debug) THEN
+ PRINT *,' zg_ml values min:', MINVAL(zg_ml(:,:,:,1)), ' max:', &
+ MAXVAL(zg_ml(:,:,:,1))
+ END IF
+ ELSE
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'zg', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ modlevellen, zg_ml)
+ END IF
+ ELSE
+ msg = "Vertical level type for 'zg' as '" // TRIM(infconf%inptzg) // "' not ready !!"
+ CALL stoprunAvail(msg, main, Navailinpt, availinpt)
+ END IF
+ END IF
+
IF (infexec%computeta) THEN
+ PRINT *,'temperature'
IF (TRIM(infconf%inptta) == 'plev') THEN
- PRINT *,'temperature'
CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, ta_pl)
ELSE IF (TRIM(infconf%inptta) == 'modlev') THEN
- !CONTINUE
+ PRINT *,' from model-levels'
+ IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
+ ALLOCATE(ta_ml(lonlen,latlen,modlevellen,1))
+ ta_ml = Rfillvalue
+ IF (TRIM(infconf%invtan) == 'WRFta') THEN
+ PRINT *,' computing ta using WRFta'
+ IF (ALLOCATED(var4dA)) DEALLOCATE(var4dA)
+ ALLOCATE(var4dA(lonlen, latlen, modlevellen, alldimts(ifile)))
+ CALL multisearch_var(debug, main, nfs, ncids, 'P', Nfvar, ffilens, fncids)
+ CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, &
+ ncid, indate)
+ CALL compute_WRFta(ncid, lonlen, latlen, modlevellen, alldimts(ifile), var4dA)
+ ta_ml(:,:,:,1) = var4dA(:,:,:,indate)
+ IF (debug) THEN
+ PRINT *,' ta_ml values min:', MINVAL(ta_ml(:,:,:,1)), ' max:', &
+ MAXVAL(ta_ml(:,:,:,1))
+ END IF
+ ELSE
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
+ infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ta_ml)
+ END IF
ELSE
msg = "Vertical level type for 'ta' as '" // TRIM(infconf%inptta) // "' not ready !!"
CALL stoprunAvail(msg, main, Navailinpt, availinpt)
@@ -2162,10 +2374,14 @@ PROGRAM netcdf2wps
IF (infexec%computetda) THEN
IF (TRIM(infconf%inpttda) == 'plev') THEN
PRINT *,'dew-point temperature'
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtdan, 'tda', infconf%indtimen(ip), &
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invtdan, 'tda', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, tda_pl)
ELSE IF (TRIM(infconf%inpttda) == 'modlev') THEN
- !CONTINUE
+ IF (ALLOCATED(tda_ml)) DEALLOCATE(tda_ml)
+ ALLOCATE(tda_ml(lonlen,latlen,modlevellen,1))
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invtdan, 'tda', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ modlevellen, tda_ml)
ELSE
msg = "Vertical level type for 'tda' as '" // TRIM(infconf%inpttda) // "' not ready !!"
CALL stoprunAvail(msg, main, Navailinpt, availinpt)
@@ -2175,10 +2391,14 @@ PROGRAM netcdf2wps
IF (infexec%computehur) THEN
IF (TRIM(infconf%inpthur) == 'plev') THEN
PRINT *,'relative humidity'
- CALL get_3Dfield(debug, nfs, ncids, infconf%invhurn, 'hur', infconf%indtimen(ip), &
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invhurn, 'hur', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, hur_pl)
ELSE IF (TRIM(infconf%inpthur) == 'modlev') THEN
- !CONTINUE
+ IF (ALLOCATED(hur_ml)) DEALLOCATE(hur_ml)
+ ALLOCATE(hur_ml(lonlen,latlen,modlevellen,1))
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invhurn, 'hur', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ modlevellen, hur_ml)
ELSE
msg = "Vertical level type for 'hur' as '" // TRIM(infconf%inpthur) // "' not ready !!"
CALL stoprunAvail(msg, main, Navailinpt, availinpt)
@@ -2188,13 +2408,17 @@ PROGRAM netcdf2wps
IF (infexec%computehus) THEN
IF (TRIM(infconf%inpthus) == 'plev') THEN
PRINT *,'specific humidity'
- CALL get_3Dfield(debug, nfs, ncids, infconf%invhusn, 'hus', infconf%indtimen(ip), &
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invhusn, 'hus', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, hus_pl)
IF (.NOT.infexec%computeqv) THEN
qv_pl = hus_pl / (1. - hus_pl)
END IF
ELSE IF (TRIM(infconf%inpthus) == 'modlev') THEN
- !CONTINUE
+ IF (ALLOCATED(hus_ml)) DEALLOCATE(hus_ml)
+ ALLOCATE(hus_ml(lonlen,latlen,modlevellen,1))
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invhusn, 'hus', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ modlevellen, hus_ml)
ELSE
msg = "Vertical level type for 'hus' as '" // TRIM(infconf%inpthus) // "' not ready !!"
CALL stoprunAvail(msg, main, Navailinpt, availinpt)
@@ -2207,28 +2431,22 @@ PROGRAM netcdf2wps
CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, qv_pl)
ELSE IF (TRIM(infconf%inptqv) == 'modlev') THEN
- !CONTINUE
+ IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
+ ALLOCATE(qv_ml(lonlen,latlen,modlevellen,1))
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', &
+ infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
+ modlevellen, qv_ml)
ELSE
msg = "Vertical level type for 'qv' as '" // TRIM(infconf%inptqv) // "' not ready !!"
CALL stoprunAvail(msg, main, Navailinpt, availinpt)
END IF
END IF
- IF (infexec%computezg) THEN
- IF (TRIM(infconf%inptzg) == 'plev') THEN
- PRINT *,'geopotential'
- CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'zg', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, zg_pl)
- ELSE IF (TRIM(infconf%inptzg) == 'modlev') THEN
- !CONTINUE
- ELSE
- msg = "Vertical level type for 'zg' as '" // TRIM(infconf%inptzg) // "' not ready !!"
- CALL stoprunAvail(msg, main, Navailinpt, availinpt)
- END IF
- END IF
-
+ ! Use of model-level values
+ !! Direct interpolations
! Getting pressure values
IF (infexec%computemodlev) THEN
+ PRINT *,'model-level pressure'
IF (ALLOCATED(p_ml)) DEALLOCATE(p_ml)
ALLOCATE(p_ml(lonlen, latlen, modlevellen, 1))
! Different options
@@ -2237,6 +2455,19 @@ PROGRAM netcdf2wps
ALLOCATE(modpres(lonlen, latlen, modlevellen, 1))
CALL compute_hybridp(lonlen, latlen, modlevellen, infconf%invmodlevn(ip), nfs, ncids, &
infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, p_ml)
+ ELSE IF (infconf%invmodlevn(ip)(1:7) == 'WRFpres') THEN
+ PRINT *, ' Computing pressure from WRF output P+PB'
+ CALL multisearch_var(debug, main, nfs, ncids, 'P', Nfvar, ffilens, fncids)
+ CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile, ncid,&
+ indate)
+ IF (ALLOCATED(var4dA)) DEALLOCATE(var4dA)
+ ALLOCATE(var4dA(lonlen,latlen,modlevellen,alldimts(ifile)))
+ CALL compute_WRFpres(ncid, lonlen, latlen, modlevellen, alldimts(ifile), var4dA)
+ inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
+ p_ml(:,:,:,1) = var4dA(:,:,:,indate)
+ IF (debug) THEN
+ PRINT *,' p_ml values min:', MINVAL(p_ml(:,:,:,1)), ' max:', MAXVAL(p_ml(:,:,:,1))
+ END IF
ELSE
CALL get_3Dfield(debug, nfs, ncids, infconf%invplevn(ip), 'pres', &
infconf%indtimen(ip), infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, &
@@ -2245,21 +2476,45 @@ PROGRAM netcdf2wps
END IF
! p-level Interpolating
+ IF (infexec%computezg) THEN
+ IF (TRIM(infconf%inptzg) == 'modlev' .AND. TRIM(infconf%invzgn) /= 'None') THEN
+ IF (ALL(zg_ml /= Rfillvalue) .AND. ALL(ta_ml /= Rfillvalue) .AND. &
+ ALL(qv_ml /= Rfillvalue)) THEN
+ PRINT *,'Geopotential interpolated from model levels and p-level inputs using ta & qv'
+ CALL pld(lonlen, latlen, modlevellen, z=zg_ml, p=p_ml, t=ta_ml, qv=qv_ml, &
+ extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
+ press_levels=level, ght_pl=zg_pl)
+ IF (debug) THEN
+ PRINT *,' zg_pl values min:', MINVAL(zg_pl(:,:,:,1)), ' max:', &
+ MAXVAL(zg_pl(:,:,:,1))
+ IF (ANY(zg_pl < metfillvalue*0.9) .OR. ANY(ISNAN(zg_pl))) THEN
+ Ival = COUNT(zg_pl < metfillvalue*0.9) + COUNT(ISNAN(zg_pl))
+ DO k=1, levellen
+ PRINT *, ' ', k, ' level pressure:', level(k), ' _______'
+ DO i=1, lonlen
+ PRINT *,(zg_pl(i,j,k,1),j=1,latlen)
+ END DO
+ END DO
+ msg = TRIM(ItoS(Ival)) // " missing values found in p-level interpolated " // &
+ "geopotential field !!"
+ CALL StopRun(msg, main)
+ END IF
+ END IF
+ END IF
+ END IF
+ END IF
+
IF (infexec%computeua) THEN
IF (TRIM(infconf%inptua) == 'modlev') THEN
- PRINT *,'V wind Earth-Rotated interpolated from model levels'
+ PRINT *,'U wind Earth-Rotated interpolated from model levels'
! Model-level variable
- IF (ALLOCATED(ua_ml)) DEALLOCATE(ua_ml)
- ALLOCATE(ua_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invuan, 'ua', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ua_ml)
- CALL pld(lonlen, latlen, modlevellen, u=ua_ml, p=p_ml, extrap_below_grnd=.TRUE., &
+ CALL pld(lonlen, latlen, modlevellen, u=ua_ml,p=p_ml,t=ta_ml, extrap_below_grnd=.TRUE.,&
missing=metfillvalue, num_press_levels=levellen, press_levels=level, u_pl=ua_pl)
! There is p_top?
IF (computeptop) THEN
IF (ALLOCATED(uaptopmod)) DEALLOCATE(uaptopmod)
ALLOCATE(uaptopmod(lonlen, latlen, 1, 1))
- CALL pld(lonlen, latlen, modlevellen, u=ua_ml, p=p_ml, extrap_below_grnd=.TRUE., &
+ CALL pld(lonlen, latlen, modlevellen,u=ua_ml,p=p_ml,t=ta_ml,extrap_below_grnd=.TRUE.,&
missing=metfillvalue, num_press_levels=1, press_levels=(/p_top*1./), u_pl=uaptopmod)
END IF
END IF
@@ -2269,17 +2524,13 @@ PROGRAM netcdf2wps
IF (TRIM(infconf%inptva) == 'modlev') THEN
PRINT *,'V wind Earth-Rotated interpolated from model levels'
! Model-level variable
- IF (ALLOCATED(va_ml)) DEALLOCATE(va_ml)
- ALLOCATE(va_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invvan, 'va', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, va_ml)
- CALL pld(lonlen, latlen, modlevellen, u=va_ml, p=p_ml, extrap_below_grnd=.TRUE., &
+ CALL pld(lonlen, latlen, modlevellen, u=va_ml,p=p_ml,t=ta_ml,extrap_below_grnd=.TRUE., &
missing=metfillvalue, num_press_levels=levellen, press_levels=level, u_pl=va_pl)
! There is p_top?
IF (computeptop) THEN
IF (ALLOCATED(vaptopmod)) DEALLOCATE(vaptopmod)
ALLOCATE(vaptopmod(lonlen, latlen, 1, 1))
- CALL pld(lonlen, latlen, modlevellen, v=va_ml, p=p_ml, extrap_below_grnd=.TRUE., &
+ CALL pld(lonlen, latlen, modlevellen,v=va_ml,p=p_ml,t=ta_ml,extrap_below_grnd=.TRUE.,&
missing=metfillvalue, num_press_levels=1, press_levels=(/p_top*1./), v_pl=vaptopmod)
END IF
END IF
@@ -2288,23 +2539,27 @@ PROGRAM netcdf2wps
! p-level Interpolating by already accesible p-level variables
IF (infexec%computeta) THEN
IF (TRIM(infconf%inptta) == 'modlev') THEN
- ! Model-level variable
- IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
- ALLOCATE(ta_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ta_ml)
+ PRINT *,'T interpolated from model levels'
! To p-level interpolate temperature is required also z_pl
- IF (ALL(zg_pl /= 0.)) THEN
- PRINT *,'Temperature interpolated from model levels and p-level inputs'
- CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, ght_pl=zg_pl, &
+ IF (ALL(zg_ml /= Rfillvalue)) THEN
+ PRINT *,'Temperature interpolated from model levels and model-level inputs'
+ CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, z=zg_ml, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, t_pl=ta_pl)
+ ELSE
+ msg = 'I do not kow how to interpolate ta from model-levels without geopotential. '//&
+ 'Neither I have it at pressure-levels, nor at model-levels'
+ CALL StopRun(msg, main)
+ END IF
+ IF (debug) THEN
+ PRINT *,' ta_pl values min:', MINVAL(ta_pl(:,:,:,1)), ' max:', &
+ MAXVAL(ta_pl(:,:,:,1))
END IF
! There is p_top?
IF (computeptop) THEN
IF (ALLOCATED(taptopmod)) DEALLOCATE(taptopmod)
ALLOCATE(taptopmod(lonlen, latlen, 1, 1))
- CALL pld(lonlen, latlen, modlevellen, p=p_ml, t=ta_ml, extrap_below_grnd=.TRUE., &
+ CALL pld(lonlen, latlen, modlevellen,p=p_ml,t=ta_ml,z=zg_ml,extrap_below_grnd=.TRUE.,&
missing=metfillvalue, num_press_levels=1, press_levels=(/p_top*1./), t_pl=taptopmod)
END IF
ENDIF
@@ -2313,10 +2568,7 @@ PROGRAM netcdf2wps
IF (infexec%computehur) THEN
IF (TRIM(infconf%inpthur) == 'modlev') THEN
! Model-level variable
- IF (ALLOCATED(hur_ml)) DEALLOCATE(hur_ml)
- ALLOCATE(hur_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invhurn, 'hur', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, hur_ml)
+ PRINT *,'Relative humidity from model levels'
! To p-level interpolate relatrive humidity is required also qv, t or t_pl
IF (ALL(ta_pl /= 0.)) THEN
PRINT *,'Relative humidity interpolated from model levels and p-level inputs'
@@ -2333,19 +2585,22 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computezg) THEN
+ IF (infexec%computezg .AND. ALL(zg_pl == 0.)) THEN
IF (TRIM(infconf%inptzg) == 'modlev') THEN
+ PRINT *,'Geopotential at model levels interpolated using, temperature and mixing ratio'
! Model-level variable
- IF (ALLOCATED(zg_ml)) DEALLOCATE(zg_ml)
- ALLOCATE(zg_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'zg', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, zg_ml)
! To p-level extrapolate zg we require t, qv or t_pl, qv_pl
IF (ALL(ta_pl /= 0.) .AND. ALL(qv_pl /= 0.)) THEN
PRINT *,'Geopotential Height interpolated from model levels and p-level inputs'
CALL pld(lonlen, latlen, modlevellen, tda=tda_ml, p=p_ml, t_pl=ta_pl, qv_pl=qv_pl, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, ght_pl=zg_pl)
+ ! To p-level extrapolate zg we require t, qv
+ ELSE IF (ALL(ta_ml /= Rfillvalue) .AND. ALL(qv_ml /= Rfillvalue)) THEN
+ PRINT *,'Geopotential Height interpolated from model levels and mod-level inputs'
+ CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, qv=qv_pl, &
+ extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
+ press_levels=level, ght_pl=zg_pl)
END IF
! There is p_top?
IF (computeptop) THEN
@@ -2357,19 +2612,24 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computeqv) THEN
+ IF (infexec%computeqv .AND. ALL(qv_pl == 0.)) THEN
IF (TRIM(infconf%inptqv) == 'modlev') THEN
+ PRINT *,'Mixing ratio at model levels interpolated using, relative humidity and ' // &
+ 'temperature'
! Model-level variable
- IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
- ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, invqvn, 'qv', indtimen(ip), invtimen(ip), &
- oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, qv_ml)
! To p-level interpolate qv we require hur_pl, ta_pl
- IF (ALL(hur_pl /= 0.) .AND. ALL(ta_pl /= 0.)) THEN
- PRINT *,'Water vapor mixing ratio interpolated from model levels and p-level inputs'
+ IF (ALL(hur_pl /= 0.) .AND. ALL(ta_ml /= Rfillvalue) .AND. ALLOCATED(hur_pl)) THEN
+ PRINT *,'Water vapor mixing ratio interpolated from model levels and p-level ' // &
+ ' inputs using hur_pl and ta_pl'
CALL pld(lonlen, latlen, modlevellen, qv=qv_ml, p=p_ml, rh_pl=hur_pl, t_pl=ta_pl, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, qv_pl=qv_pl)
+ ELSE IF (ALL(hur_pl == 0.) .AND. ALL(ta_ml /= Rfillvalue)) THEN
+ PRINT *,'Water vapor mixing ratio interpolated from model levels and p-level ' // &
+ 'inputs using ta_ml'
+ CALL pld(lonlen, latlen, modlevellen, qv=qv_ml, p=p_ml, t=ta_ml, &
+ extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
+ press_levels=level, qv_pl=qv_pl)
END IF
! There is p_top?
IF (computeptop) THEN
@@ -2381,14 +2641,14 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computehus) THEN
+ IF (infexec%computehus .AND. ALL(hus_pl == 0.)) THEN
IF (TRIM(infconf%inpthus) == 'modlev') THEN
+ PRINT *,'Mixing ratio at model levels interpolated using, specific humidity'
! Model-level variable
- IF (ALLOCATED(hus_ml)) DEALLOCATE(hus_ml)
- ALLOCATE(hus_ml(lonlen, latlen, modlevellen, 1))
IF (.NOT.ALLOCATED(qv_ml)) THEN
IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
+ qv_ml = Rfillvalue
END IF
CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, qv_ml)
@@ -2420,13 +2680,10 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computetda) THEN
+ IF (infexec%computetda .AND. ALL(tda_pl == 0.)) THEN
IF (TRIM(inpttda) == 'modlev') THEN
! Model-level variable
- IF (ALLOCATED(tda_ml)) DEALLOCATE(tda_ml)
- ALLOCATE(tda_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, invtdan, 'tda', indtimen(ip), invtimen(ip), &
- oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, tda_ml)
+ PRINT *,'Dew point temperature at model levels'
! To p-level extrapolate tda we require qv_pl
IF (ALL(qv_pl /= 0.)) THEN
PRINT *,'Dew point temperature interpolated from model levels and p-level inputs'
@@ -2448,51 +2705,69 @@ PROGRAM netcdf2wps
END IF
! Interpolate using inputs at model levels
- IF (infexec%computeta) THEN
+ IF (infexec%computeta .AND. ALL(ta_pl == 0.)) THEN
IF (TRIM(infconf%inptta) == 'modlev') THEN
- ! Model-level variable
- IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
- ALLOCATE(ta_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ta_ml)
+ PRINT *,'Temperature at model levels interpolated using geopotential and mixing ' // &
+ 'ratio'
! To p-level interpolate temperature is required also z_pl or z, t, qv
- IF (TRIM(infconf%inptzg) == 'modlev' .AND. TRIM(infconf%inptta) == 'modlev' .AND. &
- TRIM(infconf%inptqv) == 'modlev') THEN
+ IF (TRIM(infconf%inptzg) == 'modlev' .AND. TRIM(infconf%inptqv) == 'modlev') THEN
PRINT *,'Temperature interpolate from model-level values'
! Model-level variable
- IF (ALLOCATED(zg_ml)) DEALLOCATE(zg_ml)
- ALLOCATE(zg_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'zg', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, zg_ml)
- IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
- ALLOCATE(ta_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'ta', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ta_ml)
- IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
- ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, qv_ml)
- CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, z=zg_ml, qv=qv_ml, &
- extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
- press_levels=level, t_pl=ta_pl)
+ IF (ALLOCATED(zg_ml) .AND. ALL(zg_ml /= Rfillvalue)) THEN
+ ! geopotential at model levels already in system from previous steps
+ IF (.NOT. ALLOCATED(qv_ml)) THEN
+ CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, z=zg_ml, &
+ extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
+ press_levels=level, t_pl=ta_pl)
+ ELSE
+ CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, z=zg_ml, qv=qv_ml, &
+ extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
+ press_levels=level, t_pl=ta_pl)
+ END IF
+ ELSE
+ IF (ALLOCATED(zg_ml)) DEALLOCATE(zg_ml)
+ ALLOCATE(zg_ml(lonlen, latlen, modlevellen, 1))
+ IF (TRIM(infconf%invzgn) == 'WRFgeop') THEN
+ CALL multisearch_var(debug, main, nfs, ncids, 'PH', Nfvar, ffilens, fncids)
+ CALL get_equivmultiWRFtimes(Nfvar, fncids(1:Nfvar), oDs(t,:), maxtimediff, ifile,&
+ ncid, indate)
+ IF (ALLOCATED(geop3D)) DEALLOCATE(geop3D)
+ ALLOCATE(geop3D(lonlen,latlen,modlevellen,alldimts(ifile)))
+ CALL compute_WRFgeop(ncid, lonlen, latlen, modlevellen, alldimts(ifile), geop3D)
+ inc = Index1DArrayI(fncids(1:Nfvar), Nfvar, ncid)
+ zg_ml(:,:,:,1) = geop3D(:,:,:,indate)
+ ELSE
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'zg', infconf%indtimen(ip), &
+ infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, zg_ml)
+ END IF
+ IF (TRIM(infconf%invqvn) /= 'None') THEN
+ ! We have also mixing ratio
+ IF (.NOT.ALLOCATED(qv_ml)) THEN
+ ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
+ CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip),&
+ infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, qv_ml)
+ END IF
+ CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, z=zg_ml, qv=qv_ml, &
+ extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
+ press_levels=level, t_pl=ta_pl)
+ ELSE
+ CALL pld(lonlen, latlen, modlevellen, t=ta_ml, p=p_ml, z=zg_ml, &
+ extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
+ press_levels=level, t_pl=ta_pl)
+ END IF
+ END IF
END IF
END IF
END IF
- IF (infexec%computezg) THEN
+ IF (infexec%computezg .AND. ALL(zg_pl == 0.)) THEN
IF (TRIM(inptzg) == 'modlev') THEN
+ PRINT *,'Geopotential at model levels interpolated using temperature and mixing ' // &
+ 'ratio'
! Model-level variable
- IF (ALLOCATED(zg_ml)) DEALLOCATE(zg_ml)
- ALLOCATE(zg_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invzgn, 'zg', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, zg_ml)
! To p-level interpolate zg we require t, qv or t_pl, qv_pl
IF (TRIM(infconf%inptta) == 'modlev' .AND. TRIM(infconf%inptqv) == 'modlev') THEN
PRINT *,'Geopotential Height interpolate from model-level values'
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, ta_pl)
- CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, levellen, qv_pl)
CALL pld(lonlen, latlen, modlevellen, tda=tda_ml, p=p_ml, t_pl=ta_pl, qv_pl=qv_pl, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, ght_pl=zg_pl)
@@ -2500,24 +2775,14 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computehur) THEN
+ IF (infexec%computehur .AND. ALL(hur_pl == 0.)) THEN
IF (TRIM(infconf%inpthur) == 'modlev') THEN
+ PRINT *,'Relative humidity at model levels interpolated using temperature and ' // &
+ 'mixing ratio'
! Model-level variable
- IF (ALLOCATED(hur_ml)) DEALLOCATE(hur_ml)
- ALLOCATE(hur_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invhurn, 'hur', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, hur_ml)
! To p-level interpolate relatrive humidity is required also qv, t
IF (TRIM(infconf%inptta) == 'modlev' .AND. TRIM(infconf%inptqv) == 'modlev') THEN
PRINT *,'Relative humidity interpolate from model-level values'
- IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
- ALLOCATE(ta_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ta_ml)
- IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
- ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, qv_ml)
CALL pld(lonlen, latlen, modlevellen, p=p_ml, t=ta_ml, qv=qv_ml, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, rh_pl=hur_pl)
@@ -2525,13 +2790,11 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computehus) THEN
+ IF (infexec%computehus .AND. ALL(hus_pl == 0.) ) THEN
IF (TRIM(infconf%inpthus) == 'modlev') THEN
+ PRINT *,'Specific humidity at model levels interpolated using temperature and ' // &
+ 'mixing ratio'
! Model-level variable
- IF (ALLOCATED(hus_ml)) DEALLOCATE(hus_ml)
- ALLOCATE(hus_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invhusn, 'hus', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, hus_ml)
IF (.NOT.infexec%computeqv) THEN
IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
@@ -2541,10 +2804,6 @@ PROGRAM netcdf2wps
! To p-level extrapolate qv we require ta
IF (TRIM(inptta) == 'modlev') THEN
PRINT *,'Sepcific humidity interpolate from model-level variables'
- IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
- ALLOCATE(ta_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ta_ml)
CALL pld(lonlen, latlen, modlevellen, qv=qv_ml, p=p_ml, t=ta_ml, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, qv_pl=qv_pl)
@@ -2553,20 +2812,14 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computeqv) THEN
+ IF (infexec%computeqv .AND. ALL(qv_pl == 0)) THEN
IF (TRIM(infconf%inptqv) == 'modlev') THEN
! Model-level variable
- IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
- ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
+ PRINT *,'Water vapor mixing ratio interpolate from model-level variables'
CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip), &
infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, qv_ml)
! To p-level extrapolate qv we require ta
IF (TRIM(inptta) == 'modlev') THEN
- PRINT *,'Water vapor mixing ratio interpolate from model-level variables'
- IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
- ALLOCATE(ta_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtan, 'ta', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, ta_ml)
CALL pld(lonlen, latlen, modlevellen, qv=qv_ml, p=p_ml, t=ta_ml, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, qv_pl=qv_pl)
@@ -2574,19 +2827,12 @@ PROGRAM netcdf2wps
END IF
END IF
- IF (infexec%computetda) THEN
+ IF (infexec%computetda .AND. ALL(tda_pl == 0.)) THEN
IF (TRIM(infconf%inpttda) == 'modlev') THEN
! Model-level variable
- IF (ALLOCATED(tda_ml)) DEALLOCATE(tda_ml)
- ALLOCATE(tda_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invtdan, 'tda', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, tda_ml)
! Carefull it might happen that we do not have qv!!
IF (infexec%computeqv .AND. TRIM(infconf%inptqv) == 'modlev') THEN
PRINT *,'Dew point temperature interpolate from model-level intput'
- ALLOCATE(qv_ml(lonlen, latlen, modlevellen, 1))
- CALL get_3Dfield(debug, nfs, ncids, infconf%invqvn, 'qv', infconf%indtimen(ip), &
- infconf%invtimen(ip), oDs(t,:), maxtimediff, lonlen, latlen, modlevellen, qv_ml)
CALL pld(lonlen, latlen, modlevellen, tda=tda_ml, p=p_ml, qv=qv_ml, &
extrap_below_grnd=.TRUE., missing=metfillvalue, num_press_levels=levellen, &
press_levels=level, td_pl=tda_pl)
@@ -2642,6 +2888,16 @@ PROGRAM netcdf2wps
END IF
hur_pl = hur_pl*1.
END IF
+ IF (.NOT. infexec%computeqv) THEN
+ IF (infexec%computeta) THEN
+ PRINT *, TRIM(infmsg)
+ PRINT *," retrieving 'qv' from 'p, ta, hur' ..."
+ IF (ALLOCATED(qv_pl)) DEALLOCATE(qv_pl)
+ ALLOCATE(qv_pl(lonlen, latlen, levellen, 1))
+ CALL var_qv_rh(lonlen, latlen, levellen, 1, ta_pl, level, hur_pl/100., qv_pl)
+ infexec%computeqv = .TRUE.
+ END IF
+ END IF
END IF
IF (t == ltpt .AND. TRIM(indplevn(ip)) /= 'None') THEN
@@ -2762,6 +3018,23 @@ PROGRAM netcdf2wps
! This sould be more elegantly/cool/nicely done with a loop ...
!!
+ !Writing Orography
+ IF (infexec%computeorog) THEN
+ PRINT*,' Writting Orography'
+ field='SOILHGT'
+ units='m'
+ desc='Orography above geoide'
+ xlvl=200100.
+ vecr1(:,:)=orog(:,:,1)
+ slab=vecr1(:,:)
+ CALL write_ungrib2DRval(idout, version(ip), hdate, xfcst(ip), map_source(ip), field, &
+ units, desc, xlvl, nx, ny, iproj(ip))
+ CALL write_ungribprojinf(idout, iproj(ip), startloc(ip), startlat, startlon, NLg(ip), &
+ ddy, ddx, centlon(ip), truelat1(ip), truelat2(ip), earth_radius(ip), &
+ is_wind_grid_rel(ip))
+ WRITE (idout) slab
+ END IF
+
!Writing Relative Humidity at 2m
IF (infexec%computehurs .OR. ALLOCATED(hurs)) THEN
PRINT*,' Writting Relative Humidity at 2m'
@@ -2882,7 +3155,7 @@ PROGRAM netcdf2wps
END IF
!Writing a variable Sea Level Pressure
- IF (infexec%computepsl) THEN
+ IF (infexec%computepsl .OR. ALLOCATED(psl)) THEN
PRINT*,' Sea-level Pressure'
field='PMSL'
units='Pa'
@@ -3407,8 +3680,12 @@ PROGRAM netcdf2wps
END IF
END IF
+ ! Getting back to the forced variables
+ IF (TRIM(infconf%invqvn) == 'None' .AND. infexec%computeqv) infexec%computeqv = .FALSE.
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CLOSE(idout)
+
END DO time_steps
DEALLOCATE(slab)
@@ -3439,11 +3716,13 @@ PROGRAM netcdf2wps
IF (ALLOCATED(var3dB)) DEALLOCATE(var3dB)
IF (ALLOCATED(var4dA)) DEALLOCATE(var4dA)
IF (ALLOCATED(var4dB)) DEALLOCATE(var4dB)
+ IF (ALLOCATED(new2d1)) DEALLOCATE(new2d1)
IF (ALLOCATED(new2d)) DEALLOCATE(new2d)
IF (ALLOCATED(new3d)) DEALLOCATE(new3d)
IF (ALLOCATED(new4d)) DEALLOCATE(new4d)
IF (ALLOCATED(new5d)) DEALLOCATE(new5d)
+ IF (ALLOCATED(orog)) DEALLOCATE(orog)
IF (ALLOCATED(sst_mask)) DEALLOCATE(sst_mask)
IF (ALLOCATED(hurs)) DEALLOCATE(hurs)
IF (ALLOCATED(huss)) DEALLOCATE(huss)
@@ -3478,11 +3757,36 @@ PROGRAM netcdf2wps
IF (ALLOCATED(swvl2)) DEALLOCATE(swvl2)
IF (ALLOCATED(swvl3)) DEALLOCATE(swvl3)
IF (ALLOCATED(swvl4)) DEALLOCATE(swvl4)
+ IF (ALLOCATED(ua_ml)) DEALLOCATE(ua_ml)
+ IF (ALLOCATED(va_ml)) DEALLOCATE(va_ml)
+ IF (ALLOCATED(ta_ml)) DEALLOCATE(ta_ml)
+ IF (ALLOCATED(tda_ml)) DEALLOCATE(tda_ml)
+ IF (ALLOCATED(hur_ml)) DEALLOCATE(hur_ml)
+ IF (ALLOCATED(hus_ml)) DEALLOCATE(hus_ml)
+ IF (ALLOCATED(pb_ml)) DEALLOCATE(pb_ml)
+ IF (ALLOCATED(qv_ml)) DEALLOCATE(qv_ml)
+ IF (ALLOCATED(zg_ml)) DEALLOCATE(zg_ml)
+ IF (ALLOCATED(p_ml)) DEALLOCATE(p_ml)
+ IF (ALLOCATED(pb_ml)) DEALLOCATE(pb_ml)
+ IF (ALLOCATED(modpres)) DEALLOCATE(modpres)
+ IF (ALLOCATED(geop3D)) DEALLOCATE(geop3D)
DEALLOCATE(lat, lat2, lon, time)
DEALLOCATE(level, level2)
- IF (ALLOCATED(WRFstl)) DEALLOCATE(WRFstl, stl)
- IF (ALLOCATED(WRFswvl)) DEALLOCATE(WRFswvl, swvl)
+ IF (ALLOCATED(modlevel)) DEALLOCATE(modlevel)
+ IF (ALLOCATED(modlevel2)) DEALLOCATE(modlevel2)
+ IF (ALLOCATED(vecr)) DEALLOCATE(vecr)
+ IF (ALLOCATED(vecr1)) DEALLOCATE(vecr1)
+ IF (ALLOCATED(oDs)) DEALLOCATE(oDs)
+ IF (ALLOCATED(intimemat)) DEALLOCATE(intimemat)
+ IF (ALLOCATED(level2Dh)) DEALLOCATE(level2Dh)
+ IF (ALLOCATED(odates)) DEALLOCATE(odates)
+ IF (ALLOCATED(pfiles)) DEALLOCATE(pfiles)
+
+ IF (ALLOCATED(WRFstl)) DEALLOCATE(WRFstl)
+ IF (ALLOCATED(WRFswvl)) DEALLOCATE(WRFswvl)
+ IF (ALLOCATED(stl)) DEALLOCATE(stl)
+ IF (ALLOCATED(swvl)) DEALLOCATE(swvl)
IF (ALLOCATED(mamask1D)) DEALLOCATE(mamask1D)
IF (ALLOCATED(mamask2D)) DEALLOCATE(mamask2D)
IF (ALLOCATED(mamask3D)) DEALLOCATE(mamask3D)
@@ -3497,6 +3801,7 @@ PROGRAM netcdf2wps
IF (ALLOCATED(hurptopmod)) DEALLOCATE(hurptopmod)
IF (ALLOCATED(husptopmod)) DEALLOCATE(husptopmod)
IF (ALLOCATED(hurptopmod)) DEALLOCATE(hurptopmod)
+ IF (ALLOCATED(tdaptopmod)) DEALLOCATE(tdaptopmod)
IF (ALLOCATED(plptop)) DEALLOCATE(plptop)
IF (ALLOCATED(zgbar)) DEALLOCATE(zgbar)
IF (ALLOCATED(zgreldiffbar)) DEALLOCATE(zgreldiffbar)
@@ -3506,6 +3811,12 @@ PROGRAM netcdf2wps
IF (ALLOCATED(tbar)) DEALLOCATE(tbar)
IF (ALLOCATED(taptop)) DEALLOCATE(taptop)
IF (ALLOCATED(treldiffbar)) DEALLOCATE(treldiffbar)
+ IF (ALLOCATED(lon2D)) DEALLOCATE(lon2D)
+ IF (ALLOCATED(lat2D)) DEALLOCATE(lat2D)
+
+ IF (ALLOCATED(availinpt)) DEALLOCATE(availinpt)
+ IF (ALLOCATED(availlandoper)) DEALLOCATE(availlandoper)
+ IF (ALLOCATED(varinp)) DEALLOCATE(varinp)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
END PROGRAM netcdf2wps
diff --git a/nc2wps/read_FILE.f90 b/nc2wps/read_FILE.f90
index 14503e95e6217ef37d1b0e888c60718c1f3e7135..a976079ee8971b4147ef5cade3e564da8c92d7bf 100644
--- a/nc2wps/read_FILE.f90
+++ b/nc2wps/read_FILE.f90
@@ -39,15 +39,17 @@ PROGRAM read_FILE
INTEGER :: iunit, ioerr, nout
CHARACTER (len=8) :: startloc
INTEGER :: i, j, iv, ichk, Nvars, Nvals
- INTEGER :: Nvariables, Nfullvariables
+ INTEGER :: Nvariables, Nfullvariables, debug
CHARACTER(len=20) :: levS
CHARACTER(len=500) :: main, projname, outfilen, errmsg
CHARACTER(len=30), DIMENSION(1000) :: variables, fullvariables
+ REAL, DIMENSION(:,:), ALLOCATABLE :: vals2
+ REAL :: mvals, mvals2
LOGICAL :: file_exist, tocheck, tofullcheck
LOGICAL, DIMENSION(:,:), ALLOCATABLE :: mask
CHARACTER(len=3) :: iprojS
- NAMELIST /input/ filename, Nvariables, variables, Nfullvariables, fullvariables
+ NAMELIST /input/ filename, Nvariables, variables, Nfullvariables, fullvariables, debug
main = 'read_FILE'
@@ -62,6 +64,10 @@ PROGRAM read_FILE
STOP
END IF
+ ! namelist default values
+ Nfullvariables = 0
+ debug = 0
+
READ(iunit,input)
close(iunit)
@@ -245,17 +251,43 @@ PROGRAM read_FILE
CLOSE(nout)
PRINT *," file with variable data '" // TRIM(outfilen)//"' has been written"
END IF
+ IF (ALLOCATED(mask)) DEALLOCATE(mask)
+ ALLOCATE(mask(fg_data%nx, fg_data%ny))
+ mask = .FALSE.
+
+ mask = ABS(fg_data%slab) <= ABS(metfillvalue*0.9)
+
+ IF (ALLOCATED(vals2)) DEALLOCATE(vals2)
+ ALLOCATE(vals2(fg_data%nx, fg_data%ny))
+ vals2 = 0.
+ DO i=1, fg_data%nx
+ DO j=1, fg_data%ny
+ IF (mask(i,j)) vals2(i,j) = fg_data%slab(i,j)*fg_data%slab(i,j)
+ END DO
+ END DO
+
+ IF (debug > 10) THEN
+ ! Printing variables values
+ DO i=1, fg_data%nx
+ PRINT *,(fg_data%slab(i,j),j=1,fg_data%ny)
+ END DO
- mask = fg_data%slab /= metfillvalue
+ ! Printing mask of variable
+ DO i=1, fg_data%nx
+ PRINT *,(mask(i,j),j=1,fg_data%ny)
+ END DO
+ END IF
! Some statitistics
Nvals = COUNT(mask)
PRINT *, ' num. var', iv, ' '//TRIM(fg_data%field)//' at level ', fg_data%xlvl, 'num. values:', &
Nvals , ' _______'
IF (Nvals /= 0) THEN
+ mvals = SUM(fg_data%slab, mask=mask)
+ mvals2 = SUM(vals2, mask=mask)
PRINT *, ' min:', MINVAL(fg_data%slab, mask=mask), ' max:', MAXVAL(fg_data%slab, mask=mask)
PRINT *, ' mean:', SUM(fg_data%slab, mask=mask)/Nvals, ' stddev:', &
- SQRT(SUM(fg_data%slab, mask=mask)**2/Nvals-(SUM(fg_data%slab, mask=mask)/Nvals)**2)
+ SQRT(mvals2/Nvals-(mvals/Nvals)**2)
ELSE
PRINT *, ' All values masked !!'
END IF
@@ -266,4 +298,6 @@ PROGRAM read_FILE
CLOSE(iunit)
+ IF (ALLOCATED(mask)) DEALLOCATE(mask, vals2)
+
END PROGRAM read_FILE