*=*=*=*= inifilr.html =*=*=*=*
SUBROUTINE inifilr

SUBROUTINE inifilr


      SUBROUTINE inifilr
c
c    ... H. Upadhyaya, O.Sharma   ...
c
      IMPLICIT NONE
c
c     version 2 .....

c  -------------------------------------------------------------------
#include "dimensions.h"
#include "paramet.h"
c  -------------------------------------------------------------------
#include "comgeom.h"
#include "coefils.h"
#include "serre.h"

      REAL  dlonu(iim),dlatu(jjm)
      REAL  rlamda( iim ),  eignvl( iim )
c

      REAL      lamdamax,pi,cof
      INTEGER i,j,modemax,imx,k,kf
      INTEGER iymin,ixmineq,ISMIN
      REAL dymin,dxmin,colat0,pi_flt,AMIN1
      EXTERNAL  ISMIN
      EXTERNAL  inifgn
c
c ------------------------------------------------------------
c   This routine computes the eigenfunctions of the laplacien
c   on the stretched grid, and the filtering coefficients
c
c  We designate:
c   eignfn   eigenfunctions of the discrete laplacien
c   eigenvl  eigenvalues
c   jfiltn   indexof the last scalar line filtered in NH
c   jfilts   index of the first line filtered in SH
c   modfrst  index of the mode from where modes are filtered
c   modemax  maximum number of modes ( im )
c   coefil   filtering coefficients ( lamda_max*cos(rlat)/lamda )
c   sdd      SQRT( dx )
c
c     the modes are filtered from modfrst to modemax
c
c-----------------------------------------------------------
c
#include "fxyprim.h"

       pi       = 2. * ASIN( 1. )

       DO i=1,iim
 	      dlonu(i)=fxprim( FLOAT(i)+0.5 )
       ENDDO
c
       CALL inifgn(eignvl)
c
        PRINT *,'eigenvl ....',eignvl
c
c compute eigenvalues and eigenfunctions
c
c
c.................................................................
c
c  compute the filtering coefficients for scalar lines and
c  meridional wind v-lines
c
c  we filter all those latitude lines where coefil < 1
c  NO FILTERING AT POLES
c
c  colat0 is to be used  when alpha (stretching coefficient)
c  is set equal to zero for the regular grid case
c
c    .......   Calcul  de  colat0   .........
c     .....  colat0 = minimum de ( 0.5, min dy/ min dx )   ...
c
c
      DO 45 j = 1,jjm
         dlatu( j ) = rlatu( j ) - rlatu( j+1 )
 45   CONTINUE
c
      iymin   = ISMIN( jjm, dlatu, 1 )
      ixmineq = ISMIN( iim, dlonu, 1 )
      dymin   = dlatu( iymin )
      dxmin   = dlonu( ixmineq )
c
c    ... P.Le Van , 8/11/94 ..
c
      colat0  =  AMIN1( 0.5, dymin/dxmin )
c
      PRINT 50, colat0
  50  FORMAT(/15x'colat0'e16.7)
c
      IF( alphax.EQ. 0.) THEN
             lamdamax = iim / (pi * colat0)
      ELSE
         lamdamax = iim / (pi * alphax)
      ENDIF
c
      DO 71 i = 2,iim
      rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) )
 71   CONTINUE
c

      DO 72 j = 1,jjm
          DO 73 i = 1,iim
          coefilu( i,j )  = 0.0
          coefilv( i,j )  = 0.0
          coefilu2( i,j ) = 0.0
          coefilv2( i,j ) = 0.0
 73     CONTINUE
 72   CONTINUE

c
c    ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv ....
c    .........................................................
c
       modemax = iim

       imx = modemax - 4 * (modemax/iim)
       PRINT *,' TRUNCATION AT ',imx
c
      DO 75 j = 2, jjm/2+1
       cof = COS( rlatu(j) )/ colat0
          IF ( cof .LT. 1. ) THEN
          IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j
        ENDIF

       cof = COS( rlatu(jjp1-j+1) )/ colat0
          IF ( cof .LT. 1. ) THEN
          IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. )
     $      jfiltsu= jjp1-j+1
        ENDIF
 75   CONTINUE
c
      DO 76 j = 1, jjm/2
       cof = COS( rlatv(j) )/ colat0
          IF ( cof .LT. 1. ) THEN
          IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j
        ENDIF

       cof = COS( rlatv(jjm-j+1) )/ colat0
          IF ( cof .LT. 1. ) THEN
          IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. )
     $       jfiltsv= jjm-j+1
        ENDIF
 76   CONTINUE
c
c
c   ... Determination de coefilu,coefilv,n=modfrstu,modfrstv ....
c................................................................
c
c
      DO 77 j = 1,jjm
        modfrstu( j ) = iim
        modfrstv( j ) = iim
 77   CONTINUE
c
      DO 84 j = 2,jfiltnu
       DO 81 k = 2,modemax
           cof = rlamda(k) * COS( rlatu(j) )
         IF ( cof .LT. 1. ) GOTO 82
 81    CONTINUE
      GOTO 84
 82   modfrstu( j ) = k
c
        kf = modfrstu( j )
         DO 83 k = kf , modemax
        cof = rlamda(k) * COS( rlatu(j) )
          coefilu(k,j) = cof - 1.
          coefilu2(k,j) = cof*cof - 1.
 83    CONTINUE
 84   CONTINUE
c
c
      DO 89 j = 1,jfiltnv
c
       DO 86 k = 2,modemax
          cof = rlamda(k) * COS( rlatv(j) )
         IF ( cof .LT. 1. ) GOTO 87
 86    CONTINUE
      GOTO 89
 87   modfrstv( j ) = k
c
         kf = modfrstv( j )
         DO 88 k = kf , modemax
        cof = rlamda(k) * COS( rlatv(j) )
          coefilv(k,j) = cof - 1.
          coefilv2(k,j) = cof*cof - 1.
 88    CONTINUE
c
 89    CONTINUE
c
      DO 94 j = jfiltsu,jjm
       DO 91 k = 2,modemax
          cof = rlamda(k) * COS( rlatu(j) )
         IF ( cof .LT. 1. ) GOTO 92
 91    CONTINUE
      GOTO 94
 92   modfrstu( j ) = k
c
         kf = modfrstu( j )
          DO 93 k = kf , modemax
         cof = rlamda(k) * COS( rlatu(j) )
           coefilu(k,j) = cof - 1.
           coefilu2(k,j) = cof*cof - 1.
 93     CONTINUE
 94    CONTINUE
c
      DO 99 j = jfiltsv,jjm
       DO 96 k = 2,modemax
           cof = rlamda(k) * COS( rlatv(j) )
         IF ( cof .LT. 1. ) GOTO 97
 96    CONTINUE
      GOTO 99
 97   modfrstv( j ) = k
c
       kf = modfrstv( j )
         DO 98 k = kf , modemax
        cof = rlamda(k) * COS( rlatv(j) )
          coefilv(k,j) = cof - 1.
          coefilv2(k,j) = cof*cof - 1.
 98    CONTINUE
 99   CONTINUE
c
       PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
     *         jfiltnv,jfiltsv,jfiltnu,jfiltsu

       IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN

         IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv
         IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu

          PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' ,
     *        jfiltnv,jfiltsv,jfiltnu,jfiltsu
       ENDIF

       PRINT *,'   Modes premiers  v  '
       PRINT 334,modfrstv
       PRINT *,'   Modes premiers  u  '
       PRINT 334,modfrstu
334    FORMAT(1x,24i3)
c
       RETURN
       END