vol7d_var_class.F90

! Copyright (C) 2010  ARPA-SIM <urpsim@smr.arpa.emr.it>
! authors:
! Davide Cesari <dcesari@arpa.emr.it>
! Paolo Patruno <ppatruno@arpa.emr.it>

! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License as
! published by the Free Software Foundation; either version 2 of 
! the License, or (at your option) any later version.

! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.

! You should have received a copy of the GNU General Public License
! along with this program.  If not, see <http://www.gnu.org/licenses/>.
#include "config.h"

MODULE vol7d_var_class
USE kinds
USE missing_values
USE file_utilities
IMPLICIT NONE

TYPE vol7d_var
  CHARACTER(len=10) :: btable=cmiss 
  CHARACTER(len=65) :: description=cmiss 
  CHARACTER(len=24) :: unit=cmiss 
  INTEGER :: scalefactor=imiss 

  INTEGER :: r=imiss 
  INTEGER :: d=imiss 
  INTEGER :: i=imiss 
  INTEGER :: b=imiss 
  INTEGER :: c=imiss 
  INTEGER :: gribhint(4)=imiss 
  INTEGER :: feat_ind=imiss 
END TYPE  vol7d_var

TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
 (/imiss,imiss,imiss,imiss/))

INTERFACE init
  MODULE PROCEDURE vol7d_var_init
END INTERFACE

INTERFACE delete
  MODULE PROCEDURE vol7d_var_delete
END INTERFACE

INTERFACE OPERATOR (==)
  MODULE PROCEDURE vol7d_var_eq
END INTERFACE

INTERFACE OPERATOR (/=)
  MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
END INTERFACE

INTERFACE c_e
  MODULE PROCEDURE vol7d_var_c_e
END INTERFACE

#define VOL7D_POLY_TYPE TYPE(vol7d_var)
#define VOL7D_POLY_TYPES _var
#include "array_utilities_pre.F90"

INTERFACE display
  MODULE PROCEDURE display_var, display_var_vect
END INTERFACE


TYPE vol7d_var_features
  TYPE(vol7d_var) :: var
  REAL :: posdef
  INTEGER :: vartype
END TYPE vol7d_var_features

TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)

! constants for vol7d_vartype
INTEGER,PARAMETER :: var_ord=0
INTEGER,PARAMETER :: var_dir360=1
INTEGER,PARAMETER :: var_press=2
INTEGER,PARAMETER :: var_ucomp=3
INTEGER,PARAMETER :: var_vcomp=4
INTEGER,PARAMETER :: var_wcomp=5

PRIVATE vol7d_var_features_init

CONTAINS

elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
TYPE(vol7d_var),INTENT(INOUT) :: this
CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
CHARACTER(len=*),INTENT(in),OPTIONAL :: description
CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
INTEGER,INTENT(in),OPTIONAL :: scalefactor

IF (PRESENT(btable)) THEN
  this%btable = btable
ELSE
  this%btable = cmiss
  this%description = cmiss
  this%unit = cmiss
  this%scalefactor = imiss
  RETURN
ENDIF
IF (PRESENT(description)) THEN
  this%description = description
ELSE
  this%description = cmiss
ENDIF
IF (PRESENT(unit)) THEN
  this%unit = unit
ELSE
  this%unit = cmiss
ENDIF
if (present(scalefactor)) then
  this%scalefactor = scalefactor
else
  this%scalefactor = imiss
endif

this%r = -1
this%d = -1
this%i = -1
this%b = -1
this%c = -1

END SUBROUTINE vol7d_var_init


ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
CHARACTER(len=*),INTENT(in),OPTIONAL :: description
CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
INTEGER,INTENT(in),OPTIONAL :: scalefactor

TYPE(vol7d_var) :: this

CALL init(this, btable, description, unit, scalefactor)

END FUNCTION vol7d_var_new


elemental SUBROUTINE vol7d_var_delete(this)
TYPE(vol7d_var),INTENT(INOUT) :: this

this%btable = cmiss
this%description = cmiss
this%unit = cmiss
this%scalefactor = imiss

END SUBROUTINE vol7d_var_delete


ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
TYPE(vol7d_var),INTENT(IN) :: this, that
LOGICAL :: res

res = this%btable == that%btable

END FUNCTION vol7d_var_eq


ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
TYPE(vol7d_var),INTENT(IN) :: this, that
LOGICAL :: res

res = .NOT.(this == that)

END FUNCTION vol7d_var_ne


FUNCTION vol7d_var_nesv(this, that) RESULT(res)
TYPE(vol7d_var),INTENT(IN) :: this, that(:)
LOGICAL :: res(SIZE(that))

INTEGER :: i

DO i = 1, SIZE(that)
  res(i) = .NOT.(this == that(i))
ENDDO

END FUNCTION vol7d_var_nesv



subroutine display_var(this)

TYPE(vol7d_var),INTENT(in) :: this

print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
 " scale factor",this%scalefactor

end subroutine display_var


subroutine display_var_vect(this)

TYPE(vol7d_var),INTENT(in) :: this(:)
integer :: i

do i=1,size(this)
  call display_var(this(i))
end do

end subroutine display_var_vect

FUNCTION vol7d_var_c_e(this) RESULT(c_e)
TYPE(vol7d_var),INTENT(IN) :: this
LOGICAL :: c_e
c_e = this /= vol7d_var_miss
END FUNCTION vol7d_var_c_e


SUBROUTINE vol7d_var_features_set(this)
TYPE(vol7d_var),INTENT(inout) :: this
INTEGER :: i

CALL vol7d_var_features_init()

IF (ALLOCATED(var_features)) THEN
  DO i = 1, SIZE(var_features)
    IF (this == var_features(i)%var) THEN
      this%feat_ind = i
      EXIT
    ENDIF
  ENDDO
ENDIF

END SUBROUTINE vol7d_var_features_set


SUBROUTINE vol7d_var_features_init()
INTEGER :: un, i, n
TYPE(csv_record) :: csv
CHARACTER(len=1024) :: line

IF (ALLOCATED(var_features)) RETURN

un = open_package_file('varbufr.csv', filetype_data)
n=0
DO WHILE(.true.)
  READ(un,*,end=100)
  n = n + 1
ENDDO

100 CONTINUE

rewind(un)
ALLOCATE(var_features(n))

DO i = 1, n
  READ(un,'(A)',end=200)line
  CALL init(csv, line)
  CALL csv_record_getfield(csv, var_features(i)%var%btable)
  CALL csv_record_getfield(csv)
  CALL csv_record_getfield(csv)
  CALL csv_record_getfield(csv, var_features(i)%posdef)
  CALL csv_record_getfield(csv, var_features(i)%vartype)
  CALL delete(csv)
ENDDO

200 CONTINUE
CLOSE(un)

END SUBROUTINE vol7d_var_features_init


SUBROUTINE vol7d_var_features_delete()
IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
END SUBROUTINE vol7d_var_features_delete


ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
TYPE(vol7d_var),INTENT(in) :: this
INTEGER :: vartype

IF (c_e(this%feat_ind)) THEN
  vartype = var_features(this%feat_ind)%vartype
ELSE
  vartype = imiss
ENDIF

END FUNCTION vol7d_var_features_vartype


ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
TYPE(vol7d_var),INTENT(in) :: this
REAL,INTENT(inout) :: val

IF (c_e(this%feat_ind)) THEN
  IF (c_e(var_features(this%feat_ind)%posdef)) THEN
    IF (c_e(val)) THEN
      val = max(var_features(this%feat_ind)%posdef, val)
    ENDIF
  ENDIF
ENDIF

END SUBROUTINE vol7d_var_features_posdef_apply


ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
TYPE(vol7d_var),INTENT(in) :: this

INTEGER :: vartype

vartype = var_ord
SELECT CASE(this%btable)
CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
  vartype = var_dir360
CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
  vartype = var_press
CASE('B11003', 'B11200') ! u-component
  vartype = var_ucomp
CASE('B11004', 'B11201') ! v-component
  vartype = var_vcomp
CASE('B11005', 'B11006') ! w-component
  vartype = var_wcomp
END SELECT

END FUNCTION vol7d_vartype


#include "array_utilities_inc.F90"


END MODULE vol7d_var_class