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	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