var/convertor/kma_wave2grid/GAUSS.inc

   1 *** COPIED FROM 'A0568.NEW.FORT(GAUSS)' ON 1989.10.1
   2       SUBROUTINE GAUSS(A,W,K)
   3 C
   4 C  A; COSINE OF COLATITUDE
   5 C  W; GAUSSIAN WEIGHT
   6 C  K; ORDER OF LEGENDRE FUNCTIONS
   7 C
   8       IMPLICIT REAL*8(A-H,O-Z)
   9 C
  10       DIMENSION A(K),W(K)
  11 C
  12       ESP=1.E-14
  13       C=(1.E0-(2.E0/3.14159265358979E0)**2)*0.25E0
  14       FK=K
  15       KK=K/2
  16       CALL BSSLZ1(A,KK)
  17       DO 30 IS=1,KK
  18       XZ=COS(A(IS)/SQRT((FK+0.5E0)**2+C))
  19       ITER=0
  20    10 PKM2=1.0
  21       PKM1=XZ
  22       ITER=ITER+1
  23       IF(ITER.GT.10) GO TO 70
  24       DO 20 N=2,K
  25       FN=N
  26       PK=((2.E0*FN-1.E0)*XZ*PKM1-(FN-1.0)*PKM2)/FN
  27       PKM2=PKM1
  28    20 PKM1=PK
  29       PKM1=PKM2
  30       PKMRK=(FK*(PKM1-XZ*PK))/(1.E0-XZ**2)
  31       SP=PK/PKMRK
  32       XZ=XZ-SP
  33       AVSP=ABS(SP)
  34       IF(AVSP.GT.ESP) GO TO 10
  35       A(IS)=XZ
  36       W(IS)=(2.E0*(1.E0-XZ**2))/(FK*PKM1)**2
  37    30 CONTINUE
  38       IF(K.EQ.KK*2) GO TO 50
  39       A(KK+1)=0.E0
  40       PK=2.E0/FK**2
  41       DO 40 N=2,K,2
  42       FN=N
  43    40 PK=PK*FN**2/(FN-1.E0)**2
  44       W(KK+1)=PK
  45    50 CONTINUE
  46       DO 60 N=1,KK
  47       L=K+1-N
  48       A(L)=-A(N)
  49    60 W(L)=W(N)
  50       RETURN
  51    70 WRITE(96,6000)
  52  6000 FORMAT(//5X,14HERROR IN GAUAW//)
  53 C
  54       STOP
  55       END SUBROUTINE GAUSS
  56