trunk/dyn3d/grid_change.f

module grid_change

  use dimens_m, only: iim, jjm

  IMPLICIT NONE

  logical, save:: dyn_phy(iim + 1, jjm + 1)
  ! (mask for distinct points in the scalar grid and the "u" grid,
  ! first index is for longitude, second index is for latitude)

  private iim, jjm

contains

  subroutine init_dyn_phy

    ! Construct the mask:
    dyn_phy = .true.
    dyn_phy(2:, 1) = .false.
    dyn_phy(2:, jjm + 1) = .false.
    dyn_phy(iim + 1, 2:jjm) = .false.
    ! Note that "count(dyn_phy)" equals "klon"

  end subroutine init_dyn_phy

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

  function gr_fi_dyn(pfi)

    ! From gr_fi_dyn.F, version 1.1.1.1 2004/05/19 12:53:05
    ! Passage d'un champ de la grille physique \`a la grille dynamique

    use dimphy, only: klon

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

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

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

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

    ! Traitement des p\^oles :
    field(2:, 1) = pfi(1)
    field(2:, jjm + 1) = pfi(klon)
    ! (We leave undefined elements in "field")

    gr_fi_dyn = unpack(pfi, dyn_phy, field)
    ! Undefined elements at last longitude in "gr_fi_dyn" come from
    ! undefined elements in "field".
    ! Overwrite them now, knowing that last longitude equals first longitude:
    gr_fi_dyn(iim + 1, 2:jjm) = gr_fi_dyn(1, 2:jjm)

  END function gr_fi_dyn

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

  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 dimphy, only: klon

    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_dyn_phy(v)

    ! Passage d'un champ 3D de la grille dynamique \`a la grille physique

    use dimphy, only: klon

    REAL, intent(in):: v(:, :, :) ! (iim + 1, jjm + 1, :)
    real gr_dyn_phy(klon, size(v, 3))

    ! Local:
    integer k

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

    forall (k = 1:size(v, 3)) gr_dyn_phy(:, k) = pack(v(:, :, k), dyn_phy)

  END function gr_dyn_phy

end module grid_change
1	guez	3	module grid_change
2
3			use dimens_m, only: iim, jjm
4
5			IMPLICIT NONE
6
7			logical, save:: dyn_phy(iim + 1, jjm + 1)
8			! (mask for distinct points in the scalar grid and the "u" grid,
9			! first index is for longitude, second index is for latitude)
10
11			private iim, jjm
12
13			contains
14
15			subroutine init_dyn_phy
16
17			! Construct the mask:
18			dyn_phy = .true.
19			dyn_phy(2:, 1) = .false.
20			dyn_phy(2:, jjm + 1) = .false.
21			dyn_phy(iim + 1, 2:jjm) = .false.
22			! Note that "count(dyn_phy)" equals "klon"
23
24			end subroutine init_dyn_phy
25
26			!********************************************
27
28			function gr_fi_dyn(pfi)
29
30			! From gr_fi_dyn.F, version 1.1.1.1 2004/05/19 12:53:05
31	guez	168	! Passage d'un champ de la grille physique \`a la grille dynamique
32	guez	3
33			use dimphy, only: klon
34
35	guez	47	REAL, intent(in):: pfi(:) ! (klon)
36	guez	3	real gr_fi_dyn(iim + 1, jjm + 1)
37
38			! Variable local to the procedure:
39			real field(iim + 1, jjm + 1)
40
41			!-----------------------------------------------------------------------
42
43			if (size(pfi) /= klon) stop "gr_fi_dyn"
44
45	guez	168	! Traitement des p\^oles :
46	guez	3	field(2:, 1) = pfi(1)
47			field(2:, jjm + 1) = pfi(klon)
48			! (We leave undefined elements in "field")
49
50			gr_fi_dyn = unpack(pfi, dyn_phy, field)
51			! Undefined elements at last longitude in "gr_fi_dyn" come from
52			! undefined elements in "field".
53			! Overwrite them now, knowing that last longitude equals first longitude:
54			gr_fi_dyn(iim + 1, 2:jjm) = gr_fi_dyn(1, 2:jjm)
55
56			END function gr_fi_dyn
57
58			!********************************************
59
60	guez	15	function gr_phy_write_2d(pfi)
61	guez	3
62			! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
63	guez	168	! Transforme une variable de la grille physique \`a la grille d'\'ecriture.
64	guez	3	! The grid for output files does not duplicate the first longitude
65			! in the last longitude.
66
67			use dimphy, only: klon
68
69	guez	168	REAL, intent(in):: pfi(:) ! (klon)
70	guez	15	real gr_phy_write_2d(iim, jjm + 1)
71	guez	3
72			! Variable local to the procedure:
73			real field(iim, jjm + 1)
74
75			!-----------------------------------------------------------------------
76
77	guez	15	if (size(pfi) /= klon) stop "gr_phy_write_2d"
78	guez	3
79	guez	168	! Traitement des p\^oles :
80	guez	3	field(2:, 1) = pfi(1)
81			field(2:, jjm + 1) = pfi(klon)
82
83	guez	15	gr_phy_write_2d = unpack(pfi, dyn_phy(:iim, :), field)
84	guez	3
85	guez	15	END function gr_phy_write_2d
86	guez	3
87	guez	168	!********************************************
88
89			function gr_dyn_phy(v)
90
91			! Passage d'un champ 3D de la grille dynamique \`a la grille physique
92
93			use dimphy, only: klon
94
95			REAL, intent(in):: v(:, :, :) ! (iim + 1, jjm + 1, :)
96			real gr_dyn_phy(klon, size(v, 3))
97
98			! Local:
99			integer k
100
101			!-----------------------------------------------------------------------
102
103			forall (k = 1:size(v, 3)) gr_dyn_phy(:, k) = pack(v(:, :, k), dyn_phy)
104
105			END function gr_dyn_phy
106
107	guez	3	end module grid_change