!
! This file contains  the original WRF or WRFSI subroutines
! /Functions with minor changes to remove the dependence
! on WRF framework.
!
! These subroutines are releated to WRF external I/O or 
! interpolation procedures.
!
! Author: Yunheng Wang (01/07/2005).
!

SUBROUTINE wrf_debug(level, str)

  IMPLICIT NONE
  CHARACTER*(*), INTENT(IN) :: str
  INTEGER ,      INTENT(IN) :: level

  IF (level > 0) WRITE(0,*) str

  RETURN
END SUBROUTINE wrf_debug


SUBROUTINE wrf_message(str)

  IMPLICIT NONE
  CHARACTER*(*), INTENT(IN) :: str

  WRITE(6,*) 'WRF MESSAGE: ',str

  RETURN
END SUBROUTINE wrf_message


SUBROUTINE wrf_error_fatal( str ),2
  IMPLICIT NONE
  CHARACTER*(*), INTENT(IN) :: str

  WRITE(0,*) '-------------- FATAL CALLED ---------------' 
  WRITE(0,*) str
  WRITE(0,*) '-------------------------------------------'
  
  CALL arpsstop('ARPSSTOP called.',1)

END SUBROUTINE wrf_error_fatal
!
! This subroutine uses an extended intrinsic procedure
! sizeof(A). Some compilers, such as PGF90 may not provide this
! intrinsic function.
!

SUBROUTINE wrf_sizeof_integer( retval )
  IMPLICIT NONE
  INTEGER retval

#ifndef NOSIZEOF
  retval = sizeof(retval)       ! works on IBM XL Fortran IFORT_SIZEOF
                                ! Intel IFORT Fortran
                                ! PGI Fortran compiler
                                ! OSF1 Fortran compiler
#else
  retval = 4                    ! for PGF90 etc. PGF_SIZEOF
#endif

  RETURN
END SUBROUTINE wrf_sizeof_integer


SUBROUTINE wrf_sizeof_real( retval )
  IMPLICIT NONE
  INTEGER, INTENT(OUT) ::  retval
  REAL   :: tmp 

#ifndef NOSIZEOF
  retval = sizeof(tmp)            ! IFORT_SIZEOF
#else
  retval = 4                     ! for PGF90 etc. PGF_SIZEOF
#endif

  RETURN
END SUBROUTINE wrf_sizeof_real
!
!##################################################################
!

FUNCTION projrot_latlon(iproj,trulat1,trulat2,trulon,ctrlat,ctrlon,     &
                        rlat,rlon,istatus)
!
! Adapted from WRFSI
!
  IMPLICIT NONE

  INTEGER, INTENT(IN)  :: iproj
  REAL,    INTENT(IN)  :: trulat1,trulat2,trulon
  REAL,    INTENT(IN)  :: ctrlat,ctrlon
  REAL,    INTENT(IN)  :: rlat,rlon
  INTEGER, INTENT(OUT) :: istatus

  REAL :: projrot_latlon

!------------------------------------------------------------------
!
!  Misc. local variables
!
!------------------------------------------------------------------

  REAL :: angdif

  REAL :: s,n
  REAL :: colat1,colat2
  REAL :: rn

  REAL, PARAMETER :: d2rfactor = 3.1415926/180.

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  IF(ABS(iproj) == 1) THEN ! polar stereographic

    IF(trulat1 == +90.)then
      projrot_latlon = trulon - rlon
    ELSE IF(trulat1 == -90.)then
      projrot_latlon = rlon - trulon
    ELSE  ! abs(trulat1) .ne. 90.
      IF(ctrlat ==  trulat1 .AND. ctrlon == trulon) THEN
                                     ! grid centered on proj pole
        rn = COS( (90.-trulat1) * d2rfactor)
        projrot_latlon = rn * angdif(trulon,rlon)

      ELSE IF(.TRUE.) THEN
        write(6,*)' ERROR in projrot_latlon: '
        write(6,*)' This type of local',                         &
                  ' stereographic projection not yet supported.'
        write(6,*)' Grid should be centered on projection pole.'

        projrot_latlon = 0.

      ELSE ! .false.
        ! Find dx/lat and dy/lat, then determine projrot_laps

      END IF

    END IF ! trulat1

  ELSE IF(ABS(iproj) == 2) THEN ! lambert conformal

    IF(trulat1 >= 0.0) THEN
      s = +1.
    ELSE
      s = -1.
    END IF

    colat1 = 90. - s * trulat1
    colat2 = 90. - s * trulat2

    IF(trulat1 == trulat2) THEN  ! tangent lambert
      n      = COS( d2rfactor * colat1 )
    ELSE                     ! two standard latitudes
      n = ALOG(COS(d2rfactor * trulat1) / COS( d2rfactor*trulat2) )/     &
          ALOG(TAN(d2rfactor * (45.-s*trulat1/2.) ) /                    &
               TAN(d2rfactor * (45.-s*trulat2/2.) ) )
    END IF

    projrot_latlon = n * s * angdif(trulon,rlon)

  ELSE IF(ABS(iproj) == 3) THEN ! mercator
    projrot_latlon = 0.

  ELSE
    WRITE(6,*) 'projrot_latlon: unrecognized projection ',iproj
    STOP
  END IF

  istatus = 1
  RETURN
END FUNCTION projrot_latlon
!
!##################################################################
!

FUNCTION angdif(x,y)
!
! Difference between two angles, result is between -180. and +180.
!
  IMPLICIT NONE

  REAL, INTENT(IN) :: x,y
  REAL             :: angdif

  angdif = MOD(X-Y+540.,360.)-180.

  RETURN
END FUNCTION angdif
!
!##################################################################
!

SUBROUTINE const_module_initialize (p00,t00,a) 2,1

!-----------------------------------------------------------------
!
! PURPOSE:
!
!   Initialize p00,t00 & a from ARPS2WRF namelist input.
!
!----------------------------------------------------------------

  USE wrf_metadata

  IMPLICIT NONE

  REAL, INTENT(OUT)  :: p00
  REAL, INTENT(OUT)  :: t00
  REAL, INTENT(OUT)  :: a

  p00 = base_pres
  t00 = base_temp
  a   = base_lapse

!  p00 = 100000.   ! constant sea level pressure, Pa
!  t00 = 290.      ! constant sea level temperature, K
!  a   = 50.       ! temperature difference from 1000mb to 300mb, K
END SUBROUTINE