fix missing -lnetcdff when netcdf built as shared libraries #8
[WPS-merge.git] / util / src / rd_intermediate.F
blobc5e4beda992855ddd4a6b6d5809643ebc2544627
1 PROGRAM rd_intermediate
3    USE module_debug
4    USE misc_definitions_module
5    USE read_met_module
7    IMPLICIT NONE
9    !  Intermediate input and output from same source.
11    INTEGER :: istatus
12    TYPE (met_data)                   :: fg_data
14    CHARACTER ( LEN =132 )            :: flnm
17    !  Get the input file name from the command line.
18    CALL getarg ( 1 , flnm  )
20    IF ( flnm(1:1) == ' ' ) THEN
21       print *,'USAGE: rd_intermediate.exe <filename>'
22       print *,'       where <filename> is the name of an intermediate-format file'
23       STOP
24    END IF
26    CALL set_debug_level(WARN)
28    CALL read_met_init(trim(flnm), .true., '0000-00-00_00', istatus)
30    IF ( istatus == 0 ) THEN
32       CALL  read_next_met_field(fg_data, istatus)
34       DO WHILE (istatus == 0)
36          CALL mprintf(.true.,STDOUT, '================================================')
37          CALL mprintf(.true.,STDOUT, 'FIELD = %s', s1=fg_data%field)
38          CALL mprintf(.true.,STDOUT, 'UNITS = %s DESCRIPTION = %s', s1=fg_data%units, s2=fg_data%desc)
39          CALL mprintf(.true.,STDOUT, 'DATE = %s FCST = %f', s1=fg_data%hdate, f1=fg_data%xfcst)
40          CALL mprintf(.true.,STDOUT, 'SOURCE = %s', s1=fg_data%map_source)
41          CALL mprintf(.true.,STDOUT, 'LEVEL = %f', f1=fg_data%xlvl)
42          CALL mprintf(.true.,STDOUT, 'I,J DIMS = %i, %i', i1=fg_data%nx, i2=fg_data%ny)
44          SELECT CASE ( fg_data%iproj )
45             CASE (PROJ_LATLON)
46                CALL mprintf(.true.,STDOUT, 'IPROJ = %i  PROJECTION = %s', i1=0, s1='LAT LON') 
47                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
48                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
49                CALL mprintf(.true.,STDOUT,'  DLAT, DLON = %f, %f', f1=fg_data%deltalat, f2=fg_data%deltalon)
50                CALL mprintf(.true.,STDOUT,'  EARTH_RADIUS = %f', f1=fg_data%earth_radius)
51             CASE (PROJ_MERC)
52                CALL mprintf(.true.,STDOUT, 'IPROJ = %i  PROJECTION = %s', i1=1, s1='MERCATOR') 
53                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
54                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
55                CALL mprintf(.true.,STDOUT,'  DX, DY = %f, %f', f1=fg_data%dx, f2=fg_data%dy)
56                CALL mprintf(.true.,STDOUT,'  TRUELAT1 = %f', f1=fg_data%truelat1)
57                CALL mprintf(.true.,STDOUT,'  EARTH_RADIUS = %f', f1=fg_data%earth_radius)
58             CASE (PROJ_LC)
59                CALL mprintf(.true.,STDOUT, 'IPROJ = %i   PROJECTION = %s', i1=3, s1='LAMBERT CONFORMAL') 
60                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
61                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
62                CALL mprintf(.true.,STDOUT,'  DX, DY = %f, %f', f1=fg_data%dx, f2=fg_data%dy)
63                CALL mprintf(.true.,STDOUT,'  STAND_LON = %f', f1=fg_data%xlonc)
64                CALL mprintf(.true.,STDOUT,'  TRUELAT1 = %f', f1=fg_data%truelat1)
65                CALL mprintf(.true.,STDOUT,'  TRUELAT2 = %f', f1=fg_data%truelat2)
66                CALL mprintf(.true.,STDOUT,'  EARTH_RADIUS = %f', f1=fg_data%earth_radius)
67             CASE (PROJ_GAUSS)
68                CALL mprintf(.true.,STDOUT, 'IPROJ = %i   PROJECTION = %s', i1=4, s1='GAUSSIAN') 
69                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
70                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
71                CALL mprintf(.true.,STDOUT,'  NLATS, DLON = %f, %f', f1=fg_data%deltalat, f2=fg_data%deltalon)
72                CALL mprintf(.true.,STDOUT,'  EARTH_RADIUS = %f', f1=fg_data%earth_radius)
73             CASE (PROJ_PS)
74                CALL mprintf(.true.,STDOUT, 'IPROJ = %i   PROJECTION = %s', i1=5, s1='POLAR STEREOGRAPHIC') 
75                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
76                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
77                CALL mprintf(.true.,STDOUT,'  DX, DY = %f, %f', f1=fg_data%dx, f2=fg_data%dy)
78                CALL mprintf(.true.,STDOUT,'  STAND_LON = %f', f1=fg_data%xlonc)
79                CALL mprintf(.true.,STDOUT,'  TRUELAT1 = %f', f1=fg_data%truelat1)
80                CALL mprintf(.true.,STDOUT,'  EARTH_RADIUS = %f', f1=fg_data%earth_radius)
81             CASE (PROJ_CASSINI)
82                CALL mprintf(.true.,STDOUT, 'IPROJ = %i   PROJECTION = %s', i1=6, s1='PROJ_CASSINI') 
83                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
84                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
85                CALL mprintf(.true.,STDOUT,'  DX, DY = %f, %f', f1=fg_data%dx, f2=fg_data%dy)
86                CALL mprintf(.true.,STDOUT,'  STAND_LON = %f', f1=fg_data%xlonc)
87                CALL mprintf(.true.,STDOUT,'  POLE_LAT = %f', f1=fg_data%pole_lat)
88                CALL mprintf(.true.,STDOUT,'  POLE_LON = %f', f1=fg_data%pole_lon)
89                CALL mprintf(.true.,STDOUT,'  CENTER_LAT = %f', f1=fg_data%centerlat)
90                CALL mprintf(.true.,STDOUT,'  CENTER_LON = %f', f1=fg_data%centerlon)
91                CALL mprintf(.true.,STDOUT,'  EARTH_RADIUS = %f', f1=fg_data%earth_radius)
92             CASE default
93                CALL mprintf(.true.,ERROR, '  Unknown iproj %i for version %i', i1=fg_data%iproj, i2=fg_data%version)
94          END SELECT
95          CALL mprintf(.true.,STDOUT,'DATA(1,1)=%f',f1=fg_data%slab(1,1))
96          CALL mprintf(.true.,STDOUT,'')
98          IF (ASSOCIATED(fg_data%slab)) DEALLOCATE(fg_data%slab)
100          CALL  read_next_met_field(fg_data, istatus)
102       END DO
104       CALL read_met_close()
106    ELSE
107       print *, 'File = ',TRIM(flnm)
108       print *, 'Problem with input file, I can''t open it'
109       STOP 
110    END IF
112    print *,'SUCCESSFUL COMPLETION OF PROGRAM RD_INTERMEDIATE'
113    STOP
115 END PROGRAM rd_intermediate