WPS/util/src/rd_intermediate.F90

   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          CALL mprintf(.true.,STDOUT, 'IPROJ = %i', i1=fg_data%iproj)
  44
  45          SELECT CASE ( fg_data%iproj )
  46             CASE (PROJ_LATLON)
  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             CASE (PROJ_MERC)
  51                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
  52                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
  53                CALL mprintf(.true.,STDOUT,'  DX, DY = %f, %f', f1=fg_data%dx, f2=fg_data%dy)
  54                CALL mprintf(.true.,STDOUT,'  TRUELAT1 = %f', f1=fg_data%truelat1)
  55             CASE (PROJ_LC)
  56                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
  57                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
  58                CALL mprintf(.true.,STDOUT,'  DX, DY = %f, %f', f1=fg_data%dx, f2=fg_data%dy)
  59                CALL mprintf(.true.,STDOUT,'  STAND_LON = %f', f1=fg_data%xlonc)
  60                CALL mprintf(.true.,STDOUT,'  TRUELAT1 = %f', f1=fg_data%truelat1)
  61                CALL mprintf(.true.,STDOUT,'  TRUELAT2 = %f', f1=fg_data%truelat2)
  62             CASE (PROJ_GAUSS)
  63                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
  64                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
  65                CALL mprintf(.true.,STDOUT,'  NLATS, DLON = %f, %f', f1=fg_data%dy, f2=fg_data%deltalon)
  66             CASE (PROJ_PS)
  67                CALL mprintf(.true.,STDOUT,'  REF_X, REF_Y = %f, %f', f1=fg_data%starti, f2=fg_data%startj)
  68                CALL mprintf(.true.,STDOUT,'  REF_LAT, REF_LON = %f, %f', f1=fg_data%startlat, f2=fg_data%startlon)
  69                CALL mprintf(.true.,STDOUT,'  DX, DY = %f, %f', f1=fg_data%dx, f2=fg_data%dy)
  70                CALL mprintf(.true.,STDOUT,'  STAND_LON = %f', f1=fg_data%xlonc)
  71                CALL mprintf(.true.,STDOUT,'  TRUELAT1 = %f', f1=fg_data%truelat1)
  72             CASE default
  73                CALL mprintf(.true.,ERROR, '  Unknown iproj %i for version %i', i1=fg_data%iproj, i2=fg_data%version)
  74          END SELECT
  75          CALL mprintf(.true.,STDOUT,'DATA(1,1)=%f',f1=fg_data%slab(1,1))
  76          CALL mprintf(.true.,STDOUT,'')
  77
  78          IF (ASSOCIATED(fg_data%slab)) DEALLOCATE(fg_data%slab)
  79
  80          CALL  read_next_met_field(fg_data, istatus)
  81
  82       END DO
  83
  84       CALL read_met_close()
  85
  86    ELSE
  87       print *, 'File = ',TRIM(flnm)
  88       print *, 'Problem with input file, I can''t open it'
  89       STOP
  90    END IF
  91
  92    print *,'SUCCESSFUL COMPLETION OF PROGRAM RD_INTERMEDIATE'
  93    STOP
  94
  95 END PROGRAM rd_intermediate