*=*=*=*= inifilr_old.html =*=*=*=*
SUBROUTINE inifilr_old

SUBROUTINE inifilr_old


      SUBROUTINE inifilr_old
      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)
      real rlamda( iim ),  eignvl( iim )
c

      REAL      lamdamax,pi,cof,colat0
      integer imm1,im2,i,j,modemax,imx,k,kf
      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"

      imm1     = iim - 1
      im2      = 2. * iim
      pi       = 2. * ASIN( 1. )

       do i=1,iim
      	dlonu(i)=fxprim(float(i)+0.5)
      	ENDDO
        CALL inifgn(eignvl)
          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 dy/ min.de dx a l'equateur  ...
c
      colat0 = 0.5
      PRINT 50, colat0
  50  FORMAT(/15x'WARNING!!!! colat0 impose: 'e16.7)
c
      lamdamax = iim / (pi * colat0)
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
         modemax = iim

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


c
       cof = rlamda(imx) * COS( rlatv(j) )
c       print *,' ....j cofv ..',cof,j,rlatv(j)
       IF ( cof .LT. 1 ) THEN
            jfiltnv = j
         ENDIF
c
       cof = rlamda(imx) * COS( rlatu(jjp1-j+1) )
       IF ( cof .LT. 1 ) THEN
            jfiltsu = jjp1-j+1
         ENDIF
c
       cof = rlamda(imx) * COS( rlatv(jjp1-j+1) )
       IF ( cof .LT. 1 ) THEN
            jfiltsv = jjp1-j+1
         ENDIF
c
 75   CONTINUE
c
      DO 77 j = 1,jjm
       modfrstu( j ) = iim
       modfrstv( j ) = iim
 77   CONTINUE
c.............................................................
c
      DO 80 j = 2,jfiltnu
      DO 81 k = 2,modemax
          cof = rlamda(k) * COS( rlatu(j) )
         IF ( cof .LT. 1 ) GOTO 82
 81      CONTINUE
      GOTO 80
 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
 80    CONTINUE
c
      DO 85 j = 1,jfiltnv
      DO 86 k = 2,modemax
          cof = rlamda(k) * COS( rlatv(j) )
         IF ( cof .LT. 1 ) GOTO 87
 86      CONTINUE
      GOTO 85
 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
 85    CONTINUE
c
      DO 90 j = jfiltsu,jjm
      DO 91 k = 2,modemax
          cof = rlamda(k) * COS( rlatu(j) )
         IF ( cof .LT. 1 ) GOTO 92
 91      CONTINUE
      GOTO 90
 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
 90    CONTINUE
c
      DO 95 j = jfiltsv,jjm
      DO 96 k = 2,modemax
          cof = rlamda(k) * COS( rlatv(j) )
         IF ( cof .LT. 1 ) GOTO 97
 96      CONTINUE
      GOTO 95
 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
 95    CONTINUE
             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
c