libf/phylmd/gr_fi_ecrit.f90

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

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

  IMPLICIT none

  ! Transforme une variable de la grille physique à la grille d'écriture.
  ! Cf. version moderne "gr_phy_write_2d", 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
5	IMPLICIT none
6
7	! Transforme une variable de la grille physique à la grille d'écriture.
8	! Cf. version moderne "gr_phy_write_2d", dans le cas où "nfield" vaut 1.
9
10	INTEGER, intent(in):: nfield, nlon, iim, jjmp1
11	REAL, intent(in):: fi(nlon, nfield)
12	real ecrit(iim*jjmp1, nfield)
13
14	! Variables local to the procedure:
15
16	integer jjm
17	INTEGER i, n, ig
18
19	!---------------
20
21	jjm = jjmp1 - 1
22	DO n = 1, nfield
23	DO i=1, iim
24	ecrit(i, n) = fi(1, n)
25	ecrit(i+jjm*iim, n) = fi(nlon, n)
26	ENDDO
27	DO ig = 1, nlon - 2
28	ecrit(iim+ig, n) = fi(1+ig, n)
29	ENDDO
30	ENDDO
31
32	END SUBROUTINE gr_fi_ecrit