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

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