util/src/rd_intermediate.F

   1 PROGRAM rd_intermediate
   2
   3    USE module_debug
   4    USE misc_definitions_module
   5    USE read_met_module
   6
   7    IMPLICIT NONE
   8
   9    !  Intermediate input and output from same source.
  10
  11    INTEGER :: istatus
  12    TYPE (met_data)                   :: fg_data
  13
  14    CHARACTER ( LEN =132 )            :: flnm
  15
  16
  17    !  Get the input file name from the command line.
  18    CALL getarg ( 1 , flnm  )
  19
  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
  25
  26    CALL set_debug_level(WARN)
  27
  28    CALL read_met_init(trim(flnm), .true., '0000-00-00_00', istatus)
  29
  30    IF ( istatus == 0 ) THEN
  31
  32       CALL  read_next_met_field(fg_data, istatus)
  33
  34       DO WHILE (istatus == 0)
  35
  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)
  43
  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,'')
  97
  98          IF (ASSOCIATED(fg_data%slab)) DEALLOCATE(fg_data%slab)
  99
 100          CALL  read_next_met_field(fg_data, istatus)
 101
 102       END DO
 103
 104       CALL read_met_close()
 105
 106    ELSE
 107       print *, 'File = ',TRIM(flnm)
 108       print *, 'Problem with input file, I can''t open it'
 109       STOP
 110    END IF
 111
 112    print *,'SUCCESSFUL COMPLETION OF PROGRAM RD_INTERMEDIATE'
 113    STOP
 114
 115 END PROGRAM rd_intermediate