Search Site | Contact Details | FAQ

ADAS Subroutine bgdiff

C
      SUBROUTINE BGDIFF( ILEV  , maxt  , maxd    , 
     &                   popun , popar ,
     &                   error , index , 
     &                   ind_t , err_t , index_t , adiff_t , rt , 
     &                   ind_d , err_d , index_d , adiff_d , rd   
     &                 )

C-----------------------------------------------------------------------
C
C  ****************** FORTRAN77 SUBROUTINE: BGDIFF *********************
C
C  PURPOSE:  Calculates the absolute difference from 1.0 for temperature
C            or density and updates the set of arrays holding the top
C            ndtr contributing transitions. 
C
C  CALLING PROGRAM: ADAS216
C
C  INPUT : (R*8)   POP      = POPULATION ARRAY
C
C  ROUTINES:
C          ROUTINE    SOURCE    BRIEF DESCRIPTION
C          ------------------------------------------------------------
C          R8ADIF     ADAS      calculates absolute difference of array
C
C  
C  AUTHOR   : Martin O'Mullane,
C             K1/1/43,
C             JET
C
C  VERSION  : 1.1                          
C  DATE     : 17/03/1999
C
C  MODIFIED : Martin O'Mullane  
C             First version.
C
C-----------------------------------------------------------------------
      INTEGER             ILEV,        INDEX
      INTEGER             INDEX_D(NDLEV,NDTEM,NDTR)
      INTEGER             INDEX_T(NDLEV,NDDEN,NDTR)
      INTEGER             IND_D(NDLEV,NDTEM),       IND_T(NDLEV,NDDEN)
      INTEGER             MAXD,        MAXT
      REAL*8              ADIFF_D(NDLEV,NDTEM,NDTR)
      REAL*8              ADIFF_T(NDLEV,NDDEN,NDTR),             ERROR
      REAL*8              ERR_D(NDLEV,NDTEM,NDTR)
      REAL*8              ERR_T(NDLEV,NDDEN,NDTR)
      REAL*8              POPAR(NDLEV,NDTEM,NDDEN)
      REAL*8              POPUN(NDLEV,NDTEM,NDDEN)
      REAL*8              RD(NDLEV,NDTEM,NDDEN,NDTR)
      REAL*8              RT(NDLEV,NDTEM,NDDEN,NDTR)
© Copyright 1995-2024 The ADAS Project
Comments and questions to: adas-at-adas.ac.uk