      SUBROUTINE HDIFUS6 (P,C,T,ES,X,LA,ILEV,LEVS,
     1                    LM,MINDEX,LMTOTAL,LSR,
     2                    DT,KTR,S,SH,ITRAC,NTRAC,
     3                    DISP,DISC,DIST,DISES,DISX,SCRIT,
     4                    KFIRST,KLAST,NFIRST)

C     * JAN 12/07 - M.LAZARE/     NEW VERSION FOR GCM15F:
C     *             C.MCLANDRESS. CORRECT LAPLACIAN DIFFUSION
C     *                           WITH ADDITIONAL OPTION FOR
C     *                           "DEL4" LAPLACIAN.       
C     * DEC 15/03 - M.LAZARE. PREVIOUS VERSION HDIFUS5X FOR
C     *                       GCM15C/D/E.
C     *
C     * PERFORMS DISSIPATION ON GLOBAL SPECTRAL FIELDS IN THE GCM.
C     * ON VORTICITY (P), DIVERGENCE (C), TEMPERATURE (T),
C     * AND MOISTURE VARIABLE (ES).
C     * ALSO TRACER (X), WHEN ITRAC.GT.0.
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)

      INTEGER LSR(2,LM+1)
      INTEGER KFIRST(LM)
      INTEGER KLAST(LM)
      INTEGER NFIRST(LM)
      INTEGER MINDEX(LM)
C
      REAL S(ILEV),SH(ILEV)
C
      COMPLEX P(LA,ILEV),C(LA,ILEV),T(LA,ILEV),ES(LA,LEVS)
      COMPLEX X(LA,ILEV,NTRAC)
C
      FS(SSS,A,SC)=MAX(1., 1.+(A-1.)*(SC-SSS)/SC) **2
C
C     * "IDEL4" CONTROLS WHETHER LAPLACIAN (IDEL4=0) OR "DEL4"
C     * DIFFUSION IS APPLIED.
C
      DATA IDEL4 /0/
C---------------------------------------------------------------------
      AMP=SQRT(3.)
      FR=REAL(LMTOTAL-1)
      IF(KTR.EQ.2) FR=FR/SQRT(2.)
      FNSTAR=SQRT(2.)*FR
      NSMIN=INT(.55*FNSTAR+.5)
C
C     * COMPUTATION OF THE VECTOR INDICES OF THE COEF. TO BE DISSIPATED.
C     * KFIRST(M) CONTAINS THE INDICE OF FIRST (OR  LEFT) COEF. FOR A M.
C     * KLAST(M)  CONTAINS THE INDICE OF LAST  (OR RIGHT) COEF. FOR A M.
C
      DO 100 M=1,LM
         KL=LSR(1,M)
         KR=LSR(1,M+1)-1
         MS=MINDEX(M)-1
         KLAST(M)=KR
         DO 50 K=KL,KR
            NFIRST(M)=MS+(K-KL)
            KFIRST(M)=K
C
C           * WHEN .TRUE. NFIRST(M) WILL LEAVE THE LOOP WITH THE
C           * WAVENUMBER N OF THE FIRST COEF. TO BE DISSIPATED.
C           * KFIRST(M) IS THE VECTOR INDEX OF THAT COEF.
C
            IF(NFIRST(M).GE.NSMIN) GOTO 100
   50    CONTINUE
  100 CONTINUE
C
C     ***  DISSIPATION ON P,C, AND T.
C
      DO 220 L=1,ILEV
         DSP=DISP*FS(S(L),AMP,SCRIT)
         DSC=DISC*FS(S(L),AMP,SCRIT)
         DST=DIST*FS(SH(L),AMP,SCRIT)
         DO 210 M=1,LM
            ICOUNT=0
            DO 200 K=KFIRST(M),KLAST(M)
               FNS=REAL(NFIRST(M) + ICOUNT)
               FACT=2.*DT*4*(FNS/FNSTAR-.55)**2
               ICOUNT=ICOUNT+1
               P(K,L)=P(K,L)/(1.+DSP*FACT)
               C(K,L)=C(K,L)/(1.+DSC*FACT)
               T(K,L)=T(K,L)/(1.+DST*FACT)
  200       CONTINUE
  210   CONTINUE
  220 CONTINUE
C
C     ***  DISSIPATION ON TRACERS
C
      IF(ITRAC.GT.0) THEN
         DO 330 N=1,NTRAC
            DO 320 L=1,ILEV
               DSX=DISX*FS(SH(L),AMP,SCRIT)
               DO 310 M=1,LM
                  ICOUNT=0
                  DO 300 K=KFIRST(M),KLAST(M)
                     FNS=REAL(NFIRST(M) + ICOUNT)
                     IF (IDEL4.EQ.1) THEN 
                        FACT=2.*DT*(FNS*(FNS+1.))**2
                     ELSE
                        FACT=2.*DT*FNS*(FNS+1.)
                     ENDIF
                     ICOUNT=ICOUNT+1
                     X(K,L,N)=X(K,L,N)/(1.+DSX*FACT)
  300             CONTINUE  
  310          CONTINUE
  320       CONTINUE
  330    CONTINUE
      ENDIF
C
C     ***  DISSIPATION ON MOISTURE.
C
      IF(LEVS.GT.0) THEN
          DO 420 L=1,LEVS
             DES=DISES*FS(SH(L+ILEV-LEVS),AMP,SCRIT)
             DO 410 M=1,LM
                ICOUNT=0
                DO 400 K=KFIRST(M),KLAST(M)
                   FNS=REAL(NFIRST(M) + ICOUNT)
                   IF (IDEL4.EQ.1) THEN 
                     FACT=2.*DT*(FNS*(FNS+1.))**2
                   ELSE
                     FACT=2.*DT*FNS*(FNS+1.)
                   ENDIF
                   ICOUNT=ICOUNT+1
                   ES(K,L)=ES(K,L)/(1.+DES*FACT)
  400           CONTINUE
  410        CONTINUE
  420     CONTINUE
      ENDIF 
      RETURN
C-----------------------------------------------------------------------
      END
