#include "dims.h"
      SUBROUTINE GWSOURCE(ixt)
      use cons_module,only: len1,kmax
      implicit none
C     ****
C     ****  SOURCE OF GRAVITY WAVES BASED ON OROGRAPHYS, SPECIFY
C     ****  CM0 AND CP0 FOR BOTH NORTH-SOUTH AND EAST-WEST DIRECTIONS
C     ****
#include "params.h"
#include "fgcom.h"
#include "index.h"
#include "buff.h"
#include "phys.h"
#include "grvws.h"
#include "grvscr.h"
      real :: orog,sghdat
      common/dat/ orog(73,36),sghdat(73,36)
      real :: raykk
      COMMON/GRTRAN/RAYKK(ZJMX,ZKMX)
      real :: rayk
      COMMON/RAYFRIC/RAYK(ZKMX) ! set by backgrnd
!
! Args:
      integer,intent(in) :: ixt
!
! Local:
      integer :: i,k,nzk
      real :: RAYKB(ZKMX),RAYKCCM(ZKMX),ABLAT(ZJMX)
C
C *****  GARCIA TYPE ANALYTIC GWSOURCE LATITUDE DISTRIBUTION
!     DATA RAYKSH,RAYKNH/1.0,1.0/
      real,parameter :: rayksh=1.0, rayknh=1.0
C     ****
C     ****  CALCULATE GRAVITY WAVE PARAMETER RANGE IN PRESSURE CORD.
C     ****
C ****   RAYLEIGH FRICTION FROM CCM2 SPECIFICATION
      real,parameter :: RAYKRED = 0.
! added -1 to NZK as per modsrc.kibo:
      nzk = nz
      DO 5 K=1,KMAX
        NZK = NZK+1
!
! 11/00: reference fg(..nzk..) rather than f-array. Not sure about
!        latitude index. Raykk is referenced in duv.
!
!       RAYKCCM(K)=1.0/1.5*(1.+TANH((F(36,NZK)-75.0E+5)/9.0E+5))
!    1           /86400.*RAYKRED
        RAYKCCM(K)=1.0/1.5*(1.+TANH((fg(36,nzk,0,ixt)-75.0E+5)/
     |    9.0E+5))/86400.*RAYKRED
        RAYKB(K) = RAYK(K)+RAYKCCM(K)
  5   CONTINUE
      DO 6 J=1,ZJMX
C     ABLAT(J) = ABS(2.*SN(J)*CS(J))
      ABLAT(J) = 1.
      DO 7 K=1,KMAX
      IF (J.GT.18) GO TO 512
      RAYKK(J,K) = RAYKB(K)*RAYKSH*ABLAT(J)
      GO TO 7
  512 CONTINUE
      RAYKK(J,K) = RAYKB(K)*RAYKNH*ABLAT(J)
   7  CONTINUE
   6  CONTINUE
C
C     ****
C     ****   DIURNAL VARIATION FUNCTION FOR GRAVITY WAVE SOURCE
C     ****
C
C     UTH = AMOD(FLOAT(ITER)*C(4),86400.)/3600.
C     DO 1 I=3,LEN1-2
C
C     FLT(I) = 1.
C
C     XLTH(I) = UTH+(-180.+(I-3)*5.)/15.
C     FLT(I) = 3.1+3.*SIN((XLTH(I)-6.)*C(110)/12.)
C
C  1  CONTINUE
C
      RETURN
      END
C