Sources/phylmd/gr_phy_write.f

SUBROUTINE gr_fi_ecrit(nfield, nlon, iim, jjmp1, fi, ecrit)

  ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
  ! This procedure is clean: no C preprocessor directive, no include line.

  IMPLICIT none

  ! Transforme une variable de la grille physique à la grille d'écriture.
  ! Cf. version moderne "gr_phy_write", dans le cas où "nfield" vaut 1.

  INTEGER, intent(in):: nfield, nlon, iim, jjmp1
  REAL, intent(in):: fi(nlon, nfield)
  real ecrit(iim*jjmp1, nfield)

  ! Variables local to the procedure:

  integer jjm
  INTEGER i, n, ig

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

  jjm = jjmp1 - 1
  DO n = 1, nfield
     DO i=1, iim
        ecrit(i, n) = fi(1, n)
        ecrit(i+jjm*iim, n) = fi(nlon, n)
     ENDDO
     DO ig = 1, nlon - 2
        ecrit(iim+ig, n) = fi(1+ig, n)
     ENDDO
  ENDDO

END SUBROUTINE gr_fi_ecrit
1	guez	3	SUBROUTINE gr_fi_ecrit(nfield, nlon, iim, jjmp1, fi, ecrit)
2
3			! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28
4			! This procedure is clean: no C preprocessor directive, no include line.
5
6			IMPLICIT none
7
8			! Transforme une variable de la grille physique à la grille d'écriture.
9			! Cf. version moderne "gr_phy_write", dans le cas où "nfield" vaut 1.
10
11			INTEGER, intent(in):: nfield, nlon, iim, jjmp1
12			REAL, intent(in):: fi(nlon, nfield)
13			real ecrit(iim*jjmp1, nfield)
14
15			! Variables local to the procedure:
16
17			integer jjm
18			INTEGER i, n, ig
19
20			!---------------
21
22			jjm = jjmp1 - 1
23			DO n = 1, nfield
24			DO i=1, iim
25			ecrit(i, n) = fi(1, n)
26			ecrit(i+jjm*iim, n) = fi(nlon, n)
27			ENDDO
28			DO ig = 1, nlon - 2
29			ecrit(iim+ig, n) = fi(1+ig, n)
30			ENDDO
31			ENDDO
32
33			END SUBROUTINE gr_fi_ecrit