/[lmdze]/trunk/IOIPSL/histwrite_real.f
ViewVC logotype

Diff of /trunk/IOIPSL/histwrite_real.f

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

revision 56 by guez, Tue Jan 10 19:02:02 2012 UTC revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC
# Line 4  module histwrite_real_m Line 4  module histwrite_real_m
4    
5  contains  contains
6    
7    SUBROUTINE histwrite_real(pfileid, varid, pitau, nbdpt, buff_tmp, nbindex, &    SUBROUTINE histwrite_real(fileid, varid, itau, nbdpt, buff_tmp, nbindex, &
8         nindex, do_oper, do_write)         nindex, do_oper, do_write)
9    
10      ! This subroutine is internal and does the calculations and writing      ! This subroutine is internal and does the calculations and writing
11      ! if needed. At a later stage it should be split into an operation      ! if needed. At a later stage it should be split into an operation
12      ! and writing subroutines.      ! and writing subroutines.
     !--------------------------------------------------------------------  
13    
14      USE mathop_m, ONLY : mathop      USE mathop_m, ONLY: mathop
15      USE mathelp, ONLY : trans_buff, moycum      USE mathelp, ONLY: trans_buff, moycum
16      use netcdf, only: NF90_PUT_VAR      use netcdf, only: NF90_PUT_VAR
17      use histcom_var      USE histcom_var, ONLY: buffer, buff_pos, datasz_max, deltat, &
18             last_opp, last_wrt, missing_val, nbopp, nb_opp, nb_wrt, ncdf_ids, &
19             ncvar_ids, point, regular, scal, scsize, sopps, tax_last, tdimid, &
20             topp, var_axid, zorig, zsize
21    
22      INTEGER, INTENT(IN) :: pfileid, pitau, varid, nbdpt      INTEGER, INTENT(IN):: fileid, varid, itau, nbdpt
23        REAL buff_tmp(:)
24    
25      INTEGER, INTENT(IN) :: nbindex      INTEGER, INTENT(IN):: nbindex
26      ! number of indices provided      ! number of indices provided
27      ! If it is equal to the size of the full field as provided in histdef      ! If it is equal to the size of the full field as provided in histdef
28      ! then nothing is done.      ! then nothing is done.
29    
30      INTEGER, INTENT(IN) :: nindex(nbindex)      INTEGER, INTENT(IN):: nindex(nbindex)
31      ! The indices used to expand the variable (pdata) onto the full field      ! The indices used to expand the variable (pdata) onto the full field
32    
33      REAL, DIMENSION(:)  :: buff_tmp      LOGICAL, INTENT(IN):: do_oper, do_write
34      LOGICAL, INTENT(IN) :: do_oper, do_write  
35        ! Local:
36    
37      INTEGER :: tsz, ncid, ncvarid      INTEGER:: tsz, ncid, ncvarid
38      INTEGER :: i, iret, ipt, itax      INTEGER:: i, iret, ipt, itax
39      INTEGER :: io, nbin, nbout      INTEGER:: io, nbin, nbout
40      INTEGER, DIMENSION(4) :: corner, edges      INTEGER, DIMENSION(4):: corner, edges
41      INTEGER :: itime      INTEGER:: itime
42    
43      REAL :: rtime      REAL:: rtime
44      CHARACTER(LEN=7) :: tmp_opp      CHARACTER(LEN=7):: tmp_opp
45    
46      REAL, ALLOCATABLE, SAVE :: buff_tmp2(:)      REAL, ALLOCATABLE, SAVE:: buff_tmp2(:)
47      INTEGER, SAVE          :: buff_tmp2_sz      INTEGER, SAVE:: buff_tmp2_sz
48      REAL, ALLOCATABLE, SAVE :: buffer_used(:)      REAL, ALLOCATABLE, SAVE:: buffer_used(:)
49      INTEGER, SAVE          :: buffer_sz      INTEGER, SAVE:: buffer_sz
50    
51      !--------------------------------------------------------------------      !--------------------------------------------------------------------
52    
53      ! The sizes which can be encoutered      ! The sizes which can be encoutered
54    
55      tsz = zsize(pfileid, varid, 1)*zsize(pfileid, varid, 2)*zsize(pfileid, varid, 3)      tsz = zsize(fileid, varid, 1)*zsize(fileid, varid, 2)*zsize(fileid, varid, 3)
56    
57      ! 1.0 We allocate the memory needed to store the data between write      ! 1.0 We allocate the memory needed to store the data between write
58      !     and the temporary space needed for operations.      !     and the temporary space needed for operations.
# Line 79  contains Line 83  contains
83      ! reduces the umber of allocates but increases memory needs.      ! reduces the umber of allocates but increases memory needs.
84    
85      IF (.NOT.ALLOCATED(buff_tmp2)) THEN      IF (.NOT.ALLOCATED(buff_tmp2)) THEN
86         ALLOCATE (buff_tmp2(datasz_max(pfileid, varid)))         ALLOCATE (buff_tmp2(datasz_max(fileid, varid)))
87         buff_tmp2_sz = datasz_max(pfileid, varid)         buff_tmp2_sz = datasz_max(fileid, varid)
88      ELSE IF ( datasz_max(pfileid, varid) > buff_tmp2_sz) THEN      ELSE IF ( datasz_max(fileid, varid) > buff_tmp2_sz) THEN
89         DEALLOCATE (buff_tmp2)         DEALLOCATE (buff_tmp2)
90         ALLOCATE (buff_tmp2(datasz_max(pfileid, varid)))         ALLOCATE (buff_tmp2(datasz_max(fileid, varid)))
91         buff_tmp2_sz = datasz_max(pfileid, varid)         buff_tmp2_sz = datasz_max(fileid, varid)
92      ENDIF      ENDIF
93    
94      rtime = pitau * deltat(pfileid)      rtime = itau * deltat(fileid)
95      tmp_opp = topp(pfileid, varid)      tmp_opp = topp(fileid, varid)
96    
97      ! 3.0 Do the operations or transfer the slab of data into buff_tmp      ! 3.0 Do the operations or transfer the slab of data into buff_tmp
98    
99      ! 3.1 DO the Operations only if needed      ! 3.1 DO the Operations only if needed
100    
101      IF ( do_oper ) THEN      IF ( do_oper ) THEN
102         i = pfileid         i = fileid
103         nbout = nbdpt         nbout = nbdpt
104    
105         !- 3.4 We continue the sequence of operations         !- 3.4 We continue the sequence of operations
# Line 105  contains Line 109  contains
109            nbin = nbout            nbin = nbout
110            nbout = datasz_max(i, varid)            nbout = datasz_max(i, varid)
111            CALL mathop(sopps(i, varid, io), nbin, buff_tmp, missing_val, &            CALL mathop(sopps(i, varid, io), nbin, buff_tmp, missing_val, &
112                 &      nbindex, nindex, scal(i, varid, io), nbout, buff_tmp2)                 nbindex, nindex, scal(i, varid, io), nbout, buff_tmp2)
113    
114            nbin = nbout            nbin = nbout
115            nbout = datasz_max(i, varid)            nbout = datasz_max(i, varid)
116            CALL mathop(sopps(i, varid, io+1), nbin, buff_tmp2, missing_val, &            CALL mathop(sopps(i, varid, io+1), nbin, buff_tmp2, missing_val, &
117                 &      nbindex, nindex, scal(i, varid, io+1), nbout, buff_tmp)                 nbindex, nindex, scal(i, varid, io+1), nbout, buff_tmp)
118         ENDDO         ENDDO
119    
120         !   3.5 Zoom into the data         !   3.5 Zoom into the data
121    
122         CALL trans_buff &         CALL trans_buff &
123              &      (zorig(i, varid, 1), zsize(i, varid, 1), &              (zorig(i, varid, 1), zsize(i, varid, 1), &
124              &       zorig(i, varid, 2), zsize(i, varid, 2), &              zorig(i, varid, 2), zsize(i, varid, 2), &
125              &       zorig(i, varid, 3), zsize(i, varid, 3), &              zorig(i, varid, 3), zsize(i, varid, 3), &
126              &       scsize(i, varid, 1), scsize(i, varid, 2), scsize(i, varid, 3), &              scsize(i, varid, 1), scsize(i, varid, 2), scsize(i, varid, 3), &
127              &       buff_tmp, buff_tmp2_sz, buff_tmp2)              buff_tmp, buff_tmp2_sz, buff_tmp2)
128    
129         !- 5.0 Do the operations if needed. In the case of instantaneous         !- 5.0 Do the operations if needed. In the case of instantaneous
130         !-     output we do not transfer to the buffer.         !-     output we do not transfer to the buffer.
131    
132         ipt = point(pfileid, varid)         ipt = point(fileid, varid)
133    
134         IF (     (TRIM(tmp_opp) /= "inst") &         IF (     (TRIM(tmp_opp) /= "inst") &
135              &    .AND.(TRIM(tmp_opp) /= "once") ) THEN              .AND.(TRIM(tmp_opp) /= "once") ) THEN
136            CALL moycum(tmp_opp, tsz, buffer(ipt:), &            CALL moycum(tmp_opp, tsz, buffer(ipt:), &
137                 &       buff_tmp2, nb_opp(pfileid, varid))                 buff_tmp2, nb_opp(fileid, varid))
138         ENDIF         ENDIF
139    
140         last_opp(pfileid, varid) = pitau         last_opp(fileid, varid) = itau
141         nb_opp(pfileid, varid) = nb_opp(pfileid, varid)+1         nb_opp(fileid, varid) = nb_opp(fileid, varid)+1
142    
143      ENDIF      ENDIF
144    
# Line 142  contains Line 146  contains
146    
147      IF ( do_write ) THEN      IF ( do_write ) THEN
148    
149         ncvarid = ncvar_ids(pfileid, varid)         ncvarid = ncvar_ids(fileid, varid)
150         ncid = ncdf_ids(pfileid)         ncid = ncdf_ids(fileid)
151    
152         !- 6.1 Do the operations that are needed before writting         !- 6.1 Do the operations that are needed before writting
153    
154         IF (     (TRIM(tmp_opp) /= "inst") &         IF (     (TRIM(tmp_opp) /= "inst") &
155              &    .AND.(TRIM(tmp_opp) /= "once") ) THEN              .AND.(TRIM(tmp_opp) /= "once") ) THEN
156            rtime = (rtime+last_wrt(pfileid, varid)*deltat(pfileid))/2.0            rtime = (rtime+last_wrt(fileid, varid)*deltat(fileid))/2.0
157         ENDIF         ENDIF
158    
159         !- 6.2 Add a value to the time axis of this variable if needed         !- 6.2 Add a value to the time axis of this variable if needed
160    
161         IF (     (TRIM(tmp_opp) /= "l_max") &         IF (     (TRIM(tmp_opp) /= "l_max") &
162              &    .AND.(TRIM(tmp_opp) /= "l_min") &              .AND.(TRIM(tmp_opp) /= "l_min") &
163              &    .AND.(TRIM(tmp_opp) /= "once") ) THEN              .AND.(TRIM(tmp_opp) /= "once") ) THEN
164    
165            itax = var_axid(pfileid, varid)            itax = var_axid(fileid, varid)
166            itime = nb_wrt(pfileid, varid)+1            itime = nb_wrt(fileid, varid)+1
167    
168            IF (tax_last(pfileid, itax) < itime) THEN            IF (tax_last(fileid, itax) < itime) THEN
169               iret = NF90_PUT_VAR (ncid, tdimid(pfileid, itax), (/ rtime /), &               iret = NF90_PUT_VAR (ncid, tdimid(fileid, itax), (/ rtime /), &
170                    &                            start=(/ itime /), count=(/ 1 /))                    start=(/ itime /), count=(/ 1 /))
171               tax_last(pfileid, itax) = itime               tax_last(fileid, itax) = itime
172            ENDIF            ENDIF
173         ELSE         ELSE
174            itime=1            itime=1
# Line 173  contains Line 177  contains
177         !- 6.3 Write the data. Only in the case of instantaneous output         !- 6.3 Write the data. Only in the case of instantaneous output
178         !       we do not write the buffer.         !       we do not write the buffer.
179    
180         IF (scsize(pfileid, varid, 3) == 1) THEN         IF (scsize(fileid, varid, 3) == 1) THEN
181            IF (regular(pfileid)) THEN            IF (regular(fileid)) THEN
182               corner(1:4) = (/ 1, 1, itime, 0 /)               corner(1:4) = (/ 1, 1, itime, 0 /)
183               edges(1:4) = (/ zsize(pfileid, varid, 1), &               edges(1:4) = (/ zsize(fileid, varid, 1), &
184                    &                      zsize(pfileid, varid, 2), &                    zsize(fileid, varid, 2), &
185                    &                       1, 0 /)                    1, 0 /)
186            ELSE            ELSE
187               corner(1:4) = (/ 1, itime, 0, 0 /)               corner(1:4) = (/ 1, itime, 0, 0 /)
188               edges(1:4) = (/ zsize(pfileid, varid, 1), 1, 0, 0 /)               edges(1:4) = (/ zsize(fileid, varid, 1), 1, 0, 0 /)
189            ENDIF            ENDIF
190         ELSE         ELSE
191            IF ( regular(pfileid) ) THEN            IF ( regular(fileid) ) THEN
192               corner(1:4) = (/ 1, 1, 1, itime /)               corner(1:4) = (/ 1, 1, 1, itime /)
193               edges(1:4) = (/ zsize(pfileid, varid, 1), &               edges(1:4) = (/ zsize(fileid, varid, 1), &
194                    &                      zsize(pfileid, varid, 2), &                    zsize(fileid, varid, 2), &
195                    &                      zsize(pfileid, varid, 3), 1 /)                    zsize(fileid, varid, 3), 1 /)
196            ELSE            ELSE
197               corner(1:4) = (/ 1, 1, itime, 0 /)               corner(1:4) = (/ 1, 1, itime, 0 /)
198               edges(1:4) = (/ zsize(pfileid, varid, 1), &               edges(1:4) = (/ zsize(fileid, varid, 1), &
199                    &                      zsize(pfileid, varid, 3), 1, 0 /)                    zsize(fileid, varid, 3), 1, 0 /)
200            ENDIF            ENDIF
201         ENDIF         ENDIF
202    
203         ipt = point(pfileid, varid)         ipt = point(fileid, varid)
204    
205         IF (     (TRIM(tmp_opp) /= "inst") &         IF (     (TRIM(tmp_opp) /= "inst") &
206              &      .AND.(TRIM(tmp_opp) /= "once") ) THEN              .AND.(TRIM(tmp_opp) /= "once") ) THEN
207            iret = NF90_PUT_VAR (ncid, ncvarid, buffer(ipt:), &            iret = NF90_PUT_VAR (ncid, ncvarid, buffer(ipt:), &
208                 &                       start=corner(1:4), count=edges(1:4))                 start=corner(1:4), count=edges(1:4))
209         ELSE         ELSE
210            iret = NF90_PUT_VAR (ncid, ncvarid, buff_tmp2, &            iret = NF90_PUT_VAR (ncid, ncvarid, buff_tmp2, &
211                 &                       start=corner(1:4), count=edges(1:4))                 start=corner(1:4), count=edges(1:4))
212         ENDIF         ENDIF
213    
214         last_wrt(pfileid, varid) = pitau         last_wrt(fileid, varid) = itau
215         nb_wrt(pfileid, varid) = nb_wrt(pfileid, varid)+1         nb_wrt(fileid, varid) = nb_wrt(fileid, varid)+1
216         nb_opp(pfileid, varid) = 0         nb_opp(fileid, varid) = 0
217         !--         !--
218         !   After the write the file can be synchronized so that no data is         !   After the write the file can be synchronized so that no data is
219         !   lost in case of a crash. This feature gives up on the benefits of         !   lost in case of a crash. This feature gives up on the benefits of
# Line 219  contains Line 223  contains
223         !   iret = NF90_SYNC (ncid)         !   iret = NF90_SYNC (ncid)
224    
225      ENDIF      ENDIF
226      !---------------------------  
227    END SUBROUTINE histwrite_real    END SUBROUTINE histwrite_real
228    
229  end module histwrite_real_m  end module histwrite_real_m
Legend:
Removed from v.56  
changed lines
  Added in v.62
  ViewVC Help
Powered by ViewVC 1.1.21