#include "dims.h"
      SUBROUTINE BACKGRND
      use cons_module,only: kmax,kmaxp1,expz,dt,pi
      use init_module,only: iter,iday,dift,difk
      implicit none
#include "params.h"
#include "fcom.h"
#include "vscr.h"
#include "buff.h"
#include "rfft.h"
#include "index.h"
#include "pmgrid.h"
#include "mgw.h"
! 
      real :: rayk,xmue,timeb,timebx,effwv
      COMMON/RAYFRIC/RAYK(ZKMX)
      COMMON/EDYVISC/XMUE(ZKMXP)
      COMMON/TIMETRS/TIMEB,TIMEBX
      COMMON/ALFFAC/EFFWV(ZKMX)
C     ****
C     ****
C     ****
C     ****       EDDY DIFFUSION PROFILE PARAMETERS
C     ****
      real :: eddylb,zplb,eddymb1,zpmb1,eddymb2,zpmb2,eddytp,zptp
      real :: raykle,raykme1,raykme2,raykte
      real :: raykls,raykms1,raykms2,raykts
      real :: usorle,usorls
      real :: ulsorle,ulsorls
      real :: face,facs
      real :: prantl
      real :: col1(zkmxp)
!
      DATA EDDYLB ,ZPLB, EDDYMB1 ,ZPMB1,EDDYMB2 ,ZPMB2 ,EDDYTP ,ZPTP/
     1     4.0E-8 ,-17., 4.0E-7  ,-13. ,5.0E-8  ,-9.   ,2.0E-8 ,-6.5/
C
C **** RAYLEIGH FRICTION BACKGROUND DAMPING TIME 1/116DAYS CONSTANT
C **** WITH ALTITUDE (1.E-7 S-1)
C
      DATA RAYKLE,RAYKME1,RAYKME2,RAYKTE/1.0E-7,1.0E-8,1.0E-8,1.0E-8/
C     DATA RAYKLE,RAYKME1,RAYKME2,RAYKTE/3.0E-7,3.0E-7,3.0E-7,3.0E-7/
C     DATA RAYKLE,RAYKME1,RAYKME2,RAYKTE/1.0E-8,1.0E-8,1.0E-8,1.0E-8/
      DATA RAYKLS,RAYKMS1,RAYKMS2,RAYKTS/3.0E-7,3.0E-7,3.0E-7,3.0E-7/
      DATA USORLE,USORLS/-2.0,+2.0/
      DATA ULSORLE,ULSORLS/+1.5,-1.5/
C     DATA FACE,FACS/0.08,0.08/
      DATA FACE,FACS/0.10,0.10/
C     DATA FACE,FACS/0.03,0.03/
      DATA PRANTL/10./
!
      real :: dday,day1,day2,rayklb,raykmb1,raykmb2,rayktb,
     |  ds,s,expds
      integer :: k,klb,kmb1,kmb2,kturb
C     ****
C     ****  CALCULATE EDDY DIFFUSION AND RAYLEIGH FRICTION PROFILES
C     ****
      dday = float(iday)+amod(float(iter)*dt,86400.)/86400.
      uth = amod(float(iter)*dt,86400.)/3600.
C
      day1 = abs(cos(2.*pi*(dday-355.)/365.))
      day2 = cos(2.*pi*(dday-355.)/365.)
      RAYKLB = RAYKLE+(RAYKLS-RAYKLE)*DAY1
      RAYKMB1 = RAYKME1+(RAYKMS1-RAYKME1)*DAY1
      RAYKMB2 = RAYKME2+(RAYKMS2-RAYKME2)*DAY1
      RAYKTB = RAYKTE+(RAYKTS-RAYKTE)*DAY1
C     **** This is coupled to mgw.f
      USORLA = USORLE+(USORLS-USORLE)*DAY1
      ULSORLA = ULSORLE+(ULSORLS-ULSORLE)*DAY1
C     **** This is coupled to mgwbgnd.f
      FACA = FACE+(FACS-FACE)*DAY1
C     FACNH = 1.0+0.5*DAY2
C     FACSH = 1.0-0.5*DAY2
      FACNH = 1.0
      FACSH = 1.0
      facoron = .5*(1.+DAY2)
      facoros = .5*(1.-DAY2)
C
      KLB = 1
      KMB1 = (ZPMB1-ZSB)/dz+1.0001
      KMB2 = (ZPMB2-ZSB)/dz+1.0001
      KTURB = (ZPTP-ZSB)/dz+1.0001
      DIFK(1) = EDDYLB
!
! 12/11/00: divide by prantl as per kibo12:
      DIFT(1) = DIFK(1)/prantl
      XMUE(1) = DIFK(1)/prantl
      RAYK(1) = RAYKLB
      DO 2 K=2,KMB1
      DIFK(K) = EDDYLB*EXP(ALOG(EDDYMB1/EDDYLB)*(K-KLB)/(KMB1-KLB))
      DIFT(K) = DIFK(K)/prantl
      XMUE(K) = DIFK(K)/prantl
      RAYK(K) = RAYKLB*EXP(ALOG(RAYKMB1/RAYKLB)*(K-KLB)/(KMB1-KLB))
    2 CONTINUE
      DO 2009 K=KMB1,KMB2
      DIFK(K) = EDDYMB1*EXP(ALOG(EDDYMB2/EDDYMB1)*(K-KMB1)/(KMB2
     1          -KMB1))
      DIFT(K) = DIFK(K)/prantl
      XMUE(K) = DIFK(K)/prantl
      RAYK(K) = RAYKMB1*EXP(ALOG(RAYKMB2/RAYKMB1)*(K-KMB1)/(KMB2
     1          -KMB1))
 2009 CONTINUE
      DO 3 K=KMB2+1,KTURB
      DIFK(K) = EDDYMB2*EXP(ALOG(EDDYTP/EDDYMB2)*(K-KMB2)/(KTURB
     1          -KMB2))
      DIFT(K) = DIFK(K)/prantl
      XMUE(K) = DIFK(K)/prantl
      RAYK(K) = RAYKMB2*EXP(ALOG(RAYKTB/RAYKMB2)*(K-KMB2)/(KTURB
     1          -KMB2))
    3 CONTINUE
      DO 4 K=KTURB+1,KMAXP1
      col1(K) = ZSB+(K-1)*dz
      DIFK(K) = EDDYTP*EXP(ZPTP-col1(K))
      DIFT(K) = DIFK(K)/prantl
      XMUE(K) = DIFK(K)/prantl
    4 CONTINUE
      DO 44 K=KTURB+1,KMAX
      RAYK(K) = RAYKTB*EXP(ZPTP-col1(K))
C     RAYK(K) = RAYKTB
  44  CONTINUE
C     PRINT 998
C     DO 5 K=1,KMAX
C     RAYK(K) =(1.15E-5*ATAN(1.1*ALOG(1013./(5.E-7*expz(K)))-10.)
C    1         +1.1347E-5)
C     RAYDK = 1./(RAYK(K)*86400.)
C     RAYDMK=1./RAYDK
C     PRINT 999,K,RAYK(K),RAYDK,RAYDMK,XMUE(K),DIFK(K),DIFT(K)
C   5 CONTINUE
C 999 FORMAT(1X,I5,2X,6E12.3)
C 998 FORMAT(3X,1HK,8X,4HRAYK,8X,5HRAYDK,7X,6HRAYDMK,6X,4HXMUE,8X,
C    14HDIFK,8X,4HDIFT/)
C     ****
C     ****
C     WRITE(6,135)(K,expz(K),A(K),DIFK(K),DIFT(K),K=1,KMAX)
C 135 FORMAT(*0 K*,5X,*expz(K)*,8X,*A(K)*,5X,*DIFK(K)*,5X,*DIFT(K)*//
C    A(1H ,I2,4E12.3))
      RETURN
      END
C