/[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 62 by guez, Thu Jul 26 14:37:37 2012 UTC revision 67 by guez, Tue Oct 2 15:50:56 2012 UTC
# Line 11  contains Line 11  contains
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    
     USE mathop_m, ONLY: mathop  
     USE mathelp, ONLY: trans_buff, moycum  
     use netcdf, only: NF90_PUT_VAR  
14      USE histcom_var, ONLY: buffer, buff_pos, datasz_max, deltat, &      USE histcom_var, ONLY: buffer, buff_pos, datasz_max, deltat, &
15           last_opp, last_wrt, missing_val, nbopp, nb_opp, nb_wrt, ncdf_ids, &           last_opp, last_wrt, missing_val, nbopp, nb_opp, nb_wrt, ncdf_ids, &
16           ncvar_ids, point, regular, scal, scsize, sopps, tax_last, tdimid, &           ncvar_ids, point, regular, scal, scsize, sopps, tax_last, tdimid, &
17           topp, var_axid, zorig, zsize           topp, var_axid, zorig, zsize
18        USE mathelp, ONLY: trans_buff, moycum
19        USE mathop_m, ONLY: mathop
20        use netcdf, only: NF90_PUT_VAR
21    
22      INTEGER, INTENT(IN):: fileid, varid, itau, nbdpt      INTEGER, INTENT(IN):: fileid, varid, itau, nbdpt
23      REAL buff_tmp(:)      REAL buff_tmp(:)
# Line 52  contains Line 52  contains
52    
53      ! The sizes which can be encoutered      ! The sizes which can be encoutered
54    
55      tsz = zsize(fileid, varid, 1)*zsize(fileid, varid, 2)*zsize(fileid, varid, 3)      tsz = zsize(fileid, varid, 1) * zsize(fileid, varid, 2) &
56             * zsize(fileid, varid, 3)
57    
58      ! 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
59      !     and the temporary space needed for operations.      ! and the temporary space needed for operations.
60      !     We have to keep precedent buffer if needed      ! We have to keep precedent buffer if needed
61    
62      IF (.NOT. ALLOCATED(buffer)) THEN      IF (.NOT. ALLOCATED(buffer)) THEN
63         ALLOCATE(buffer(buff_pos))         ALLOCATE(buffer(buff_pos))
# Line 64  contains Line 65  contains
65         buffer(:)=0.0         buffer(:)=0.0
66      ELSE IF (buffer_sz < buff_pos) THEN      ELSE IF (buffer_sz < buff_pos) THEN
67         IF (SUM(buffer)/=0.0) THEN         IF (SUM(buffer)/=0.0) THEN
68            ALLOCATE (buffer_used(buffer_sz))            ALLOCATE(buffer_used(buffer_sz))
69            buffer_used(:)=buffer(:)            buffer_used(:)=buffer(:)
70            DEALLOCATE (buffer)            DEALLOCATE(buffer)
71            ALLOCATE (buffer(buff_pos))            ALLOCATE(buffer(buff_pos))
72            buffer_sz = buff_pos            buffer_sz = buff_pos
73            buffer(:SIZE(buffer_used))=buffer_used            buffer(:SIZE(buffer_used))=buffer_used
74            DEALLOCATE (buffer_used)            DEALLOCATE(buffer_used)
75         ELSE         ELSE
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(:)=0.0            buffer(:)=0.0
80         ENDIF         ENDIF
# Line 83  contains Line 84  contains
84      ! reduces the umber of allocates but increases memory needs.      ! reduces the umber of allocates but increases memory needs.
85    
86      IF (.NOT.ALLOCATED(buff_tmp2)) THEN      IF (.NOT.ALLOCATED(buff_tmp2)) THEN
87         ALLOCATE (buff_tmp2(datasz_max(fileid, varid)))         ALLOCATE(buff_tmp2(datasz_max(fileid, varid)))
88         buff_tmp2_sz = datasz_max(fileid, varid)         buff_tmp2_sz = datasz_max(fileid, varid)
89      ELSE IF ( datasz_max(fileid, varid) > buff_tmp2_sz) THEN      ELSE IF (datasz_max(fileid, varid) > buff_tmp2_sz) THEN
90         DEALLOCATE (buff_tmp2)         DEALLOCATE(buff_tmp2)
91         ALLOCATE (buff_tmp2(datasz_max(fileid, varid)))         ALLOCATE(buff_tmp2(datasz_max(fileid, varid)))
92         buff_tmp2_sz = datasz_max(fileid, varid)         buff_tmp2_sz = datasz_max(fileid, varid)
93      ENDIF      ENDIF
94    
# Line 98  contains Line 99  contains
99    
100      ! 3.1 DO the Operations only if needed      ! 3.1 DO the Operations only if needed
101    
102      IF ( do_oper ) THEN      IF (do_oper) THEN
103         i = fileid         i = fileid
104         nbout = nbdpt         nbout = nbdpt
105    
106         !- 3.4 We continue the sequence of operations         ! 3.4 We continue the sequence of operations
107         !-     we started in the interface routine         ! we started in the interface routine
108    
109         DO io = 2, nbopp(i, varid), 2         DO io = 2, nbopp(i, varid), 2
110            nbin = nbout            nbin = nbout
# Line 117  contains Line 118  contains
118                 nbindex, nindex, scal(i, varid, io+1), nbout, buff_tmp)                 nbindex, nindex, scal(i, varid, io+1), nbout, buff_tmp)
119         ENDDO         ENDDO
120    
121         !   3.5 Zoom into the data         ! 3.5 Zoom into the data
122    
123         CALL trans_buff &         CALL trans_buff(zorig(i, varid, 1), zsize(i, varid, 1), &
124              (zorig(i, varid, 1), zsize(i, varid, 1), &              zorig(i, varid, 2), zsize(i, varid, 2), zorig(i, varid, 3), &
125              zorig(i, varid, 2), zsize(i, varid, 2), &              zsize(i, varid, 3), scsize(i, varid, 1), scsize(i, varid, 2), &
126              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)  
127    
128         !- 5.0 Do the operations if needed. In the case of instantaneous         ! 5.0 Do the operations if needed. In the case of instantaneous
129         !-     output we do not transfer to the buffer.         ! output we do not transfer to the buffer.
130    
131         ipt = point(fileid, varid)         ipt = point(fileid, varid)
132    
133         IF (     (TRIM(tmp_opp) /= "inst") &         IF ((TRIM(tmp_opp) /= "inst") &
134              .AND.(TRIM(tmp_opp) /= "once") ) THEN              .AND.(TRIM(tmp_opp) /= "once")) THEN
135            CALL moycum(tmp_opp, tsz, buffer(ipt:), &            CALL moycum(tmp_opp, tsz, buffer(ipt:), &
136                 buff_tmp2, nb_opp(fileid, varid))                 buff_tmp2, nb_opp(fileid, varid))
137         ENDIF         ENDIF
# Line 144  contains Line 143  contains
143    
144      ! 6.0 Write to file if needed      ! 6.0 Write to file if needed
145    
146      IF ( do_write ) THEN      IF (do_write) THEN
   
147         ncvarid = ncvar_ids(fileid, varid)         ncvarid = ncvar_ids(fileid, varid)
148         ncid = ncdf_ids(fileid)         ncid = ncdf_ids(fileid)
149    
150         !- 6.1 Do the operations that are needed before writting         ! 6.1 Do the operations that are needed before writting
151           IF ((TRIM(tmp_opp) /= "inst") .AND. (TRIM(tmp_opp) /= "once")) THEN
152         IF (     (TRIM(tmp_opp) /= "inst") &            rtime = (rtime + last_wrt(fileid, varid)*deltat(fileid)) / 2.
             .AND.(TRIM(tmp_opp) /= "once") ) THEN  
           rtime = (rtime+last_wrt(fileid, varid)*deltat(fileid))/2.0  
153         ENDIF         ENDIF
154    
155         !- 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
156           IF (TRIM(tmp_opp) /= "l_max" .AND. TRIM(tmp_opp) /= "l_min" &
157         IF (     (TRIM(tmp_opp) /= "l_max") &              .AND. TRIM(tmp_opp) /= "once") THEN
             .AND.(TRIM(tmp_opp) /= "l_min") &  
             .AND.(TRIM(tmp_opp) /= "once") ) THEN  
   
158            itax = var_axid(fileid, varid)            itax = var_axid(fileid, varid)
159            itime = nb_wrt(fileid, varid)+1            itime = nb_wrt(fileid, varid) + 1
160    
161            IF (tax_last(fileid, itax) < itime) THEN            IF (tax_last(fileid, itax) < itime) THEN
162               iret = NF90_PUT_VAR (ncid, tdimid(fileid, itax), (/ rtime /), &               iret = NF90_PUT_VAR(ncid, tdimid(fileid, itax), (/rtime/), &
163                    start=(/ itime /), count=(/ 1 /))                    start=(/itime/))
164               tax_last(fileid, itax) = itime               tax_last(fileid, itax) = itime
165            ENDIF            ENDIF
166         ELSE         ELSE
167            itime=1            itime=1
168         ENDIF         ENDIF
169    
170         !- 6.3 Write the data. Only in the case of instantaneous output         ! 6.3 Write the data. Only in the case of instantaneous output
171         !       we do not write the buffer.         ! we do not write the buffer.
172    
173         IF (scsize(fileid, varid, 3) == 1) THEN         IF (scsize(fileid, varid, 3) == 1) THEN
174            IF (regular(fileid)) THEN            IF (regular(fileid)) THEN
175               corner(1:4) = (/ 1, 1, itime, 0 /)               corner(1:4) = (/1, 1, itime, 0/)
176               edges(1:4) = (/ zsize(fileid, varid, 1), &               edges(1:4) = (/zsize(fileid, varid, 1), &
177                    zsize(fileid, varid, 2), &                    zsize(fileid, varid, 2), &
178                    1, 0 /)                    1, 0/)
179            ELSE            ELSE
180               corner(1:4) = (/ 1, itime, 0, 0 /)               corner(1:4) = (/1, itime, 0, 0/)
181               edges(1:4) = (/ zsize(fileid, varid, 1), 1, 0, 0 /)               edges(1:4) = (/zsize(fileid, varid, 1), 1, 0, 0/)
182            ENDIF            ENDIF
183         ELSE         ELSE
184            IF ( regular(fileid) ) THEN            IF (regular(fileid)) THEN
185               corner(1:4) = (/ 1, 1, 1, itime /)               corner(1:4) = (/1, 1, 1, itime/)
186               edges(1:4) = (/ zsize(fileid, varid, 1), &               edges(1:4) = (/zsize(fileid, varid, 1), &
187                    zsize(fileid, varid, 2), &                    zsize(fileid, varid, 2), &
188                    zsize(fileid, varid, 3), 1 /)                    zsize(fileid, varid, 3), 1/)
189            ELSE            ELSE
190               corner(1:4) = (/ 1, 1, itime, 0 /)               corner(1:4) = (/1, 1, itime, 0/)
191               edges(1:4) = (/ zsize(fileid, varid, 1), &               edges(1:4) = (/zsize(fileid, varid, 1), &
192                    zsize(fileid, varid, 3), 1, 0 /)                    zsize(fileid, varid, 3), 1, 0/)
193            ENDIF            ENDIF
194         ENDIF         ENDIF
195    
196         ipt = point(fileid, varid)         ipt = point(fileid, varid)
197    
198         IF (     (TRIM(tmp_opp) /= "inst") &         IF ((TRIM(tmp_opp) /= "inst") .AND. (TRIM(tmp_opp) /= "once")) THEN
199              .AND.(TRIM(tmp_opp) /= "once") ) THEN            iret = NF90_PUT_VAR(ncid, ncvarid, buffer(ipt:), &
           iret = NF90_PUT_VAR (ncid, ncvarid, buffer(ipt:), &  
200                 start=corner(1:4), count=edges(1:4))                 start=corner(1:4), count=edges(1:4))
201         ELSE         ELSE
202            iret = NF90_PUT_VAR (ncid, ncvarid, buff_tmp2, &            iret = NF90_PUT_VAR(ncid, ncvarid, buff_tmp2, &
203                 start=corner(1:4), count=edges(1:4))                 start=corner(1:4), count=edges(1:4))
204         ENDIF         ENDIF
205    
206         last_wrt(fileid, varid) = itau         last_wrt(fileid, varid) = itau
207         nb_wrt(fileid, varid) = nb_wrt(fileid, varid)+1         nb_wrt(fileid, varid) = nb_wrt(fileid, varid)+1
208         nb_opp(fileid, 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)  
   
209      ENDIF      ENDIF
210    
211    END SUBROUTINE histwrite_real    END SUBROUTINE histwrite_real
Legend:
Removed from v.62  
changed lines
  Added in v.67
  ViewVC Help
Powered by ViewVC 1.1.21