source: LMDZ6/trunk/libf/filtrez/inifgn.F90 @ 5246

!
! $Header: /home/cvsroot/LMDZ4/libf/filtrez/inifgn.F,v 1.1.1.1 2004-05-19 12:53:09 lmdzadmin Exp $
!
SUBROUTINE inifgn(dv)
  !
  !    ...  H.Upadyaya , O.Sharma  ...
  !
  IMPLICIT NONE
  !
  include "dimensions.h"
  include "paramet.h"
  include "comgeom.h"

  !
  REAL :: vec(iim,iim),vec1(iim,iim)
  REAL :: dlonu(iim),dlonv(iim)
  REAL :: du(iim),dv(iim),d(iim)
  REAL :: pi
  INTEGER :: i,j,k,imm1,nrot
  !
  include "coefils.h"
  !
  EXTERNAL SSUM, acc,eigen,jacobi
  REAL :: SSUM
  !

  imm1  = iim -1
  pi = 2.* ASIN(1.)
  !
  DO i=1,iim
   dlonu(i)=  xprimu( i )
   dlonv(i)=  xprimv( i )
  END DO

  DO i=1,iim
  sddv(i)   = SQRT(dlonv(i))
  sddu(i)   = SQRT(dlonu(i))
  unsddu(i) = 1./sddu(i)
  unsddv(i) = 1./sddv(i)
  END DO
  !
  DO j=1,iim
  DO i=1,iim
  vec(i,j)     = 0.
  vec1(i,j)    = 0.
  eignfnv(i,j) = 0.
  eignfnu(i,j) = 0.
  END DO
  END DO
  !
  !
  eignfnv(1,1)    = -1.
  eignfnv(iim,1)  =  1.
  DO i=1,imm1
  eignfnv(i+1,i+1)= -1.
  eignfnv(i,i+1)  =  1.
  END DO
  DO j=1,iim
  DO i=1,iim
  eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
  END DO
  END DO
  DO j=1,iim
  DO i=1,iim
  eignfnu(i,j) = -eignfnv(j,i)
  END DO
  END DO
  !
#ifdef CRAY
  CALL MXM(eignfnu,iim,eignfnv,iim,vec ,iim)
  CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
#else
  DO j = 1, iim
  DO i = 1, iim
    vec (i,j) = 0.0
    vec1(i,j) = 0.0
   DO k = 1, iim
    vec (i,j) = vec(i,j)  + eignfnu(i,k) * eignfnv(k,j)
    vec1(i,j) = vec1(i,j) + eignfnv(i,k) * eignfnu(k,j)
   ENDDO
  ENDDO
  ENDDO
#endif

  !
  CALL jacobi(vec,iim,iim,dv,eignfnv,nrot)
  CALL acc(eignfnv,d,iim)
  CALL eigen_sort(dv,eignfnv,iim,iim)
  !
  CALL jacobi(vec1,iim,iim,du,eignfnu,nrot)
  CALL acc(eignfnu,d,iim)
  CALL eigen_sort(du,eignfnu,iim,iim)

  !c   ancienne version avec appels IMSL
  !
  ! CALL MXM(eignfnu,iim,eignfnv,iim,vec,iim)
  ! CALL MXM(eignfnv,iim,eignfnu,iim,vec1,iim)
  !     CALL EVCSF(iim,vec,iim,dv,eignfnv,iim)
  ! CALL acc(eignfnv,d,iim)
  ! CALL eigen(eignfnv,dv)
  !
  ! CALL EVCSF(iim,vec1,iim,du,eignfnu,iim)
  ! CALL acc(eignfnu,d,iim)
  ! CALL eigen(eignfnu,du)

  RETURN
END SUBROUTINE inifgn