program get_dim_x1d
! **********************************************************************
! *              .      .    .
! * SUBROUTINE: GET_DIM_X1D
! *
! * PRGMMR:     M. ZUPANSKI, D. ZUPANSKI     ORG: CIRA/CSU   DATE: 2003-08-14
! *
! * ABSTRACT:   THIS SUBROUTINE GETS DIMENSION OF CONTROL VARIABLE X1D
! *
! * PROGRAM LOG:
! *
! * 08/14/2003    ..... M. ZUPANSKI, D. ZUPANSKI
! *
! **********************************************************************
      
      INCLUDE 'define_var_list_type.h'
      INCLUDE 'define_cvar_type.h'

      TYPE (var_list_type), dimension(:), allocatable :: cvar_list
      TYPE (cvar_type), dimension(:), allocatable :: cvar

      real, dimension(:), allocatable :: x
      real, dimension(:), allocatable :: cvar1d
      real, dimension(:,:), allocatable :: cvar2d
      real, dimension(:,:,:), allocatable :: cvar3d
      real, dimension(:,:,:,:), allocatable :: cvar4d
      real                                  :: cvarparm
      integer, dimension(1) :: NNXP,NNYP,NNZP,NNSOIL,NNSNOW
      integer, dimension(:), allocatable :: unitbias
      integer               :: cvar_max
      integer               :: ubias,unitbfile,nbias,num_bias
      character*20          :: filename
      character*20          :: file_ic,file_param,file_bias
      character*9           :: cv_name
!------------------------------
      NAMELIST /MODEL_DIMENSION/ NNXP,NNYP,NNZP,NNSOIL,NNSNOW
!------------------------------

     write(*,*) " start get_dim_x1d"

!--- get model dimensions
      write(filename,200)
 200  format('model_dimension.name')
      CLOSE(500)
      OPEN(UNIT=500,FILE=filename,FORM='FORMATTED',IOSTAT=IER)
      IF(IER.NE.0) WRITE(3,*)' 500 OPEN UNIT ERROR IER=',IER
      READ(500,MODEL_DIMENSION)
      CLOSE(500,STATUS='KEEP')
      write(*,*) "NNXP=",NNXP(1)," NNYP=",NNYP(1)," NNZP=",NNZP(1)

!--- control variable
      INCLUDE 'cntrl_vrbl_list.h' 

      write(*,*) "max_num_of_cntrl_vrbls=",max_num_of_cntrl_vrbls

      CLOSE(103)
      OPEN(103,FILE='cntrl_vrbl',FORM='FORMATTED',IOSTAT=IER)
      IF(IER.NE.0)WRITE(*,*)' 103 OPEN UNIT ERROR IER=',IER
      READ(103,*) cvar_max
      allocate(cvar(1:cvar_max))
       do i=1,cvar_max
      READ(103,*) cvar(i)
      write(*,*) cvar(i)
!     READ(103,*) cvar(i)%name,cvar(i)%ic,cvar(i)%param,cvar(i)%bias,cvar(i)%num_bias
!     write(*,*) cvar(i)%name,cvar(i)%ic,cvar(i)%param,cvar(i)%bias,cvar(i)%num_bias
       end do
      CLOSE(103,STATUS='KEEP')

        idim=0
        nvar=0
       do i=1,cvar_max
       write(*,*) "do i=",i
        do j=1,max_num_of_cntrl_vrbls
        write(*,*) "do j=",j
        if(cvar(i)%name.eq.cvar_list(j)%name) then
        nvar=nvar+1

         idim_h =(cvar_list(j)%end_index(1)-cvar_list(j)%start_index(1)+1) &
                *(cvar_list(j)%end_index(2)-cvar_list(j)%start_index(2)+1) &
                *(cvar_list(j)%end_index(3)-cvar_list(j)%start_index(3)+1) &
                *(cvar_list(j)%end_index(4)-cvar_list(j)%start_index(4)+1)
         
         if(cvar(i)%ic) then
          idim_ic=idim_h
           else
            idim_ic=0
             end if
         if(cvar(i)%param) then
          idim_param=idim_h
           else
            idim_param=0
             end if
         if(cvar(i)%bias) then
          idim_bias=idim_h*cvar(i)%num_bias
           else
            idim_bias=0
             end if
         idim=idim+idim_ic+idim_param+idim_bias
        write(*,*) cvar(i)%name
        exit
        end if
        end do
       end do
       if(nvar.ne.cvar_max) then
       write(*,*) "PROBLEM: NOT ALL VARIABLES FOUND !!!"
       end if

        write(*,*) "total dimensions=",idim

!========== write idim on file x1d_cntrl ==============
      rewind 50
      WRITE(50) idim

      write(*,*) " end get_dim_x1d"
      end program get_dim_x1d