text:
C=======================================================================
C  WARNING, Subroutine, C.H.PORTER
C  Writes warning messages to Warning.OUT file
C-----------------------------------------------------------------------
C  REVISION HISTORY
C  03/21/2002 CHP Written
C  09/03/2004 CHP Modified call to GETPUT_CONTROL
C  03/22/2005 CHP Added option to suppress Warning.OUT messages with
C                 IDETL = 0 (zero).
!  05/04/2005 CHP Added date to warning message.
!  01/11/2007 CHP Changed GETPUT calls to GET and PUT
C=======================================================================

      SUBROUTINE WARNING (ICOUNT, ERRKEY, MESSAGE)

!     FILEIO and RUN needed to generate header for WARNING.OUT file

      USE ModuleDefs
      USE ModuleData
      USE HeaderMod
      IMPLICIT NONE
      SAVE

      CHARACTER*(*) ERRKEY
      CHARACTER*11, PARAMETER :: WarnOut = 'WARNING.OUT'
      CHARACTER*30  FILEIO
      CHARACTER*(*)  MESSAGE(*)

      INTEGER ICOUNT, DOY, I, LUN, OLDRUN, RUN, YEAR, YRDOY, ErrCode
      LOGICAL FIRST, FEXIST, FOPEN

      TYPE (ControlType) CONTROL
      TYPE (SwitchType)  ISWITCH

      DATA FIRST /.TRUE./
      DATA OLDRUN /0/

!-----------------------------------------------------------------------
!     Suppress Warning.OUT if IDETL = '0' (zero)
      CALL GET(ISWITCH)
!     IF (ISWITCH % IDETL == '0') RETURN

      CALL GET(CONTROL)
      FILEIO = CONTROL % FILEIO
      RUN    = CONTROL % RUN
      YRDOY  = CONTROL % YRDOY
      ErrCode = CONTROL % ErrCode

      IF (INDEX(ERRKEY,'ENDRUN') <= 0) THEN
!       First time routine is called to print, open file.
!       File will remain open until program execution is stopped.
        IF (FIRST) THEN

!         Check for IDETL = '0' (zero) --> suppress output
          CALL GET(ISWITCH)
          IF (ISWITCH % IDETL == '0' .AND. ErrCode <=0) RETURN

          CALL GETLUN(WarnOut, LUN)
          INQUIRE (FILE = WarnOut, EXIST = FEXIST)
          IF (FEXIST) THEN
            INQUIRE (FILE = WarnOut, OPENED = FOPEN)
            IF (.NOT. FOPEN) THEN
              OPEN (UNIT=LUN, FILE=WarnOut, STATUS='OLD',
     &            POSITION='APPEND')
            ENDIF
          ELSE
            OPEN (UNIT=LUN, FILE=WarnOut, STATUS='NEW')
            WRITE(LUN,'("*WARNING DETAIL FILE")')
          ENDIF

          WRITE(LUN,'(/,78("*"))')
          IF (CONTROL % MULTI > 1) CALL MULTIRUN(RUN,0)
          IF (Headers % RUN == RUN) THEN
            CALL HEADER(SEASINIT, LUN, RUN)
            FIRST = .FALSE.
            OLDRUN = RUN
          ENDIF
        ENDIF
!         VSH
          CALL GETLUN('OUTWARN', LUN)
          INQUIRE (FILE = WarnOut, OPENED = FOPEN)
          IF (.NOT. FOPEN) THEN
             OPEN (UNIT=LUN, FILE=WarnOut, STATUS='OLD',
     &             POSITION='APPEND')
          ENDIF
      ENDIF

      IF (ICOUNT > 0) THEN
        !Print header if this is a new run.
        IF (OLDRUN .NE. RUN .AND. RUN .NE. 0 .AND. FILEIO .NE. "")THEN
          IF (Headers % RUN == RUN) THEN
            CALL HEADER(SEASINIT,LUN,RUN)
            OLDRUN = RUN
          ENDIF
        ENDIF

!       Print the warning.  Message is sent from calling routine as text.
        CALL YR_DOY(YRDOY, YEAR, DOY)
        WRITE(LUN,'(/,1X,A,"  YEAR DOY = ",I4,1X,I3)')ERRKEY,YEAR,DOY
        DO I = 1, ICOUNT
          WRITE(LUN,'(1X,A78)') MESSAGE(I)
        ENDDO
      ENDIF

      IF (INDEX(ERRKEY,'ENDRUN') > 0) THEN    !ERRKEY = 'ENDRUN' -> End of season
        FIRST = .TRUE.
        CLOSE(LUN)
      ENDIF

!-----------------------------------------------------------------------
      RETURN
      END SUBROUTINE WARNING

ext: for

max_stars_repo_name: vstocca/dssat-csm-os

max_issues_repo_name: vstocca/dssat-csm-os

max_forks_repo_name: vstocca/dssat-csm-os


text:
c............................................................corehff
      SUBROUTINE corehff(mrad,kap1,kap2,xmj,s,nsol,bhf,gck,fck,
     +                   rc,dx,jtop)
C   ********************************************************************
C   *                                                                  *
C   *   CALCULATE THE RELATIVISTIC HYPERFINE FIELDS FOR THE            *
C   *                  CURRENT  CORE STATE S                           *
C   *                                                                  *
C   *   THE WAVE FUNCTION  {G(K,S),F(K,S)}  IS NORMALIZED TO 1         *
C   *                                                                  *
C   ********************************************************************

      IMPLICIT NONE
C CONVERSION FACTOR FOR HYPERFINE FIELDS FROM A.U. TO GAUSS
C                                      ELECTRON CHARGE     IN ESU
C                                      BOHR-RADIUS         IN CM
c
c
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C   ANGULAR HYPERFINE MATRIX ELEMENTS   SEE E.G.  E.M.ROSE
C        THE FACTOR  I  HAS BEEN OMITTED
C
C     .. Parameters ..
      REAL e0
      PARAMETER (e0=1.6021892e-19*2.997930e+09)
      REAL a0
      PARAMETER (a0=0.52917706e-08)
      REAL cautog
      PARAMETER (cautog=e0/ (a0*a0))
C     ..
C     .. Scalar Arguments ..
      INTEGER, INTENT (IN) :: mrad
      REAL bhf,dx,xmj
      INTEGER jtop,kap1,kap2,nsol,s
C     ..
C     .. Array Arguments ..
      REAL fck(2,2,mrad),gck(2,2,mrad),rc(mrad)
C     ..
C     .. Local Scalars ..
      INTEGER n
C     ..
C     .. Local Arrays ..
      REAL ame(2,2),rint(mrad)
C     ..
C     .. External Functions ..
      REAL rsimp
      EXTERNAL rsimp
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC real,sqrt
C     ..
      ame(1,1) = 4.0*kap1*xmj/ (4.0*kap1*kap1-1.0)
      IF (nsol.EQ.2) THEN
         ame(2,2) = 4.0*kap2*xmj/ (4.0*kap2*kap2-1.0)
         ame(2,1) = sqrt(0.25- (xmj/real(kap1-kap2))**2)
         ame(1,2) = ame(2,1)
      END IF
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      IF (nsol.EQ.1) THEN
         DO n = 1,jtop
            rint(n) = (gck(1,s,n)*fck(1,s,n)+fck(1,s,n)*gck(1,s,n))*
     +                ame(1,1)
         END DO
      ELSE
         DO n = 1,jtop
            rint(n) = (gck(1,s,n)*fck(1,s,n)+fck(1,s,n)*gck(1,s,n))*
     +                ame(1,1) + (gck(2,s,n)*fck(2,s,n)+
     +                fck(2,s,n)*gck(2,s,n))*ame(2,2) +
     +                (gck(2,s,n)*fck(1,s,n)+fck(2,s,n)*gck(1,s,n))*
     +                ame(2,1) + (gck(1,s,n)*fck(2,s,n)+
     +                fck(1,s,n)*gck(2,s,n))*ame(1,2)
         END DO
      END IF
      bhf = -cautog*rsimp(mrad,rint,rc,jtop,dx)*0.001
c      write(oUnit,'(''hf='',e14.7)') BHF
      RETURN
      END

ext: f

max_stars_repo_name: MRedies/FLEUR

max_issues_repo_name: MRedies/FLEUR

max_forks_repo_name: MRedies/FLEUR


text:
program NwtnFwdDiffForm
! Computes the value of the interpolating
! polynomial using Newton's forward difference formula
! The numbers   x_0, h, x
! and values f(x_0),...f(x_n)
! are read from the first two lines of the file named NwtnFwdInput
implicit none
integer, parameter :: real8   = selected_real_kind(13,300)
real(kind=real8) tol,xx,s,h,x0,P,prod
integer, parameter :: n=2
real(kind=real8), dimension(0:n,0:n)::F
real(kind=real8), dimension(0:n):: x
integer i,j
open(unit=7,file='NwtnFwdInput')
read(7,*) x0,h,xx
read(7,*) (F(i,0),i=0,n)
s=(xx-x0)/h
do i=1,n
  do j=1,i
    F(i,j)=F(i,j-1)-F(i-1,j-1)
  enddo
enddo
prod=1.d0
P=F(0,0)
i=0
write(*,*) i,prod,P
do i=1,n
  prod=prod*(s-dfloat(i-1))/dfloat(i)
  P=P+prod*F(i,i)
  write(*,*) i,prod,P
enddo
write(*,*) 'P(x)=',P
end program NwtnFwdDiffForm

max_stars_repo_name: whisker-rebellion/Fortran

max_issues_repo_name: whisker-rebellion/Fortran

max_forks_repo_name: whisker-rebellion/Fortran


text:
!
! BeCoeff_netCDF_IO
!
! Module containing routines to inquire, read, and write netCDF
! BeCoeff object datafiles.
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 10-Feb-2010
!                       paul.vandelst@noaa.gov
!

MODULE BeCoeff_netCDF_IO

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE Type_Kinds     , ONLY: fp
  USE Message_Handler, ONLY: SUCCESS, FAILURE, INFORMATION, Display_Message
  USE File_Utility   , ONLY: File_Exists
  USE String_Utility , ONLY: StrClean
  USE BeCoeff_Define , ONLY: BeCoeff_type         , &
                             BeCoeff_Associated   , &
                             BeCoeff_Destroy      , &
                             BeCoeff_Create       , &
                             BeCoeff_Inspect      , &
                             BeCoeff_ValidRelease , &
                             BeCoeff_Info         , &
                             BeCoeff_DefineVersion
  USE netcdf
  ! Disable implicit typing
  IMPLICIT NONE

  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Procedures
  PUBLIC :: BeCoeff_netCDF_InquireFile
  PUBLIC :: BeCoeff_netCDF_ReadFile
  PUBLIC :: BeCoeff_netCDF_WriteFile
  PUBLIC :: BeCoeff_netCDF_IOVersion

  ! -----------------
  ! Module parameters
  ! -----------------
  ! Module version
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
  ! Default msg string length
  INTEGER, PARAMETER :: ML = 1024

  ! Global attribute names. Case sensitive
  CHARACTER(*), PARAMETER :: RELEASE_GATTNAME = 'Release'
  CHARACTER(*), PARAMETER :: VERSION_GATTNAME = 'Version'
  CHARACTER(*), PARAMETER :: TITLE_GATTNAME   = 'Title'
  CHARACTER(*), PARAMETER :: HISTORY_GATTNAME = 'History'
  CHARACTER(*), PARAMETER :: COMMENT_GATTNAME = 'Comment'

  ! Dimension names. Case sensitive
  CHARACTER(*), PRIVATE, PARAMETER :: COMPONENT_DIMNAME = 'n_Components'
  CHARACTER(*), PRIVATE, PARAMETER :: LATITUDE_DIMNAME  = 'n_Latitudes'
  CHARACTER(*), PRIVATE, PARAMETER :: LONGITUDE_DIMNAME = 'n_Longitudes'

  ! Variable names. Case sensitive.
  CHARACTER(*), PRIVATE, PARAMETER :: LUT_VARNAME  = 'LUT'

  ! Variable description attribute.
  CHARACTER(*), PRIVATE, PARAMETER :: DESCRIPTION_ATTNAME = 'description'
  CHARACTER(*), PRIVATE, PARAMETER :: LUT_DESCRIPTION  = 'Earth geomagnetic field X,Y,Z component look-up-table'

  ! Variable long name attribute.
  CHARACTER(*), PRIVATE, PARAMETER :: LONGNAME_ATTNAME = 'long_name'
  CHARACTER(*), PRIVATE, PARAMETER :: LUT_LONGNAME  = 'Earth geomagnetic field'

  ! Variable units attribute.
  CHARACTER(*), PRIVATE, PARAMETER :: UNITS_ATTNAME = 'units'
  CHARACTER(*), PRIVATE, PARAMETER :: LUT_UNITS  = 'milliGauss'

  ! Variable _FillValue attribute.
  CHARACTER(*), PRIVATE, PARAMETER :: FILLVALUE_ATTNAME = '_FillValue'
  REAL(fp),     PRIVATE, PARAMETER :: LUT_FILLVALUE = 0.0_fp

  ! Variable netCDF datatypes
  INTEGER, PRIVATE, PARAMETER :: LUT_TYPE = NF90_DOUBLE

CONTAINS

!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       BeCoeff_netCDF_InquireFile
!
! PURPOSE:
!       Function to inquire BeCoeff object netCDF format files.
!
! CALLING SEQUENCE:
!       Error_Status = BeCoeff_netCDF_InquireFile( &
!                        Filename, &
!                        n_Latitudes  = n_Latitudes , &
!                        n_Longitudes = n_Longitudes, &
!                        Release      = Release     , &
!                        Version      = Version     , &
!                        Title        = Title       , &
!                        History      = History     , &
!                        Comment      = Comment       )
!
! INPUTS:
!       Filename:       Character string specifying the name of the
!                       BeCoeff data file to inquire.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OPTIONAL OUTPUTS:
!       n_Latitudes:    Number of regularly-spaced latitudes from 90S to 90N for
!                       which there is geomagnetic field data.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       n_Longitudes:   Number of regularly-spaced longitudes from 0 to 360E for
!                       which there is geomagnetic field data.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Release:        The release number of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Version:        The version number of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Title:          Character string written into the TITLE global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       History:        Character string written into the HISTORY global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Comment:        Character string written into the COMMENT global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error
!                       status. The error codes are defined in the
!                       Message_Handler module.
!                       If == SUCCESS the file inquiry was successful
!                          == FAILURE an error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION BeCoeff_netCDF_InquireFile( &
    Filename    , &  ! Input
    n_Latitudes , &  ! Optional output
    n_Longitudes, &  ! Optional output
    Release     , &  ! Optional output
    Version     , &  ! Optional output
    Title       , &  ! Optional output
    History     , &  ! Optional output
    Comment     ) &  ! Optional output
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: Filename
    INTEGER,      OPTIONAL, INTENT(OUT) :: n_Latitudes
    INTEGER,      OPTIONAL, INTENT(OUT) :: n_Longitudes
    INTEGER,      OPTIONAL, INTENT(OUT) :: Release
    INTEGER,      OPTIONAL, INTENT(OUT) :: Version
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: History
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'BeCoeff_InquireFile(netCDF)'
    ! Function variables
    CHARACTER(ML) :: msg
    LOGICAL :: Close_File
    INTEGER :: NF90_Status
    INTEGER :: FileId
    INTEGER :: DimId
    TYPE(BeCoeff_type) :: BeCoeff

    ! Set up
    err_stat = SUCCESS
    Close_File = .FALSE.

    ! Open the file
    NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error opening '//TRIM(Filename)//' for read access - '// &
            TRIM(NF90_STRERROR( NF90_Status ))
      CALL Inquire_Cleanup(); RETURN
    END IF
    ! ...Close the file if any error from here on
    Close_File = .TRUE.

    ! Get the dimensions
    ! ...n_Latitudes dimension
    NF90_Status = NF90_INQ_DIMID( FileId,LATITUDE_DIMNAME,DimId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error inquiring dimension ID for '//LATITUDE_DIMNAME//' - '// &
            TRIM(NF90_STRERROR( NF90_Status ))
      CALL Inquire_Cleanup(); RETURN
    END IF
    NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=BeCoeff%n_Latitudes )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error reading dimension value for '//LATITUDE_DIMNAME//' - '// &
            TRIM(NF90_STRERROR( NF90_Status ))
      CALL Inquire_Cleanup(); RETURN
    END IF
    ! ...n_Longitudes dimension
    NF90_Status = NF90_INQ_DIMID( FileId,LONGITUDE_DIMNAME,DimId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error inquiring dimension ID for '//LONGITUDE_DIMNAME//' - '// &
            TRIM(NF90_STRERROR( NF90_Status ))
      CALL Inquire_Cleanup(); RETURN
    END IF
    NF90_Status = NF90_INQUIRE_DIMENSION( FileId,DimId,Len=BeCoeff%n_Longitudes )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error reading dimension value for '//LONGITUDE_DIMNAME//' - '// &
            TRIM(NF90_STRERROR( NF90_Status ))
      CALL Inquire_Cleanup(); RETURN
    END IF

    ! Get the global attributes
    err_stat = ReadGAtts( Filename, &
                          FileId  , &
                          Release = BeCoeff%Release, &
                          Version = BeCoeff%Version, &
                          Title   = Title  , &
                          History = History, &
                          Comment = Comment  )
    IF ( err_stat /= SUCCESS ) THEN
      msg = 'Error reading global attributes from '//TRIM(Filename)
      CALL Inquire_Cleanup(); RETURN
    END IF

    ! Close the file
    NF90_Status = NF90_CLOSE( FileId )
    Close_File = .FALSE.
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error closing input file - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Inquire_Cleanup(); RETURN
    END IF

    ! Set the return values
    IF ( PRESENT(n_Latitudes ) ) n_Latitudes  = BeCoeff%n_Latitudes
    IF ( PRESENT(n_Longitudes) ) n_Longitudes = BeCoeff%n_Longitudes
    IF ( PRESENT(Release     ) ) Release      = BeCoeff%Release
    IF ( PRESENT(Version     ) ) Version      = BeCoeff%Version

  CONTAINS

    SUBROUTINE Inquire_CleanUp()
      IF ( Close_File ) THEN
        NF90_Status = NF90_CLOSE( FileId )
        IF ( NF90_Status /= NF90_NOERR ) &
          msg = TRIM(msg)//'; Error closing input file during error cleanup.'
      END IF
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME,msg,err_stat )
    END SUBROUTINE Inquire_CleanUp

  END FUNCTION BeCoeff_netCDF_InquireFile

!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       BeCoeff_netCDF_WriteFile
!
! PURPOSE:
!       Function to write BeCoeff object files in netCDF format.
!
! CALLING SEQUENCE:
!       Error_Status = BeCoeff_netCDF_WriteFile( &
!                        Filename, &
!                        BeCoeff , &
!                        Quiet   = Quiet  , &
!                        Title   = Title  , &
!                        History = History, &
!                        Comment = Comment  )
!
! INPUTS:
!       Filename:       Character string specifying the name of the
!                       BeCoeff data file to write.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       BeCoeff:        Object containing the geomagnetic field data.
!                       UNITS:      N/A
!                       TYPE:       TYPE(BeCoeff_type)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!       Quiet:          Set this logical argument to suppress INFORMATION
!                       messages being printed to stdout
!                       If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
!                          == .TRUE.,  INFORMATION messages are SUPPRESSED.
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Title:          Character string written into the TITLE global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       History:        Character string written into the HISTORY global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
!       Comment:        Character string written into the COMMENT global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the data write was successful
!                          == FAILURE an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION BeCoeff_netCDF_WriteFile( &
    Filename, &  ! Input
    BeCoeff , &  ! Input
    Quiet   , &  ! Optional input
    Title   , &  ! Optional input
    History , &  ! Optional input
    Comment ) &  ! Optional input
  RESULT ( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN) :: Filename
    TYPE(BeCoeff_type),     INTENT(IN) :: BeCoeff
    LOGICAL,      OPTIONAL, INTENT(IN) :: Quiet
    CHARACTER(*), OPTIONAL, INTENT(IN) :: Title
    CHARACTER(*), OPTIONAL, INTENT(IN) :: History
    CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'BeCoeff_WriteFile(netCDF)'
    ! Local variables
    CHARACTER(ML) :: msg
    LOGICAL :: Close_File
    LOGICAL :: Noisy
    INTEGER :: NF90_Status
    INTEGER :: FileId
    INTEGER :: VarId

    ! Set up
    err_stat = SUCCESS
    Close_File = .FALSE.
    ! ...Check structure pointer association status
    IF ( .NOT. BeCoeff_Associated( BeCoeff ) ) THEN
      msg = 'BeCoeff structure is empty. Nothing to do!'
      CALL Write_CleanUp(); RETURN
    END IF
    ! ...Check if release is valid
    IF ( .NOT. BeCoeff_ValidRelease( BeCoeff ) ) THEN
      msg = 'BeCoeff Release check failed.'
      CALL Write_Cleanup(); RETURN
    END IF
    ! ...Check Quiet argument
    Noisy = .TRUE.
    IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet

    ! Create the output file
    err_stat = CreateFile( &
                 Filename                 , &  ! Input
                 BeCoeff%n_Latitudes      , &  ! Input
                 BeCoeff%n_Longitudes     , &  ! Input
                 FileId                   , &  ! Output
                 Version = BeCoeff%Version, &  ! Optional input
                 Title   = Title          , &  ! Optional input
                 History = History        , &  ! Optional input
                 Comment = Comment          )  ! Optional input
    IF ( err_stat /= SUCCESS ) THEN
      msg = 'Error creating output file '//TRIM(Filename)
      CALL Write_Cleanup(); RETURN
    END IF
    ! ...Close the file if any error from here on
    Close_File = .TRUE.

    ! Write the data items
    ! ...LUT variable
    NF90_Status = NF90_INQ_VARID( FileId,LUT_VARNAME,VarId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error inquiring '//TRIM(Filename)//' for '//LUT_VARNAME//&
            ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Write_Cleanup(); RETURN
    END IF
    NF90_Status = NF90_PUT_VAR( FileId,VarID,BeCoeff%LUT )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error writing '//LUT_VARNAME//' to '//TRIM(Filename)//&
            ' - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Write_Cleanup(); RETURN
    END IF

    ! Close the file
    NF90_Status = NF90_CLOSE( FileId )
    Close_File = .FALSE.
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Write_Cleanup(); RETURN
    END IF

    ! Output an info message
    IF ( Noisy ) THEN
      CALL BeCoeff_Info( BeCoeff, msg )
      CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION )
    END IF

  CONTAINS

    SUBROUTINE Write_CleanUp()
      IF ( Close_File ) THEN
        NF90_Status = NF90_CLOSE( FileId )
        IF ( NF90_Status /= NF90_NOERR ) &
          msg = TRIM(msg)//'; Error closing output file during error cleanup - '//&
                TRIM(NF90_STRERROR( NF90_Status ))
      END IF
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME,msg,err_stat )
    END SUBROUTINE Write_CleanUp

  END FUNCTION BeCoeff_netCDF_WriteFile

!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       BeCoeff_netCDF_ReadFile
!
! PURPOSE:
!       Function to read BeCoeff object files in netCDF format.
!
! CALLING SEQUENCE:
!       Error_Status = BeCoeff_netCDF_ReadFile( &
!                        Filename         , &
!                        BeCoeff          , &
!                        Quiet   = Quiet  , &
!                        Title   = Title  , &
!                        History = History, &
!                        Comment = Comment  )
!
! INPUTS:
!       Filename:       Character string specifying the name of the
!                       BeCoeff data file to write.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       BeCoeff:        BeCoeff object containing the geomagnetic field data.
!                       UNITS:      N/A
!                       TYPE:       TYPE(BeCoeff_type)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT)
!
! OPTIONAL INPUTS:
!       Quiet:          Set this logical argument to suppress INFORMATION
!                       messages being printed to stdout
!                       If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
!                          == .TRUE.,  INFORMATION messages are SUPPRESSED.
!                       If not specified, default is .FALSE.
!                       UNITS:      N/A
!                       TYPE:       LOGICAL
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN), OPTIONAL
!
! OPTIONAL OUTPUTS:
!       Title:          Character string written into the TITLE global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       History:        Character string written into the HISTORY global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
!       Comment:        Character string written into the COMMENT global
!                       attribute field of the BeCoeff file.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the data write was successful
!                          == FAILURE an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION BeCoeff_netCDF_ReadFile( &
    Filename, &  ! Input
    BeCoeff , &  ! Output
    Quiet   , &  ! Optional input
    Title   , &  ! Optional output
    History , &  ! Optional output
    Comment ) &  ! Optional output
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: Filename
    TYPE(BeCoeff_type),     INTENT(OUT) :: BeCoeff
    LOGICAL,      OPTIONAL, INTENT(IN)  :: Quiet
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: History
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment
    ! Function result
    INTEGER :: err_stat
    ! Function parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'BeCoeff_ReadFile(netCDF)'
    ! Function variables
    CHARACTER(ML) :: msg
    LOGICAL :: Close_File
    LOGICAL :: Noisy
    INTEGER :: NF90_Status
    INTEGER :: FileId
    INTEGER :: n_Latitudes
    INTEGER :: n_Longitudes
    INTEGER :: VarId

    ! Set up
    err_stat = SUCCESS
    Close_File = .FALSE.
    ! ...Check that the file exists
    IF ( .NOT. File_Exists(Filename) ) THEN
      msg = 'File '//TRIM(Filename)//' not found.'
      CALL Read_Cleanup(); RETURN
    END IF
    ! ...Check Quiet argument
    Noisy = .TRUE.
    IF ( PRESENT(Quiet) ) Noisy = .NOT. Quiet

    ! Inquire the file to get the dimensions
    err_stat = BeCoeff_netCDF_InquireFile( &
                 Filename, &
                 n_Latitudes  = n_Latitudes , &
                 n_Longitudes = n_Longitudes  )
    IF ( err_stat /= SUCCESS ) THEN
      msg = 'Error obtaining BeCoeff dimensions from '//TRIM(Filename)
      CALL Read_Cleanup(); RETURN
    END IF

    ! Allocate the output structure
    CALL BeCoeff_Create( &
           BeCoeff     , &
           n_Latitudes , &
           n_Longitudes  )
    IF ( .NOT. BeCoeff_Associated(BeCoeff) ) THEN
      msg = 'Error allocating output BeCoeff'
      CALL Read_Cleanup(); RETURN
    END IF

    ! Open the file for reading
    NF90_Status = NF90_OPEN( Filename,NF90_NOWRITE,FileId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error opening '//TRIM(Filename)//' for read access - '//&
            TRIM(NF90_STRERROR( NF90_Status ))
      CALL Read_Cleanup(); RETURN
    END IF
    ! ...Close the file if any error from here on
    Close_File = .TRUE.

    ! Read the global attributes
    err_stat = ReadGAtts( Filename, &
                          FileID  , &
                          Release = BeCoeff%Release, &
                          Version = BeCoeff%Version, &
                          Title   = Title          , &
                          History = History        , &
                          Comment = Comment          )
    IF ( err_stat /= SUCCESS ) THEN
      msg = 'Error reading global attribute from '//TRIM(Filename)
      CALL Read_Cleanup(); RETURN
    END IF
    ! ...Check if release is valid
    IF ( .NOT. BeCoeff_ValidRelease( BeCoeff ) ) THEN
      msg = 'BeCoeff Release check failed.'
      CALL Read_Cleanup(); RETURN
    END IF

    ! Read the BeCoeff data
    ! ...LUT variable
    NF90_Status = NF90_INQ_VARID( FileId,LUT_VARNAME,VarId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error inquiring '//TRIM(Filename)//' for '//LUT_VARNAME//&
            ' variable ID - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Read_Cleanup(); RETURN
    END IF
    NF90_Status = NF90_GET_VAR( FileId,VarID,BeCoeff%LUT )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error reading '//LUT_VARNAME//' from '//TRIM(Filename)//&
            ' - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Read_Cleanup(); RETURN
    END IF

    ! Close the file
    NF90_Status = NF90_CLOSE( FileId ); Close_File = .FALSE.
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error closing output file - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Read_Cleanup(); RETURN
    END IF

    ! Output an info message
    IF ( Noisy ) THEN
      CALL BeCoeff_Info( BeCoeff, msg )
      CALL Display_Message( ROUTINE_NAME, 'FILE: '//TRIM(Filename)//'; '//TRIM(msg), INFORMATION )
    END IF

  CONTAINS

    SUBROUTINE Read_CleanUp()
      IF ( Close_File ) THEN
        NF90_Status = NF90_CLOSE( FileId )
        IF ( NF90_Status /= NF90_NOERR ) &
          msg = TRIM(msg)//'; Error closing input file during error cleanup- '//&
                TRIM(NF90_STRERROR( NF90_Status ))
      END IF
      CALL BeCoeff_Destroy( BeCoeff )
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME,msg,err_stat )
    END SUBROUTINE Read_CleanUp

  END FUNCTION BeCoeff_netCDF_ReadFile

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       BeCoeff_netCDF_IOVersion
!
! PURPOSE:
!       Subroutine to return the module version information.
!
! CALLING SEQUENCE:
!       CALL BeCoeff_netCDF_IOVersion( Id )
!
! OUTPUT ARGUMENTS:
!       Id:            Character string containing the version Id information
!                      for the module.
!                      UNITS:      N/A
!                      TYPE:       CHARACTER(*)
!                      DIMENSION:  Scalar
!                      ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE BeCoeff_netCDF_IOVersion( Id )
    CHARACTER(*), INTENT(OUT) :: Id
    Id = MODULE_VERSION_ID
  END SUBROUTINE BeCoeff_netCDF_IOVersion

!##################################################################################
!##################################################################################
!##                                                                              ##
!##                          ## PRIVATE MODULE ROUTINES ##                       ##
!##                                                                              ##
!##################################################################################
!##################################################################################

  ! Function to write the global attributes to a BeCoeff data file.

  FUNCTION WriteGAtts( &
    Filename, &  ! Input
    FileId  , &  ! Input
    Version , &  ! Optional input
    Title   , &  ! Optional input
    History , &  ! Optional input
    Comment ) &  ! Optional input
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN) :: Filename
    INTEGER     ,           INTENT(IN) :: FileId
    INTEGER     , OPTIONAL, INTENT(IN) :: Version
    CHARACTER(*), OPTIONAL, INTENT(IN) :: Title
    CHARACTER(*), OPTIONAL, INTENT(IN) :: History
    CHARACTER(*), OPTIONAL, INTENT(IN) :: Comment
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'BeCoeff_WriteGAtts(netCDF)'
    CHARACTER(*), PARAMETER :: WRITE_MODULE_HISTORY_GATTNAME   = 'write_module_history'
    CHARACTER(*), PARAMETER :: CREATION_DATE_AND_TIME_GATTNAME = 'creation_date_and_time'
    ! Local variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: GAttName
    CHARACTER(8)  :: cdate
    CHARACTER(10) :: ctime
    CHARACTER(5)  :: czone
    INTEGER :: Ver
    INTEGER :: NF90_Status
    TYPE(BeCoeff_type) :: BeCoeff

    ! Set up
    err_stat = SUCCESS
    msg = ' '

    ! Mandatory global attributes
    ! ...Software ID
    GAttName = WRITE_MODULE_HISTORY_GATTNAME
    NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),MODULE_VERSION_ID )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      CALL WriteGAtts_Cleanup(); RETURN
    END IF
    ! ...Creation date
    CALL DATE_AND_TIME( cdate, ctime, czone )
    GAttName = CREATION_DATE_AND_TIME_GATTNAME
    NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName), &
                                cdate(1:4)//'/'//cdate(5:6)//'/'//cdate(7:8)//', '// &
                                ctime(1:2)//':'//ctime(3:4)//':'//ctime(5:6)//' '// &
                                czone//'UTC' )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      CALL WriteGAtts_Cleanup(); RETURN
    END IF
    ! ...The Release
    GAttName = RELEASE_GATTNAME
    NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),BeCoeff%Release )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      CALL WriteGAtts_Cleanup(); RETURN
    END IF

    ! Optional global attributes
    ! ...The Version
    IF ( PRESENT(Version) ) THEN
      Ver = Version
    ELSE
      Ver = BeCoeff%Version
    END IF
    GAttName = VERSION_GATTNAME
    NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),Ver )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      CALL WriteGAtts_Cleanup(); RETURN
    END IF
    ! ...The title
    IF ( PRESENT(title) ) THEN
      GAttName = TITLE_GATTNAME
      NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),title )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL WriteGAtts_Cleanup(); RETURN
      END IF
    END IF
    ! ...The history
    IF ( PRESENT(history) ) THEN
      GAttName = HISTORY_GATTNAME
      NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),history )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL WriteGAtts_Cleanup(); RETURN
      END IF
    END IF
    ! ...The comment
    IF ( PRESENT(comment) ) THEN
      GAttName = COMMENT_GATTNAME
      NF90_Status = NF90_PUT_ATT( FileId,NF90_GLOBAL,TRIM(GAttName),comment )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL WriteGAtts_Cleanup(); RETURN
      END IF
    END IF

 CONTAINS

    SUBROUTINE WriteGAtts_CleanUp()
      NF90_Status = NF90_CLOSE( FileId )
      IF ( NF90_Status /= NF90_NOERR ) &
        msg = '; Error closing input file during error cleanup - '//&
              TRIM(NF90_STRERROR( NF90_Status ) )
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME, &
                            'Error writing '//TRIM(GAttName)//' attribute to '//&
                            TRIM(Filename)//' - '// &
                            TRIM(NF90_STRERROR( NF90_Status ) )//TRIM(msg), &
                            err_stat )
    END SUBROUTINE WriteGAtts_CleanUp

  END FUNCTION WriteGAtts

  ! Function to read the global attributes from a BeCoeff data file.

  FUNCTION ReadGAtts( &
    Filename, &  ! Input
    FileId  , &  ! Input
    Release , &  ! Optional output
    Version , &  ! Optional output
    Title   , &  ! Optional output
    History , &  ! Optional output
    Comment ) &  ! Optional output
  RESULT( err_stat )
    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: Filename
    INTEGER     ,           INTENT(IN)  :: FileId
    INTEGER     , OPTIONAL, INTENT(OUT) :: Release
    INTEGER     , OPTIONAL, INTENT(OUT) :: Version
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: Title
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: History
    CHARACTER(*), OPTIONAL, INTENT(OUT) :: Comment
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'BeCoeff_ReadGAtts(netCDF)'
    ! Local variables
    CHARACTER(ML)   :: msg
    CHARACTER(256)  :: GAttName
    CHARACTER(5000) :: GAttString
    INTEGER :: NF90_Status

    ! Set up
    err_stat = SUCCESS

    ! The global attributes
    ! ...The Release
    IF ( PRESENT(Release) ) THEN
      GAttName = RELEASE_GATTNAME
      NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Release )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL ReadGAtts_Cleanup(); RETURN
      END IF
    END IF
    ! ...The Version
    IF ( PRESENT(Version) ) THEN
      GAttName = VERSION_GATTNAME
      NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),Version )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL ReadGAtts_Cleanup(); RETURN
      END IF
    END IF
    ! ...The title
    IF ( PRESENT(title) ) THEN
      GAttName = TITLE_GATTNAME; GAttString = ''
      NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL ReadGAtts_Cleanup(); RETURN
      END IF
      CALL StrClean( GAttString )
      title = GAttString(1:MIN(LEN(title), LEN_TRIM(GAttString)))
    END IF
    ! ...The history
    IF ( PRESENT(history) ) THEN
      GAttName = HISTORY_GATTNAME; GAttString = ''
      NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL ReadGAtts_Cleanup(); RETURN
      END IF
      CALL StrClean( GAttString )
      history = GAttString(1:MIN(LEN(history), LEN_TRIM(GAttString)))
    END IF
    ! ...The comment
    IF ( PRESENT(comment) ) THEN
      GAttName = COMMENT_GATTNAME; GAttString = ''
      NF90_Status = NF90_GET_ATT( FileID,NF90_GLOBAL,TRIM(GAttName),GAttString )
      IF ( NF90_Status /= NF90_NOERR ) THEN
        CALL ReadGAtts_Cleanup(); RETURN
      END IF
      CALL StrClean( GAttString )
      comment = GAttString(1:MIN(LEN(comment), LEN_TRIM(GAttString)))
    END IF

  CONTAINS

    SUBROUTINE ReadGAtts_CleanUp()
      err_stat = FAILURE
      msg = 'Error reading '//TRIM(GAttName)//' attribute from '//TRIM(Filename)//' - '// &
            TRIM(NF90_STRERROR( NF90_Status ) )
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
    END SUBROUTINE ReadGAtts_CleanUp

  END FUNCTION ReadGAtts

  ! Function to create a BeCoeff file for writing

  FUNCTION CreateFile( &
    Filename    , &  ! Input
    n_Latitudes , &  ! Input
    n_Longitudes, &  ! Input
    FileId      , &  ! Output
    Version     , &  ! Optional input
    Title       , &  ! Optional input
    History     , &  ! Optional input
    Comment     ) &  ! Optional input
  RESULT( err_stat )

    ! Arguments
    CHARACTER(*),           INTENT(IN)  :: Filename
    INTEGER     ,           INTENT(IN)  :: n_Latitudes
    INTEGER     ,           INTENT(IN)  :: n_Longitudes
    INTEGER     ,           INTENT(OUT) :: FileId
    INTEGER     , OPTIONAL, INTENT(IN)  :: Version
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: Title
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: History
    CHARACTER(*), OPTIONAL, INTENT(IN)  :: Comment
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'BeCoeff_CreateFile(netCDF)'
    ! Local variables
    CHARACTER(ML) :: msg
    LOGICAL :: Close_File
    INTEGER :: NF90_Status
    INTEGER :: n_Components_DimID
    INTEGER :: n_Latitudes_DimID
    INTEGER :: n_Longitudes_DimID
    INTEGER :: varID
    INTEGER :: Put_Status(4)
    TYPE(BeCoeff_type) :: BeCoeff

    ! Setup
    err_stat = SUCCESS
    Close_File = .FALSE.

    ! Create the data file
    NF90_Status = NF90_CREATE( Filename,NF90_CLOBBER,FileId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error creating '//TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Create_Cleanup(); RETURN
    END IF
    ! ...Close the file if any error from here on
    Close_File = .TRUE.

    ! Define the dimensions
    ! ...Number of field components. (Cartesian directions, X, Y, and Z)
    NF90_Status = NF90_DEF_DIM( FileID,COMPONENT_DIMNAME,BeCoeff%n_Components,n_Components_DimID )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error defining '//COMPONENT_DIMNAME//' dimension in '//&
            TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Create_Cleanup(); RETURN
    END IF
    ! ...Number of regularly-spaced latitudes
    NF90_Status = NF90_DEF_DIM( FileID,LATITUDE_DIMNAME,n_Latitudes,n_Latitudes_DimID )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error defining '//LATITUDE_DIMNAME//' dimension in '//&
            TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Create_Cleanup(); RETURN
    END IF
    ! ...Number of regularly-spaced longitudes
    NF90_Status = NF90_DEF_DIM( FileID,LONGITUDE_DIMNAME,n_Longitudes,n_Longitudes_DimID )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error defining '//LONGITUDE_DIMNAME//' dimension in '//&
            TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Create_Cleanup(); RETURN
    END IF

    ! Write the global attributes
    err_stat = WriteGAtts( Filename, &
                           FileId  , &
                           Version = Version, &
                           Title   = Title  , &
                           History = History, &
                           Comment = Comment  )
    IF ( err_stat /= SUCCESS ) THEN
      msg = 'Error writing global attribute to '//TRIM(Filename)
      CALL Create_Cleanup(); RETURN
    END IF

    ! Define the variables
    ! ...LUT variable
    NF90_Status = NF90_DEF_VAR( &
                    FileID, &
                    LUT_VARNAME, &
                    LUT_TYPE, &
                    dimIDs=(/n_Components_DimID, n_Latitudes_DimID, n_Longitudes_DimID/), &
                    varID=VarID )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error defining '//LUT_VARNAME//' variable in '//&
            TRIM(Filename)//' - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Create_Cleanup(); RETURN
    END IF
    Put_Status(1) = NF90_PUT_ATT( FileID,VarID,LONGNAME_ATTNAME   ,LUT_LONGNAME    )
    Put_Status(2) = NF90_PUT_ATT( FileID,VarID,DESCRIPTION_ATTNAME,LUT_DESCRIPTION )
    Put_Status(3) = NF90_PUT_ATT( FileID,VarID,UNITS_ATTNAME      ,LUT_UNITS       )
    Put_Status(4) = NF90_PUT_ATT( FileID,VarID,FILLVALUE_ATTNAME  ,LUT_FILLVALUE   )
    IF ( ANY(Put_Status /= NF90_NOERR) ) THEN
      msg = 'Error writing '//LUT_VARNAME//' variable attributes to '//TRIM(Filename)
      CALL Create_Cleanup(); RETURN
    END IF

    ! Take netCDF file out of define mode
    NF90_Status = NF90_ENDDEF( FileId )
    IF ( NF90_Status /= NF90_NOERR ) THEN
      msg = 'Error taking file '//TRIM(Filename)// &
            ' out of define mode - '//TRIM(NF90_STRERROR( NF90_Status ))
      CALL Create_Cleanup(); RETURN
    END IF

  CONTAINS

    SUBROUTINE Create_CleanUp()
      IF ( Close_File ) THEN
        NF90_Status = NF90_CLOSE( FileID )
        IF ( NF90_Status /= NF90_NOERR ) &
          msg = TRIM(msg)//'; Error closing input file during error cleanup - '//&
                TRIM(NF90_STRERROR( NF90_Status ))
      END IF
      err_stat = FAILURE
      CALL Display_Message( ROUTINE_NAME,msg,err_stat )
    END SUBROUTINE Create_CleanUp

  END FUNCTION CreateFile

END MODULE BeCoeff_netCDF_IO

max_stars_repo_name: hsbadr/crtm

max_issues_repo_name: hsbadr/crtm

max_forks_repo_name: hsbadr/crtm


text:
C    @(#)bus_type.f	20.7 7/18/96
	character * (*) function bus_type (nb)

	include 'ipfinc/parametr.inc'
	include 'ipfinc/blank.inc'
	include 'ipfinc/bus.inc'
	include 'ipfinc/tbx.inc'

        character tbxtyp(6) * 2
        character tbxste(6,6) * 4

        data tbxtyp / 'BV', 'BQ', 'BG', 'BO', 'BX', 'BF' /
        data tbxste / 5*' ', 'BE',
     1     ' ', ' ', 'QMIN', ' ', 'QMIN', ' ',
     2     'VMIN', 'QMIN', 'QMAX', 'QMIN', 'QMAX', ' ',
     3     'VMAX', 'QMAX', 'VMIN', 'QMAX', 'QDIS', ' ',
     4     6*' ', 6*' ' /

        if (tbx_loaded .eq. 0) then
           do i = 1, ntot
              ptrtbx(i) = 0
           enddo

           do i = 1, ntotb
              kxd = tbx(2, i)
              if (kxd .gt. 0) ptrtbx(kxd) = i
           enddo
           tbx_loaded = 1
        endif

        ktype = kbsdta(1,nb)
        bus_type = 'B'
        call typno (bus_type(2:2), ktype)

C               1   2   3   4   5   6   7   8   9  10  11  12  13)
        go to (90, 90, 90, 90, 90, 10, 10, 10, 10, 90, 10, 90, 90)
     1    ktype

   10   jt = ptrtbx(nb)
        ltyp = tbx(1,jt)
        ityp = tbx(7,jt)
        bus_type(3:) = tbxste(ltyp,ityp)

   90   return
        end

max_stars_repo_name: mbheinen/bpa-ipf-tsp

max_issues_repo_name: cuihantao/bpa-ipf-tsp

max_forks_repo_name: mbheinen/bpa-ipf-tsp


text:
module result_test
    use vegetables, only: &
            result_t, &
            test_item_t, &
            assert_doesnt_include, &
            assert_equals, &
            assert_includes, &
            assert_that, &
            assert_not, &
            describe, &
            fail, &
            it, &
            succeed

    implicit none
    private

    public :: test_result
contains
    function test_result() result(tests)
        type(test_item_t) :: tests

        tests = describe( &
                "Results", &
                [ it("Can tell whether they passed", check_passed) &
                , it( &
                        "Can tell how many assertions there were", &
                        check_num_asserts) &
                , it( &
                        "Can tell how many failing assertions there were", &
                        check_num_failing_asserts) &
                , it( &
                        "Verbose description includes all the messages", &
                        check_verbose_includes) &
                , it( &
                        "Failure description only includes the failing messages", &
                        check_failure_includes) &
                ])
    end function

    pure function check_passed() result(result_)
        type(result_t) :: result_

        type(result_t) :: failing_result
        type(result_t) :: passing_result

        passing_result = succeed("Message")
        failing_result = fail("Message")

        result_ = &
                assert_that(passing_result%passed()) &
                .and.assert_not(failing_result%passed())
    end function

    pure function check_num_asserts() result(result_)
        type(result_t) :: result_

        type(result_t) :: multiple_asserts

        multiple_asserts = succeed("First").and.succeed("Second")

        result_ = assert_equals(2, multiple_asserts%num_asserts())
    end function

    pure function check_num_failing_asserts() result(result_)
        type(result_t) :: result_

        type(result_t) :: multiple_asserts

        multiple_asserts = succeed("First").and.fail("Second")

        result_ = assert_equals(1, multiple_asserts%num_failing_asserts())
    end function

    pure function check_verbose_includes() result(result_)
        type(result_t) :: result_

        type(result_t) :: multiple_asserts

        multiple_asserts = succeed("First").and.fail("Second")

        result_ = &
                assert_includes( &
                        "First", multiple_asserts%verbose_description(.false.))&
                .and.assert_includes( &
                        "Second", multiple_asserts%verbose_description(.false.))
    end function

    pure function check_failure_includes() result(result_)
        type(result_t) :: result_

        type(result_t) :: multiple_asserts

        multiple_asserts = succeed("First").and.fail("Second")

        result_ = &
                assert_doesnt_include( &
                        "First", multiple_asserts%failure_description(.false.))&
                .and.assert_includes( &
                        "Second", multiple_asserts%failure_description(.false.))
    end function
end module

max_stars_repo_name: everythingfunctional/vegetables

max_issues_repo_name: everythingfunctional/vegetables

max_forks_repo_name: everythingfunctional/vegetables


program whereStatement
implicit none

   integer :: a(3,5), i , j

   do i = 1,3
      do j = 1, 5
         a(i,j) = j-i
      end do
   end do

   Print *, 'The A array:'

   do i = lbound(a,1), ubound(a,1)
      write(*,*) (a(i,j), j = lbound(a,2), ubound(a,2))
   end do

   where( a<0 )
      a = 1
   elsewhere
      a = 5
   end where

   Print *, 'The A array:'
   do i = lbound(a,1), ubound(a,1)
      write(*,*) (a(i,j), j = lbound(a,2), ubound(a,2))
   end do

end program whereStatement


text:
This is a page to leave stories of alleged and factual racial profiling, police agressiveness, misconduct, and unconstitutional rights violations on UC Davis Police Department campus and in the Davis Police Department City. The flip side of this page can be found at Police Appreciation Stories.
 http://www.aclunc.org/publications.html For a full report on racial profiling in California (ACLU)

http://www.sacbee.com/content/news/story/13489410p14330102c.html According to information provided by the Davis Police Department, According to the data presented, blacks and Latinos were arrested at significantly higher rates than whites during the first seven and a half months of 2005. From Jan. 1 to Aug. 19, Latinos accounted for 20.5 percent of all arrests in Davis, while comprising roughly 10 percent of the population. During the same period, blacks accounted for 9.2 percent of arrests, while comprising about 2.4 percent of the population.

  Are those arrested necessarily citizens of Davis?  After that question is answered, what is the average for black/latino arrests relative to their population?  Answering that question would tell us how much above or below Davis is in terms of this.

 Racial Profiling Stories

March, 2006: The Davis police are facing an upcoming civil rights suit after initiating an investigation and arresting Halema Buzayan, a high school student, for allegedly bumping into and denting another car in the Cowell Blvd. Safeway parking lot.  Buzayan denies that she was driving at the time and her father showed photos to KGO news personnel which he claims demonstrate that it could not have been the Buzayans car that made the dent.  However, a witness to the accident took down the license plate, which matched the Buzayan family vehicle, gave a description of a teenage driver that matched Halema, and picked Halema out of a photoline up.  Regardless of fault, the police continued to pursue criminal charges against Halema after it had been settled civilly between the two parties.  The victim criticised the police investigation on KGO news: For them to prosecute something like this  this is a bumper bender in a parking lot  really makes me question where the priorities are.  http://abclocal.go.com/kgo/story?sectioni_team&id4000500 abc story.

November, 2005: An AfricanAmerican couple alleges racial profiling and discrimination by Davis police.  Ivy Anderson and David Johnson file a civil rights lawsuit, citing cameras set up around their home recording over 500 incidents of Davis PD driving by their home, shining lights, etc, but making no arrests.

November, 2004; Senior Richmond Darko, a 20yearold born in Ghana, wants an explanation why police stopped him on his way to a computer lab to search his backpack and ask what he was doing on campus.You were in the wrong place at the wrong time, Darko recalled an officer telling him. The Davis Enterprise Archives “Racism at root of police complaint” By Lauren Keene Enterprise staff writer Published: October 15, 2004

October 5th, 2004:  AfricanAmerican UC Davis graduate student Ebrima Ceesay was stopped by UC Davis police at the corner of Kleiber Hall and Hutchison drives at about 4 p.m. for obstructing traffic by not giving the right of way to a pedestrian. The officer then proceeded to ask if Ceesay ever had any driving tickets, criminal records, tattoos on his body, or lived in Oakland. Ceesay said he found the questions demeaning and dishonoring, and of no relevance to the alleged bike infraction. During the incident, a second officer pulled up behind Les patrol car and observed the conversation with one hand resting on his gun, Ceesay said.

It should be noted that it is acceptable and legal for officers to place their hands on their guns or holsters for various reasons.  Officers are trained to do this in unassessed situations as it can greatly assist in response time in a situation where either lethal force or the threat of lethal force is necessary.  Some believe the posture may be used as a method of intimidation and question how often it is done when questioning minorities versus similar situations with nonminorities.

I get asked similar questions everytime i am stopped including have you ever been arrested, do you have any warrants, where do you live. It should be noted that in every stop police verify all your information with NCIC and know the answers to all these questions already, they are simply asking to testyour honesty for whatever reason not necessarily to demean you. In the above case there was probably someone who matched the description of the person stopped that the police were actively looking for.

http://occr.ucdavis.edu/news/view.cfm?news_id61 The Davis Enterprise Archives: Racism at root of police complaint by Lauren Keene Enterprise staff writer (October 15, 2004).

Exact date unknown, Fall 2004: Frederick Clarke, a secondyear AfricanAmerican graduate student in computer science at UCD, said police officers stopped him and his roommate while in the process of getting their bicycles.One of the police officers was nasty in his approach to the whole thing, Clarke said. One made a comment about having an Uzi in my pocket. UCD grad student files complaint against campus police” by Katy Tang Posted 10/18/2004, California Aggie

i think i know this cop, i was stopped by him because i matched the description of someone who they were looking for and while he was searching me he asked if i had and weapons in my pockets such as grenades, rocket launchers etc. its a joke, at least in my case i dont think theres anything wrong with that

 Misconduct
May 18, 2009:
Please read the UC Davis Police misconduct complaint that I sent to the UCD Police Chief. I hope that my concerns will be noted. I cannot believe that regular citizens are being treated this way.

Sir/Madame,
On May 18th 2009 around 10pm, I was stopped by a police car at A street and Hutchinson Dr vicinity in Davis California. I was driving a 1995 white mercury tracer, belonging to my daughter. I had just dropped of my daughter, who is a student at UC Davis, and was looking to make my way back to Hwy 80 for Sacramento. I got lost around the place mentioned above and called my daughter for directions. At that time I saw the blinking lights of the patrol car behind me. When I was pulled over I did use a cell phone and understood that I was in violation.
When the officer approached my vehicle from the right and knocked on the window, I opened the right side door. Due to the darkness in the car and the officer’s flashlight that was shining in my eyes, I could barely make out the officers’ profile due to his position at the right back door. He told me that I was in violation for 3 codes: 1. Cell phone use while driving. 2. Tail light failure.(checking afterwards, revealed no tail light problem) 3. License plate light failure. He said that he will write me only one ticket for the cell phone violation and dismiss the other ones. He asked for license, registration and proof of insurance. I provide my license (wallet) very quickly but had trouble finding the registration and proof of insurance (glove compartment) as the car was dark and the flashlight of the officer was constantly pointed at my face. I found the registration and the insurance paper and gave it to the officer. (Due to the darkness I must have given the officer the expired insurance paper instead of the current one.) The officer went back to his vehicle and I waited in the car. This allowed me time to go over all the facts and then I remembered that my drivers’ license has my previous address. I wanted to inform the officer of this fact as such that the correspondence of this traffic violation would not be sent to the wrong address. I opened the door and waved at the officer to get his attention. After a few seconds the responds was aggressive and loud: “Get back in the car and close the door!”. I got back in the car and waited. Finally the officer came back and stood again on my right barely visible. He told me that my insurance document was expired and said he was giving me a ticket. I told him that there was insurance on the car and that the document must be in the glove compartment. He told me that I had already ample time to find it. (this is not correct because I was only informed of this a few second before) I started looking for the current insurance documents on the seat next to me when he loudly shouted at me to stop it or he would take me to jail right there. I just sat silently in my car and waited for this to pass. The last time I was approached with such immediate verbal aggressiveness was during infantry basic training 26 years ago. He stretched to let me sign the violation report and walked off.
I fully understand and respect the authority of a police officer and I will pay the fine without reservation, however this random humiliation at the hands of this police officer has altered the image I had of a Police departments’ ability to serve and protect.
My complaint does not question the validity of the traffic violation nor does it question enforcement of the law. My complaint does question the capability of the officer to correctly read the situation in front of him and his overall poor job performance. The officer was rude, inpatient, threatening with total disregard of civil acceptable behavior. This behavior might be warranted in gang infested neighborhoods but not towards every day civilians being stopped for a traffic violation. I feel humiliated, frustrated and worried that my daughter might be approached the same way during her college time UC Davis.Users/ConcernedParent

August 26th, 2006: Whatever Rights You Think You Have You Dont.....this line was said to two UCD student leaders, Chris Herold, former chair of the ASUCD Business and Finance Commission and Eric Zamora, former Student Assistant to the Chancellor as well as myself, James Schwab ASUCD director of External Affairs. Furthermore, we have all sat on the CityStudent Liaison Commission.

Who said this line? A Davis Police officer.

This evening at 12:45am an officer responded to a noise complaint for our going away party for friend. Eric and Chris answered the door. They were not residents of the house, so the officer requested to speak with a resident. As a resident was being fetched, Eric closed the door slightly. The officer put his foot in the door and said he cannot shut the door. The officer continued and said that whatever rights you think you have you dont. Once a resident came to the door, the resident, Eric, Chris and officer talked outside. I was not a part of this coversation, but Eric and Chris told me the officers tone was very threatening. They both used audio recorders to tape the conversation.

I am extremely offended that a public servant in the City of Davis confronts its citizenry in this manner. There was absolutely no reason for the officer to take a threatening manner; Eric and Chris were both polite and cordial they have both worked consistently with leadership from the University as well as the City police departments. Second, for a police officer not to believe in a citizens rights is disturbing. I never thought I would hear such language used by an officer who has sworn to uphold the law.

I do not know the name of the officer, only that he drove one of the white, unmarked vehicles on FridaySaturday August 25th26th.

I plan on filing a formal complaint, as this behavior should not be tolerated by citizens or fellow officers.
  Doesnt it seem a bit irregular, perhaps unfair, to shunt this over to the talk page, when there are many other lengthy discussions on this page?Users/CameronMenezes

June 17th, 2005: Police accidently rough up an autistic 17 year old in Slide Hill Park after receiving a report that he attempted to lure a young girl into the car. http://www.davisenterprise.com/articles/2005/06/17/news/197new0.txt read the Davis Enterprise story.

April 16th, 2005: A police http://www.livejournal.com/community/ucdavis/2093976.html misconduct story was sighted on the UCD LiveJournal, about overactive police during Picnic Day.

June 2004:Police Pepper spray individuals at a party.  Also, police arrest couple in alleged domestic dispute. Both incidents are detailed in http://www.californiaaggie.com/media/storage/paper981/news/2004/06/02/FrontPage/Students.Police.Stories.Differ1317742.shtml this California Aggie article.

April 24th, 2004: Im not sure if this should be classified as police misconduct, or just really fucked up, so feel free to correct me if needed. Me and five other friends were coming back from a DPS formal and had a stupid idea to go see the llamas over by the Veterinary Medicince Center on campus. After driving slowly by the llamas, getting our fill for the night, we were on our way out. Then, from out of nowhere, a cop car appears and pulls us over. All of us were completely sober, and the driver had been following the traffic laws, so we all were dumbfounded as to why the cop pulled us over. The cop asked our driver why he had run the stop sign 10 feet behind us, but the odd thing is none of us could remember seeing a stop sign and didnt know what the cop was talking about. We all had to get out of the car, still in our formal clothes and show him our student IDs, and were each badgered about why were doing there, where we were earlier that night, etc. Eventually they let us go, but before they did the cop added casually, Oh, and dont worry, you didnt run a stop sign, were pulling over all the cars through this area because were looking for ELF and/or ALF demonstrators... heightened security for Earth Week, you know... and you guys just dont fit the profile. Though they let us all go without incident, I found the whole incident a little weird, and was sure glad I was in my formal clothes and didnt fit the profile.

March 5th, 2004  A friend of mine from an aerobic walking class confided in me that she was going to have to leave the country to protect herself and her kids from her allegedly abusive ex husband. I never met the exhusband and didnt even know my friend that well at the time, so I had no reason to take sides there  but as soon as she left, the police inevitably came after her for violating the custody order. Now there are laws there that they have to enforce, I understand that and dont blame them for contacting me for info (which I didnt have, she didnt tell me where she was going). But investigator Rick Gore from the Yolo Countys DA Office, who they sent to interview me, made several sexist comments, for example saying that if she were to call me, then he would want me to let him know first so that they could tap the phone, but that I shouldnt worry or get embarrassed since he wouldnt pay attention or gossip if we started to talk about boys or something. Also he told me that they had to find her because she couldnt survive on her own in a foreign country, what would she do once she got her period and got cramps and couldnt even go to the public health hospital? I felt so awkward having to talk about cramps with a male investigator, and I got the sense that he thought my friend and I were like young children or junior high girls. CristinaDeptula

September 1989,  A black lawyer is allegedly beaten by Davis police according to a group of witnesses who saw the incident. The investigation into the four officers accused of the beating is kept private by the City. Sacramento Bee on September 15, 1989, Page B1 and September 14, 1989, Page B1

December 20th, 1989  The Yolo County district attorneys office prosecuted, William Caldwell, a black man for resisting arrest in an incident outside a community theater, even though the city of Davis that the charges be dropped. The arrest in September of 1998 of Caldwell who was an amateur actor and recent graduate of the University of California, Davis, School of Law, prompted public protest and criticism of police tactics. Sacramento Bee, December 20, 1989, Page B2,
 Civil Rights Violations
November 18, 2011 UC Davis Students PepperSprayed UC Davis Police pepper spray peaceful protesters

April, 2004: Sterling Apartment prePicnic Day party. Anonymous UC Davis football player is shot in the eye with a police pepper spray projectile. (basically a paintball gun that shoots pellets filled with a mixture of cayenne pepper and water) The student was on his balcony in Sterling Apartments, during the Sterling riots. Police are trained to avoid shooting the pepper projectile guns at peoples heads, otherwise the guns MAY become http://www.policeone.com/pdfs/bostonglobe.pdf lethal.  The student became blind in the eye he was hit in, and lost his sports scholarship. A lawsuit he filed is still pending.
  What was the student doing when he was shot?  He was obviously not leaving the area.   Why did this student remain at the party after being given lawful orders to disperse (leave the area)?  I know for a fact that officers gave orders to disperse MULTIPLE times before firing any pepper projectiles.  CameronMenezes
         The student was on the balcony of his third floor apartment looking down and whaat was happening. Users/JimSchwab
          Officers gave orders for everyone to leave the area and return to their apartments/get off the apartment grounds.  Officer did not know where, or who, was throwing the projectiles (at the police).  A thirdfloor balcony with boozy people on it would scare me, as an officer, since those people could chuck anything right onto my head (if I were on the ground).  In my opinion as a nonpolice officer, the people on that balcony were definitely an implicit, if not explicit, danger.  Or should the cops have simply had blind faith in the goodness of the people on the balcony?CameronMenezes
            I actually agree with you on this one, they should just shoot everyone on every balcony. Users/JimSchwab
             Jim!  Weve finally agreed!  But remember only if the person refuses to leave that balcony after repeated, and lawful, orders from the police. :)  July 20th... Ill write that down so that you and I can send congratulatory messages to each other on every anniversary of our first agreement. :)CameronMenezes

Can we have an examination of the increased police presence during Black Family Day (including the calling in of other local agencies: Yolo county, Woodland police)? Also, Look into the hesitation the police have of too many black people in davis, and the desire to have such events over before sundown. The early closing of businesses and police turning people away from AMPM on such nights. Users/DavisWikiGnome
  Dont know about the rest of the stuff, but how could the police have anything to do with businesses closing early?  Police officers cannot tell businesses to close, unless, of course, the business is illegal! :)  Black Family Day is a large event (with great food, I might add).  Having other agencies oncall doesnt seem that unusual... just my $.02.CameronMenezes
  Actually, police can shut down businesses when they feel that there is imminent threat of civil unrest. In 2006, the July 4 fireworks display at Raley Field was shut down by police after about 15minutes because a couple started a brawl that began to involve bystanders. How imminent threat is determined is, I suppose, at the discretion of the police officers present and is likely colored by their personal beliefs. Users/AlphaDog
    ADog, good point.CameronMenezes
   Should we then also investigate the large police presence during picnic day?  DaveZavatson
   Picnic day is entirely different, with a lot of alcohol and tons and tons of people.  If you compared the amount of police per people present black families day certainly has more. (im not talking about rained out picnic days of course, but i would still guess the analogy holds) Users/MattHh

 Addressing the Problem

It is important that we identify, clearly document, and generate awareness about injustices in our society, but it is also important that we move toward a solution to this problem.

Solutions and things to keep in mind:

  Encourage free discussion between parties.
  Focus on bad aspects, but also identify and recognize good aspects. i.e. Police Appreciation Stories (they may be paid to do their jobs but we can also show our gratitude for their actions)
  Push for good individuals to join the force, instead of pushing them out. (collateral damage from harsh criticism directed at the entire police as opposed to individual officers who commit the actions)
  Generate and brainstorm new and innovative solutions in addition to identifying the problem.
  Occasionally, a misunderstanding may result in police misconduct, or in police conduct that is misinterpreted as misconduct. Knowing How to survive police encounters how to survive police encounters may help one to avoid these misunderstandings.

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
! ###########################################################
! #                                                         #
! #                    THE LIDORT FAMILY                    #
! #                                                         #
! #      (LInearized Discrete Ordinate Radiative Transfer)  #
! #       --         -        -        -         -          #
! #                                                         #
! ###########################################################

! ###########################################################
! #                                                         #
! #  Author :      Robert. J. D. Spurr                      #
! #                                                         #
! #  Address :     RT Solutions, Inc.                       #
! #                9 Channing Street                        #
! #                Cambridge, MA 02138, USA                 #
! #                                                         #
! #  Tel:          (617) 492 1183                           #
! #  Email :        rtsolutions@verizon.net                 #
! #                                                         #
! #  This Version :   3.7 F90                               #
! #  Release Date :   June 2014                             #
! #                                                         #
! #       NEW: THERMAL SUPPLEMENT INCLUDED    (3.2)         #
! #       NEW: OUTGOING SPHERICITY CORRECTION (3.2)         #
! #       NEW: TOTAL COLUMN JACOBIANS         (3.3)         #
! #       VLIDORT COMPATIBILITY               (3.4)         #
! #       THREADED/OPTIMIZED F90 code         (3.5)         #
! #       EXTERNAL SS / NEW I/O STRUCTURES    (3.6)         #
! #                                                         #
! #       Surface-leaving, BRDF Albedo-scaling     (3.7)    #
! #       Taylor series, BBF Jacobians, ThreadSafe (3.7)    #
! #                                                         #
! ###########################################################

!    #####################################################
!    #                                                   #
!    #   This Version of LIDORT comes with a GNU-style   #
!    #   license. Please read the license carefully.     #
!    #                                                   #
!    #####################################################

      module LIDORT_LinOutputs_def

!  Version 3.7, Internal threading removed, 02 May 2014

!  This module contains the following LIDORT output structures,
!  with intents :

!         LIDORT_LinAtmos    nested in LIDORT_LinOutputs
!          LIDORT_LinSurf    nested in LIDORT_LinOutputs
!       LIDORT_LinOutputs    Intent(Out)

      use LIDORT_PARS, only : fpk, MAX_GEOMETRIES, MAX_DIRECTIONS, &
                              MAXBEAMS, MAX_USER_STREAMS, MAX_USER_LEVELS,     &
                              MAXLAYERS, MAX_ATMOSWFS, MAX_SURFACEWFS

      implicit none

! #####################################################################
! #####################################################################

      TYPE LIDORT_LinAtmos

!  Column weighting functions at all angles and optical depths

      REAL(fpk), dimension ( MAX_ATMOSWFS, MAX_USER_LEVELS, MAX_GEOMETRIES, MAX_DIRECTIONS ) :: TS_COLUMNWF

!  Mean-intensity and Flux, column weighting functions

      REAL(fpk), dimension ( MAX_ATMOSWFS, MAX_USER_LEVELS, MAXBEAMS, MAX_DIRECTIONS ) :: TS_MINT_COLUMNWF
      REAL(fpk), dimension ( MAX_ATMOSWFS, MAX_USER_LEVELS, MAXBEAMS, MAX_DIRECTIONS ) :: TS_FLUX_COLUMNWF

!  Profile weighting functions at all angles and optical depths

      REAL(fpk), dimension ( MAX_ATMOSWFS, MAXLAYERS, MAX_USER_LEVELS, MAX_GEOMETRIES, MAX_DIRECTIONS ) :: TS_PROFILEWF

!  Mean-intensity and flux, profile weighting functions

      REAL(fpk), dimension ( MAX_ATMOSWFS, MAXLAYERS, MAX_USER_LEVELS, MAXBEAMS, MAX_DIRECTIONS ) :: TS_MINT_PROFILEWF
      REAL(fpk), dimension ( MAX_ATMOSWFS, MAXLAYERS, MAX_USER_LEVELS, MAXBEAMS, MAX_DIRECTIONS ) :: TS_FLUX_PROFILEWF

!  Blackbody weighting functions, 18 March 2014, Introduced for Version 3.7

      REAL(fpk), dimension ( MAX_USER_LEVELS, MAX_USER_STREAMS, 0:MAXLAYERS, MAX_DIRECTIONS) :: TS_ABBWFS_JACOBIANS
      REAL(fpk), dimension ( MAX_USER_LEVELS, 2, 0:MAXLAYERS, MAX_DIRECTIONS)                :: TS_ABBWFS_FLUXES

      END TYPE LIDORT_LinAtmos

! #####################################################################
! #####################################################################

      TYPE LIDORT_LinSurf

!  Surface weighting functions at all angles and optical depths

      REAL(fpk), dimension ( MAX_SURFACEWFS, MAX_USER_LEVELS, MAX_GEOMETRIES, MAX_DIRECTIONS ) :: TS_SURFACEWF

!  Mean-intensity and flux, surface weighting functions

      REAL(fpk), dimension ( MAX_SURFACEWFS, MAX_USER_LEVELS, MAXBEAMS, MAX_DIRECTIONS ) :: TS_MINT_SURFACEWF
      REAL(fpk), dimension ( MAX_SURFACEWFS, MAX_USER_LEVELS, MAXBEAMS, MAX_DIRECTIONS ) :: TS_FLUX_SURFACEWF

!  Blackbody weighting functions, 18 March 2014, Introduced for Version 3.7

      REAL(fpk), dimension ( MAX_USER_LEVELS, MAX_USER_STREAMS, MAX_DIRECTIONS) :: TS_SBBWFS_JACOBIANS
      REAL(fpk), dimension ( MAX_USER_LEVELS, 2, MAX_DIRECTIONS)                :: TS_SBBWFS_FLUXES

      END TYPE LIDORT_LinSurf

! #####################################################################
! #####################################################################

      TYPE LIDORT_LinOutputs

      TYPE(LIDORT_LinAtmos) :: Atmos
      TYPE(LIDORT_LinSurf)  :: Surf

      END TYPE LIDORT_LinOutputs

! #####################################################################
! #####################################################################

!  EVERYTHING PUBLIC HERE

      PRIVATE
      PUBLIC :: LIDORT_LinAtmos,&
                LIDORT_LinSurf,&
                LIDORT_LinOutputs

      end module LIDORT_LinOutputs_def

max_stars_repo_name: GEOS-ESM/AeroApps

max_issues_repo_name: GEOS-ESM/AeroApps

max_forks_repo_name: GEOS-ESM/AeroApps


text:
logical :: dir_e
! a trick to be sure docs is a dir
inquire( file="./docs/.", exist=dir_e )
if ( dir_e ) then
  write(*,*), "dir exists!"
else
  ! workaround: it calls an extern program...
  call system('mkdir docs')
end if

max_issues_repo_name: seanwallawalla-forks/RosettaCodeData

max_forks_repo_name: seanwallawalla-forks/RosettaCodeData


#include "eiscor.h"
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! DARFGR (Double Auxiliary Routine Fuse Givens Rotations)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! This routine computes the product of two real Given's rotations and
! and stores the output in one of the input arrays.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! INPUT VARIABLES:
!
!  JOB             CHARACTER
!                    'L': store fusion in Q1
!                    'R': store fusion in Q2
!
!  Q1, Q2          REAL(8) array of dimension (2)
!                    generators for two Givens rotations
!
! OUTPUT VARIABLES:
!
!  INFO            INTEGER
!                    INFO = 0 implies successful computation
!                    INFO = -1 implies JOB is invalid
!                    INFO = -2 implies Q1 is invalid
!                    INFO = -3 implies Q2 is invalid
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine DARFGR(JOB,Q1,Q2,INFO)

  implicit none

  ! input variables
  character, intent(in) :: JOB
  integer, intent(inout) :: INFO
  real(8), intent(inout) :: Q1(2), Q2(2)

  ! compute variables
  real(8) :: nrm

  ! initialize INFO
  INFO = 0

  ! check input in debug mode
  if (DEBUG) then

    ! check JOB
    if ((JOB.NE.'L').AND.(JOB.NE.'R')) then
      INFO = -1
      call UARERR(__FILE__,__LINE__,"JOB is invalid",INFO,-1)
      return
    end if

    ! check Q1
    call DARACH1(2,Q1,INFO)
    call UARERR(__FILE__,__LINE__,"Q1 is invalid",INFO,-2)
    if (INFO.NE.0) then
      return
    end if

    ! check Q2
    call DARACH1(2,Q2,INFO)
    call UARERR(__FILE__,__LINE__,"Q2 is invalid",INFO,-3)
    if (INFO.NE.0) then
      return
    end if

  end if

  ! store in Q2
  if(JOB.EQ.'R')then
    ! compute new generators
    nrm = Q1(1)*Q2(1) - Q1(2)*Q2(2)
    Q1(2) = Q1(2)*Q2(1) + Q1(1)*Q2(2)
    Q1(1) = nrm

    ! compute new generators
    call DARCG22(Q1(1),Q1(2),Q2(1),Q2(2),nrm,INFO)

    ! check INFO in debug mode
    if (DEBUG) then
      call UARERR(__FILE__,__LINE__,"DARCG22 failed",INFO,INFO)
      if (INFO.NE.0) then
        return
      end if
    end if

  ! store in Q2
  else
    ! compute new generators
    nrm = Q1(1)*Q2(1) - Q1(2)*Q2(2)
    Q2(2) = Q1(2)*Q2(1) + Q1(1)*Q2(2)
    Q2(1) = nrm

    ! compute new generators
    call DARCG22(Q2(1),Q2(2),Q1(1),Q1(2),nrm,INFO)

    ! check INFO in debug mode
    if (DEBUG) then
      call UARERR(__FILE__,__LINE__,"DARCG22 failed",INFO,INFO)
      if (INFO.NE.0) then
        return
      end if
    end if

  end if

end subroutine DARFGR