/[lmdze]/trunk/Sources/IOIPSL/histwrite.f
ViewVC logotype

Diff of /trunk/Sources/IOIPSL/histwrite.f

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

revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC revision 31 by guez, Thu Apr 1 14:59:19 2010 UTC
# Line 1  Line 1 
1  MODULE histwrite_m  MODULE histwrite_m
2    
3    ! From histcom.f90, v 2.1 2004/04/21 09:27:10    ! From histcom.f90, version 2.1 2004/04/21 09:27:10
   
   use histcom_var  
4    
5    implicit none    implicit none
6    
# Line 10  MODULE histwrite_m Line 8  MODULE histwrite_m
8    PUBLIC histwrite    PUBLIC histwrite
9    
10    INTERFACE histwrite    INTERFACE histwrite
11       !- The "histwrite" procedures give the data to the input-output system.       ! The "histwrite" procedures give the data to the input-output system.
12       !- They trigger the operations to be performed       ! They trigger the operations to be performed and the writing to
13       !- and the writing to the file if needed.       ! the file if needed.
14    
15       !- We test the work to be done at this time here so that at a       ! We test the work to be done at this time here so that at a
16       !- later stage we can call different operations and write subroutines       ! later stage we can call different operations and write subroutines
17       !- for the REAL and INTEGER interfaces.       ! for the REAL and INTEGER interfaces.
18    
19       ! INTEGER, INTENT(IN):: pfileid       ! INTEGER, INTENT(IN):: pfileid
20       ! The ID of the file on which this variable is to be written.       ! The ID of the file on which this variable is to be written.
# Line 51  CONTAINS Line 49  CONTAINS
49      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
50      use calendar, only: isittime      use calendar, only: isittime
51      USE mathelp, ONLY : mathop      USE mathelp, ONLY : mathop
52        use histcom_var
53    
54      INTEGER, INTENT(IN) :: pfileid, pitau      INTEGER, INTENT(IN) :: pfileid, pitau
55      REAL, INTENT(IN) :: pdata(:)      REAL, INTENT(IN) :: pdata(:)
# Line 64  CONTAINS Line 63  CONTAINS
63      INTEGER, SAVE :: buff_tmp_sz      INTEGER, SAVE :: buff_tmp_sz
64      CHARACTER(LEN=7) :: tmp_opp      CHARACTER(LEN=7) :: tmp_opp
65    
66      !---------------------------------------------------------------------      !--------------------------------------------------------------------
67    
68      nbindex = size(nindex)      nbindex = size(nindex)
69      nindex = 0      nindex = 0
# Line 118  CONTAINS Line 117  CONTAINS
117    
118      IF (do_oper.OR.do_write) THEN      IF (do_oper.OR.do_write) THEN
119    
120         !-- 5.1 Get the sizes of the data we will handle         !- 5.1 Get the sizes of the data we will handle
121    
122         IF (datasz_in(pfileid, varid, 1) <= 0) THEN         IF (datasz_in(pfileid, varid, 1) <= 0) THEN
123            !---- There is the risk here that the user has over-sized the array.            !--- There is the risk here that the user has over-sized the array.
124            !---- But how can we catch this ?            !--- But how can we catch this ?
125            !---- In the worst case we will do impossible operations            !--- In the worst case we will do impossible operations
126            !---- on part of the data !            !--- on part of the data !
127            datasz_in(pfileid, varid, 1) = SIZE(pdata)            datasz_in(pfileid, varid, 1) = SIZE(pdata)
128            datasz_in(pfileid, varid, 2) = -1            datasz_in(pfileid, varid, 2) = -1
129            datasz_in(pfileid, varid, 3) = -1            datasz_in(pfileid, varid, 3) = -1
130         ENDIF         ENDIF
131    
132         !-- 5.2 The maximum size of the data will give the size of the buffer         !- 5.2 The maximum size of the data will give the size of the buffer
133    
134         IF (datasz_max(pfileid, varid) <= 0) THEN         IF (datasz_max(pfileid, varid) <= 0) THEN
135            largebuf = .FALSE.            largebuf = .FALSE.
# Line 159  CONTAINS Line 158  CONTAINS
158            buff_tmp_sz = datasz_max(pfileid, varid)            buff_tmp_sz = datasz_max(pfileid, varid)
159         ENDIF         ENDIF
160    
161         !-- We have to do the first operation anyway.         !- We have to do the first operation anyway.
162         !-- Thus we do it here and change the ranke         !- Thus we do it here and change the ranke
163         !-- of the data at the same time. This should speed up things.         !- of the data at the same time. This should speed up things.
164    
165         nbpt_in = datasz_in(pfileid, varid, 1)         nbpt_in = datasz_in(pfileid, varid, 1)
166         nbpt_out = datasz_max(pfileid, varid)         nbpt_out = datasz_max(pfileid, varid)
# Line 181  CONTAINS Line 180  CONTAINS
180         last_opp_chk(pfileid, varid) = -99         last_opp_chk(pfileid, varid) = -99
181         last_wrt_chk(pfileid, varid) = -99         last_wrt_chk(pfileid, varid) = -99
182      ENDIF      ENDIF
183      !---------------------------      !--------------------------
184    END SUBROUTINE histwrite_r1d    END SUBROUTINE histwrite_r1d
185    
186    !===    !===
187    
188    SUBROUTINE histwrite_r2d (pfileid, pvarname, pitau, pdata)    SUBROUTINE histwrite_r2d (pfileid, pvarname, pitau, pdata)
189      !---------------------------------------------------------------------      !--------------------------------------------------------------------
190    
191      use calendar, only: isittime      use calendar, only: isittime
192      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
193      USE mathelp, ONLY : mathop      USE mathelp, ONLY : mathop
194        use histcom_var
195    
196      INTEGER, INTENT(IN) :: pfileid, pitau      INTEGER, INTENT(IN) :: pfileid, pitau
197      REAL, DIMENSION(:, :), INTENT(IN) :: pdata      REAL, DIMENSION(:, :), INTENT(IN) :: pdata
# Line 204  CONTAINS Line 204  CONTAINS
204      INTEGER, SAVE :: buff_tmp_sz      INTEGER, SAVE :: buff_tmp_sz
205      CHARACTER(LEN=7) :: tmp_opp      CHARACTER(LEN=7) :: tmp_opp
206    
207      !---------------------------------------------------------------------      !--------------------------------------------------------------------
208    
209      nbindex = size(nindex)      nbindex = size(nindex)
210      nindex = 0      nindex = 0
# Line 258  CONTAINS Line 258  CONTAINS
258    
259      IF (do_oper.OR.do_write) THEN      IF (do_oper.OR.do_write) THEN
260    
261         !-- 5.1 Get the sizes of the data we will handle         !- 5.1 Get the sizes of the data we will handle
262    
263         IF (datasz_in(pfileid, varid, 1) <= 0) THEN         IF (datasz_in(pfileid, varid, 1) <= 0) THEN
264            !---- There is the risk here that the user has over-sized the array.            !--- There is the risk here that the user has over-sized the array.
265            !---- But how can we catch this ?            !--- But how can we catch this ?
266            !---- In the worst case we will do impossible operations            !--- In the worst case we will do impossible operations
267            !---- on part of the data !            !--- on part of the data !
268            datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1)            datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1)
269            datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2)            datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2)
270            datasz_in(pfileid, varid, 3) = -1            datasz_in(pfileid, varid, 3) = -1
271         ENDIF         ENDIF
272    
273         !-- 5.2 The maximum size of the data will give the size of the buffer         !- 5.2 The maximum size of the data will give the size of the buffer
274    
275         IF (datasz_max(pfileid, varid) <= 0) THEN         IF (datasz_max(pfileid, varid) <= 0) THEN
276            largebuf = .FALSE.            largebuf = .FALSE.
# Line 300  CONTAINS Line 300  CONTAINS
300            buff_tmp_sz = datasz_max(pfileid, varid)            buff_tmp_sz = datasz_max(pfileid, varid)
301         ENDIF         ENDIF
302    
303         !-- We have to do the first operation anyway.         !- We have to do the first operation anyway.
304         !-- Thus we do it here and change the ranke         !- Thus we do it here and change the ranke
305         !-- of the data at the same time. This should speed up things.         !- of the data at the same time. This should speed up things.
306    
307         nbpt_in(1:2) = datasz_in(pfileid, varid, 1:2)         nbpt_in(1:2) = datasz_in(pfileid, varid, 1:2)
308         nbpt_out = datasz_max(pfileid, varid)         nbpt_out = datasz_max(pfileid, varid)
# Line 322  CONTAINS Line 322  CONTAINS
322         last_opp_chk(pfileid, varid) = -99         last_opp_chk(pfileid, varid) = -99
323         last_wrt_chk(pfileid, varid) = -99         last_wrt_chk(pfileid, varid) = -99
324      ENDIF      ENDIF
325      !---------------------------      !--------------------------
326    END SUBROUTINE histwrite_r2d    END SUBROUTINE histwrite_r2d
327    
328    !===    !===
329    
330    SUBROUTINE histwrite_r3d (pfileid, pvarname, pitau, pdata)    SUBROUTINE histwrite_r3d (pfileid, pvarname, pitau, pdata)
331      !---------------------------------------------------------------------      !--------------------------------------------------------------------
332    
333      use calendar, only: isittime      use calendar, only: isittime
334      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
335      USE mathelp, ONLY : mathop      USE mathelp, ONLY : mathop
336        use histcom_var
337    
338      INTEGER, INTENT(IN) :: pfileid, pitau      INTEGER, INTENT(IN) :: pfileid, pitau
339      REAL, DIMENSION(:, :, :), INTENT(IN) :: pdata      REAL, DIMENSION(:, :, :), INTENT(IN) :: pdata
# Line 345  CONTAINS Line 346  CONTAINS
346      INTEGER, SAVE :: buff_tmp_sz      INTEGER, SAVE :: buff_tmp_sz
347      CHARACTER(LEN=7) :: tmp_opp      CHARACTER(LEN=7) :: tmp_opp
348    
349      !---------------------------------------------------------------------      !--------------------------------------------------------------------
350    
351      nbindex = size(nindex)      nbindex = size(nindex)
352      nindex = 0      nindex = 0
# Line 399  CONTAINS Line 400  CONTAINS
400    
401      IF (do_oper.OR.do_write) THEN      IF (do_oper.OR.do_write) THEN
402    
403         !-- 5.1 Get the sizes of the data we will handle         !- 5.1 Get the sizes of the data we will handle
404    
405         IF (datasz_in(pfileid, varid, 1) <= 0) THEN         IF (datasz_in(pfileid, varid, 1) <= 0) THEN
406            !---- There is the risk here that the user has over-sized the array.            !--- There is the risk here that the user has over-sized the array.
407            !---- But how can we catch this ?            !--- But how can we catch this ?
408            !---- In the worst case we will do impossible operations            !--- In the worst case we will do impossible operations
409            !---- on part of the data !            !--- on part of the data !
410            datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1)            datasz_in(pfileid, varid, 1) = SIZE(pdata, DIM=1)
411            datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2)            datasz_in(pfileid, varid, 2) = SIZE(pdata, DIM=2)
412            datasz_in(pfileid, varid, 3) = SIZE(pdata, DIM=3)            datasz_in(pfileid, varid, 3) = SIZE(pdata, DIM=3)
413         ENDIF         ENDIF
414    
415         !-- 5.2 The maximum size of the data will give the size of the buffer         !- 5.2 The maximum size of the data will give the size of the buffer
416    
417         IF (datasz_max(pfileid, varid) <= 0) THEN         IF (datasz_max(pfileid, varid) <= 0) THEN
418            largebuf = .FALSE.            largebuf = .FALSE.
# Line 442  CONTAINS Line 443  CONTAINS
443            buff_tmp_sz = datasz_max(pfileid, varid)            buff_tmp_sz = datasz_max(pfileid, varid)
444         ENDIF         ENDIF
445    
446         !-- We have to do the first operation anyway.         !- We have to do the first operation anyway.
447         !-- Thus we do it here and change the ranke         !- Thus we do it here and change the ranke
448         !-- of the data at the same time. This should speed up things.         !- of the data at the same time. This should speed up things.
449    
450         nbpt_in(1:3) = datasz_in(pfileid, varid, 1:3)         nbpt_in(1:3) = datasz_in(pfileid, varid, 1:3)
451         nbpt_out = datasz_max(pfileid, varid)         nbpt_out = datasz_max(pfileid, varid)
# Line 464  CONTAINS Line 465  CONTAINS
465         last_opp_chk(pfileid, varid) = -99         last_opp_chk(pfileid, varid) = -99
466         last_wrt_chk(pfileid, varid) = -99         last_wrt_chk(pfileid, varid) = -99
467      ENDIF      ENDIF
468      !---------------------------      !--------------------------
469    END SUBROUTINE histwrite_r3d    END SUBROUTINE histwrite_r3d
470    
471    !===    !===
# Line 472  CONTAINS Line 473  CONTAINS
473    SUBROUTINE histwrite_real(pfileid, varid, pitau, nbdpt, buff_tmp, nbindex, &    SUBROUTINE histwrite_real(pfileid, varid, pitau, nbdpt, buff_tmp, nbindex, &
474         nindex, do_oper, do_write)         nindex, do_oper, do_write)
475    
476      !- This subroutine is internal and does the calculations and writing      ! This subroutine is internal and does the calculations and writing
477      !- 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
478      !- and writing subroutines.      ! and writing subroutines.
479      !---------------------------------------------------------------------      !--------------------------------------------------------------------
480    
481      USE mathelp, ONLY : mathop, trans_buff, moycum      USE mathelp, ONLY : mathop, trans_buff, moycum
482      use netcdf, only: NF90_PUT_VAR      use netcdf, only: NF90_PUT_VAR
483        use histcom_var
484    
485      INTEGER, INTENT(IN) :: pfileid, pitau, varid, &      INTEGER, INTENT(IN) :: pfileid, pitau, varid, &
486           &                      nbindex, nindex(nbindex), nbdpt           &                      nbindex, nindex(nbindex), nbdpt
# Line 499  CONTAINS Line 501  CONTAINS
501      REAL, ALLOCATABLE, SAVE :: buffer_used(:)      REAL, ALLOCATABLE, SAVE :: buffer_used(:)
502      INTEGER, SAVE          :: buffer_sz      INTEGER, SAVE          :: buffer_sz
503    
504      !---------------------------------------------------------------------      !--------------------------------------------------------------------
505    
506      ! The sizes which can be encoutered      ! The sizes which can be encoutered
507    
# Line 553  CONTAINS Line 555  CONTAINS
555         i = pfileid         i = pfileid
556         nbout = nbdpt         nbout = nbdpt
557    
558         !-- 3.4 We continue the sequence of operations         !- 3.4 We continue the sequence of operations
559         !--     we started in the interface routine         !-     we started in the interface routine
560    
561         DO io = 2, nbopp(i, varid), 2         DO io = 2, nbopp(i, varid), 2
562            nbin = nbout            nbin = nbout
# Line 577  CONTAINS Line 579  CONTAINS
579              &       scsize(i, varid, 1), scsize(i, varid, 2), scsize(i, varid, 3), &              &       scsize(i, varid, 1), scsize(i, varid, 2), scsize(i, varid, 3), &
580              &       buff_tmp, buff_tmp2_sz, buff_tmp2)              &       buff_tmp, buff_tmp2_sz, buff_tmp2)
581    
582         !-- 5.0 Do the operations if needed. In the case of instantaneous         !- 5.0 Do the operations if needed. In the case of instantaneous
583         !--     output we do not transfer to the buffer.         !-     output we do not transfer to the buffer.
584    
585         ipt = point(pfileid, varid)         ipt = point(pfileid, varid)
586    
# Line 600  CONTAINS Line 602  CONTAINS
602         ncvarid = ncvar_ids(pfileid, varid)         ncvarid = ncvar_ids(pfileid, varid)
603         ncid = ncdf_ids(pfileid)         ncid = ncdf_ids(pfileid)
604    
605         !-- 6.1 Do the operations that are needed before writting         !- 6.1 Do the operations that are needed before writting
606    
607         IF (     (TRIM(tmp_opp) /= "inst") &         IF (     (TRIM(tmp_opp) /= "inst") &
608              &    .AND.(TRIM(tmp_opp) /= "once") ) THEN              &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
609            rtime = (rtime+last_wrt(pfileid, varid)*deltat(pfileid))/2.0            rtime = (rtime+last_wrt(pfileid, varid)*deltat(pfileid))/2.0
610         ENDIF         ENDIF
611    
612         !-- 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
613    
614         IF (     (TRIM(tmp_opp) /= "l_max") &         IF (     (TRIM(tmp_opp) /= "l_max") &
615              &    .AND.(TRIM(tmp_opp) /= "l_min") &              &    .AND.(TRIM(tmp_opp) /= "l_min") &
# Line 625  CONTAINS Line 627  CONTAINS
627            itime=1            itime=1
628         ENDIF         ENDIF
629    
630         !-- 6.3 Write the data. Only in the case of instantaneous output         !- 6.3 Write the data. Only in the case of instantaneous output
631         !       we do not write the buffer.         !       we do not write the buffer.
632    
633         IF (scsize(pfileid, varid, 3) == 1) THEN         IF (scsize(pfileid, varid, 3) == 1) THEN
# Line 665  CONTAINS Line 667  CONTAINS
667         last_wrt(pfileid, varid) = pitau         last_wrt(pfileid, varid) = pitau
668         nb_wrt(pfileid, varid) = nb_wrt(pfileid, varid)+1         nb_wrt(pfileid, varid) = nb_wrt(pfileid, varid)+1
669         nb_opp(pfileid, varid) = 0         nb_opp(pfileid, varid) = 0
670         !---         !--
671         !   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
672         !   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
673         !   buffering and should only be used in debuging mode. A flag is         !   buffering and should only be used in debuging mode. A flag is
674         !   needed here to switch to this mode.         !   needed here to switch to this mode.
675         !---         !--
676         !   iret = NF90_SYNC (ncid)         !   iret = NF90_SYNC (ncid)
677    
678      ENDIF      ENDIF
679      !----------------------------      !---------------------------
680    END SUBROUTINE histwrite_real    END SUBROUTINE histwrite_real
681    
682    !*************************************************************    !*************************************************************
683    
684    SUBROUTINE histvar_seq (pfid, pvarname, pvid)    SUBROUTINE histvar_seq (pfid, pvarname, pvid)
685    
686      !- This subroutine optimized the search for the variable in the table.      ! This subroutine optimized the search for the variable in the table.
687      !- In a first phase it will learn the succession of the variables      ! In a first phase it will learn the succession of the variables
688      !- called and then it will use the table to guess what comes next.      ! called and then it will use the table to guess what comes next.
689      !- It is the best solution to avoid lengthy searches through array      ! It is the best solution to avoid lengthy searches through array
690      !- vectors.      ! vectors.
691    
692      !- ARGUMENTS :      ! ARGUMENTS :
693    
694      !- pfid  : id of the file on which we work      ! pfid  : id of the file on which we work
695      !- pvarname : The name of the variable we are looking for      ! pvarname : The name of the variable we are looking for
696      !- pvid     : The var id we found      ! pvid     : The var id we found
697    
698      USE stringop, ONLY: find_str      USE stringop, ONLY: find_str
699      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
700        use histcom_var
701    
702      INTEGER, INTENT(in)  :: pfid      INTEGER, INTENT(in)  :: pfid
703      CHARACTER(LEN=*), INTENT(IN) :: pvarname      CHARACTER(LEN=*), INTENT(IN) :: pvarname
# Line 712  CONTAINS Line 715  CONTAINS
715      CHARACTER(LEN=70) :: str70      CHARACTER(LEN=70) :: str70
716      INTEGER      :: tab_str20_length(nb_var_max)      INTEGER      :: tab_str20_length(nb_var_max)
717    
718      !---------------------------------------------------------------------      !--------------------------------------------------------------------
719      nb = nb_var(pfid)      nb = nb_var(pfid)
720    
721      IF (learning(pfid)) THEN      IF (learning(pfid)) THEN
722    
723         !-- 1.0 We compute the length over which we are going         !- 1.0 We compute the length over which we are going
724         !--     to check the overlap         !-     to check the overlap
725    
726         IF (overlap(pfid) <= 0) THEN         IF (overlap(pfid) <= 0) THEN
727            IF (nb_var(pfid) > 6) THEN            IF (nb_var(pfid) > 6) THEN
# Line 728  CONTAINS Line 731  CONTAINS
731            ENDIF            ENDIF
732         ENDIF         ENDIF
733    
734         !-- 1.1 Find the position of this string         !- 1.1 Find the position of this string
735    
736         str20 = pvarname         str20 = pvarname
737         tab_str20(1:nb) = name(pfid, 1:nb)         tab_str20(1:nb) = name(pfid, 1:nb)
# Line 745  CONTAINS Line 748  CONTAINS
748                 &      TRIM(str20))                 &      TRIM(str20))
749         ENDIF         ENDIF
750    
751         !-- 1.2 If we have not given up we store the position         !- 1.2 If we have not given up we store the position
752         !--     in the sequence of calls         !-     in the sequence of calls
753    
754         IF ( varseq_err(pfid) .GE. 0 ) THEN         IF ( varseq_err(pfid) .GE. 0 ) THEN
755            sp = varseq_len(pfid)+1            sp = varseq_len(pfid)+1
# Line 766  CONTAINS Line 769  CONTAINS
769               varseq_err(pfid) = -1               varseq_err(pfid) = -1
770            ENDIF            ENDIF
771    
772            !---- 1.3 Check if we have found the right overlap            !--- 1.3 Check if we have found the right overlap
773    
774            IF (varseq_len(pfid) .GE. overlap(pfid)*2) THEN            IF (varseq_len(pfid) .GE. overlap(pfid)*2) THEN
775    
776               !------ We skip a few variables if needed as they could come               !----- We skip a few variables if needed as they could come
777               !------ from the initialisation of the model.               !----- from the initialisation of the model.
778    
779               DO ib = 0, sp-overlap(pfid)*2               DO ib = 0, sp-overlap(pfid)*2
780                  IF ( learning(pfid) .AND.&                  IF ( learning(pfid) .AND.&
# Line 788  CONTAINS Line 791  CONTAINS
791         ENDIF         ENDIF
792      ELSE      ELSE
793    
794         !-- 2.0 Now we know how the calls to histwrite are sequenced         !- 2.0 Now we know how the calls to histwrite are sequenced
795         !--     and we can get a guess at the var ID         !-     and we can get a guess at the var ID
796    
797         nx = varseq_pos(pfid)+1         nx = varseq_pos(pfid)+1
798         IF (nx > varseq_len(pfid)) nx = 1         IF (nx > varseq_len(pfid)) nx = 1
# Line 812  CONTAINS Line 815  CONTAINS
815            varseq_err(pfid) = varseq_err(pfid)+1            varseq_err(pfid) = varseq_err(pfid)+1
816         ELSE         ELSE
817    
818            !---- We only keep the new position if we have found the variable            !--- We only keep the new position if we have found the variable
819            !---- this way. This way an out of sequence call to histwrite does            !--- this way. This way an out of sequence call to histwrite does
820            !---- not defeat the process.            !--- not defeat the process.
821    
822            varseq_pos(pfid) = nx            varseq_pos(pfid) = nx
823         ENDIF         ENDIF
Legend:
Removed from v.30  
changed lines
  Added in v.31
  ViewVC Help
Powered by ViewVC 1.1.21