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	module gr_phy_write_m
2
3	use dimensions, only: iim, jjm
4	use dimphy, only: klon
5
6	IMPLICIT none
7
8	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	contains
16
17	function gr_phy_write_2d(pfi)
18
19	! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
20	! 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
24	use grid_change, only: dyn_phy
25
26	REAL, intent(in):: pfi(:) ! (klon)
27	real gr_phy_write_2d(iim, jjm + 1)
28
29	! Variable local to the procedure:
30	real field(iim, jjm + 1)
31
32	!-----------------------------------------------------------------------
33
34	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	!---------------
64
65	call assert(size(fi, 1) == klon, "gr_phy_write_3d")
66
67	DO l = 1, size(fi, 2)
68	gr_phy_write_3d(:, :, l) = gr_phy_write_2d(fi(:, l))
69	END DO
70
71	END function gr_phy_write_3d
72
73	end module gr_phy_write_m