/[lmdze]/trunk/Sources/phylmd/gr_phy_write.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/gr_phy_write.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/Sources/phylmd/gr_fi_ecrit.f revision 186 by guez, Mon Mar 21 15:36:26 2016 UTC trunk/Sources/phylmd/gr_phy_write.f revision 189 by guez, Tue Mar 29 15:20:23 2016 UTC
# Line 1  Line 1 
1  module gr_fi_ecrit_m  module gr_phy_write_m
2    
3      use dimens_m, only: iim, jjm
4      use dimphy, only: klon
5    
6    IMPLICIT none    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  contains
16    
17    SUBROUTINE gr_fi_ecrit(nfield, nlon, iim, jjmp1, fi, ecrit)    function gr_phy_write_2d(pfi)
18    
19      ! From phylmd/physiq.F, version 1.22 2006/02/20 09:38:28      ! 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      ! Transforme une variable de la grille physique \`a la grille      gr_phy_write_2d = unpack(pfi, dyn_phy(:iim, :), field)
     ! d'\'ecriture.  Cf. version moderne "gr_phy_write_2d", dans le  
     ! cas o\`u "nfield" vaut 1.  
   
     INTEGER, intent(in):: nfield, nlon, iim, jjmp1  
     REAL, intent(in):: fi(nlon, nfield)  
     real ecrit(iim*jjmp1, nfield)  
41    
42      ! Variables local to the procedure:    END function gr_phy_write_2d
43    
44      integer jjm    !********************************************
45      INTEGER i, n, ig  
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      jjm = jjmp1 - 1      call assert(size(fi, 1) == klon, "gr_phy_write_3d")
66      DO n = 1, nfield  
67         DO i=1, iim      DO l = 1, size(fi, 2)
68            ecrit(i, n) = fi(1, n)         gr_phy_write_3d(:, :, l) = gr_phy_write_2d(fi(:, l))
69            ecrit(i+jjm*iim, n) = fi(nlon, n)      END DO
        ENDDO  
        DO ig = 1, nlon - 2  
           ecrit(iim+ig, n) = fi(1+ig, n)  
        ENDDO  
     ENDDO  
70    
71    END SUBROUTINE gr_fi_ecrit    END function gr_phy_write_3d
72    
73  end module gr_fi_ecrit_m  end module gr_phy_write_m
Legend:
Removed from v.186  
changed lines
  Added in v.189
  ViewVC Help
Powered by ViewVC 1.1.21