trunk/dyn3d/gr_u_scal.f90


! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/gr_u_scal.F,v 1.1.1.1 2004/05/19
! 12:53:06 lmdzadmin Exp $

SUBROUTINE gr_u_scal(nx, x_u, x_scal)
  ! %W%    %G%
  ! =======================================================================

  ! Author:    Frederic Hourdin      original: 11/11/92
  ! -------

  ! Subject:
  ! ------

  ! Method:
  ! --------

  ! Interface:
  ! ----------

  ! Input:
  ! ------

  ! Output:
  ! -------

  ! =======================================================================
  USE dimensions
  USE paramet_m
  USE comgeom
  IMPLICIT NONE
  ! -----------------------------------------------------------------------
  ! Declararations:
  ! ---------------


  ! Arguments:
  ! ----------

  INTEGER nx
  REAL x_u(ip1jmp1, nx), x_scal(ip1jmp1, nx)

  ! Local:
  ! ------

  INTEGER l, ij

  ! -----------------------------------------------------------------------

  DO l = 1, nx
    DO ij = ip1jmp1, 2, -1
      x_scal(ij, l) = (aireu(ij)*x_u(ij,l)+aireu(ij-1)*x_u(ij-1,l))/ &
        (aireu(ij)+aireu(ij-1))
    END DO
  END DO

  CALL scopy(nx*jjp1, x_scal(iip1,1), iip1, x_scal(1,1), iip1)

  RETURN
END SUBROUTINE gr_u_scal
1
2	! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/gr_u_scal.F,v 1.1.1.1 2004/05/19
3	! 12:53:06 lmdzadmin Exp $
4
5	SUBROUTINE gr_u_scal(nx, x_u, x_scal)
6	! %W% %G%
7	! =======================================================================
8
9	! Author: Frederic Hourdin original: 11/11/92
10	! -------
11
12	! Subject:
13	! ------
14
15	! Method:
16	! --------
17
18	! Interface:
19	! ----------
20
21	! Input:
22	! ------
23
24	! Output:
25	! -------
26
27	! =======================================================================
28	USE dimensions
29	USE paramet_m
30	USE comgeom
31	IMPLICIT NONE
32	! -----------------------------------------------------------------------
33	! Declararations:
34	! ---------------
35
36
37	! Arguments:
38	! ----------
39
40	INTEGER nx
41	REAL x_u(ip1jmp1, nx), x_scal(ip1jmp1, nx)
42
43	! Local:
44	! ------
45
46	INTEGER l, ij
47
48	! -----------------------------------------------------------------------
49
50	DO l = 1, nx
51	DO ij = ip1jmp1, 2, -1
52	x_scal(ij, l) = (aireu(ij)x_u(ij,l)+aireu(ij-1)x_u(ij-1,l))/ &
53	(aireu(ij)+aireu(ij-1))
54	END DO
55	END DO
56
57	CALL scopy(nx*jjp1, x_scal(iip1,1), iip1, x_scal(1,1), iip1)
58
59	RETURN
60	END SUBROUTINE gr_u_scal