trunk/phylmd/gr_phy_write.f

module gr_phy_write_m

  use dimensions, only: iim, jjm
  use dimphy, only: klon

  IMPLICIT none

  interface gr_phy_write
     module procedure gr_phy_write_2d, gr_phy_write_3d
  end interface gr_phy_write

  private
  public gr_phy_write

contains

  function gr_phy_write_2d(pfi)

    ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
    ! Transforme une variable de la grille physique \`a la grille d'\'ecriture.
    ! The grid for output files does not duplicate the first longitude
    ! in the last longitude.

    use grid_change, only: dyn_phy

    REAL, intent(in):: pfi(:) ! (klon)
    real gr_phy_write_2d(iim, jjm + 1)

    ! Variable local to the procedure:
    real field(iim, jjm + 1)

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

    if (size(pfi) /= klon) stop "gr_phy_write_2d"

    ! Traitement des p\^oles :
    field(2:, 1) = pfi(1)
    field(2:, jjm + 1) = pfi(klon)

    gr_phy_write_2d = unpack(pfi, dyn_phy(:iim, :), field)

  END function gr_phy_write_2d

  !********************************************

  function gr_phy_write_3d(fi)

    ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28

    ! Transforme une variable tri-dimensionnelle de la grille physique
    ! \`a la grille d'\'ecriture. The grid for output files does not
    ! duplicate the first longitude in the last longitude. Input array
    ! has rank 2. Horizontal index is in the first dimension.

    use nr_util, only: assert

    REAL, intent(in):: fi(:, :) ! (klon, :)
    real gr_phy_write_3d(iim, jjm + 1, size(fi, 2))

    ! Local:
    INTEGER l

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

    call assert(size(fi, 1) == klon, "gr_phy_write_3d")

    DO l = 1, size(fi, 2)
       gr_phy_write_3d(:, :, l) = gr_phy_write_2d(fi(:, l))
    END DO

  END function gr_phy_write_3d

end module gr_phy_write_m
1	guez	189	module gr_phy_write_m
2	guez	3
3	guez	265	use dimensions, only: iim, jjm
4	guez	189	use dimphy, only: klon
5
6	guez	3	IMPLICIT none
7
8	guez	189	interface gr_phy_write
9			module procedure gr_phy_write_2d, gr_phy_write_3d
10			end interface gr_phy_write
11
12			private
13			public gr_phy_write
14
15	guez	186	contains
16	guez	3
17	guez	189	function gr_phy_write_2d(pfi)
18	guez	3
19	guez	186	! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
20	guez	189	! Transforme une variable de la grille physique \`a la grille d'\'ecriture.
21			! The grid for output files does not duplicate the first longitude
22			! in the last longitude.
23	guez	3
24	guez	189	use grid_change, only: dyn_phy
25	guez	3
26	guez	189	REAL, intent(in):: pfi(:) ! (klon)
27			real gr_phy_write_2d(iim, jjm + 1)
28	guez	3
29	guez	189	! Variable local to the procedure:
30			real field(iim, jjm + 1)
31	guez	3
32	guez	189	!-----------------------------------------------------------------------
33	guez	186
34	guez	189	if (size(pfi) /= klon) stop "gr_phy_write_2d"
35
36			! Traitement des p\^oles :
37			field(2:, 1) = pfi(1)
38			field(2:, jjm + 1) = pfi(klon)
39
40			gr_phy_write_2d = unpack(pfi, dyn_phy(:iim, :), field)
41
42			END function gr_phy_write_2d
43
44			!********************************************
45
46			function gr_phy_write_3d(fi)
47
48			! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
49
50			! Transforme une variable tri-dimensionnelle de la grille physique
51			! \`a la grille d'\'ecriture. The grid for output files does not
52			! duplicate the first longitude in the last longitude. Input array
53			! has rank 2. Horizontal index is in the first dimension.
54
55			use nr_util, only: assert
56
57			REAL, intent(in):: fi(:, :) ! (klon, :)
58			real gr_phy_write_3d(iim, jjm + 1, size(fi, 2))
59
60			! Local:
61			INTEGER l
62
63	guez	186	!---------------
64
65	guez	189	call assert(size(fi, 1) == klon, "gr_phy_write_3d")
66	guez	186
67	guez	189	DO l = 1, size(fi, 2)
68			gr_phy_write_3d(:, :, l) = gr_phy_write_2d(fi(:, l))
69			END DO
70	guez	186
71	guez	189	END function gr_phy_write_3d
72
73			end module gr_phy_write_m