/[lmdze]/trunk/IOIPSL/histwrite.f90
ViewVC logotype

Diff of /trunk/IOIPSL/histwrite.f90

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

revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC revision 32 by guez, Tue Apr 6 17:52:58 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 50  CONTAINS Line 48  CONTAINS
48    
49      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
50      use calendar, only: isittime      use calendar, only: isittime
51      USE mathelp, ONLY : mathop      USE mathop_m, 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 mathop_m, 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 mathop_m, 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 mathop_m, ONLY : mathop
482        USE mathelp, ONLY : trans_buff, moycum
483      use netcdf, only: NF90_PUT_VAR      use netcdf, only: NF90_PUT_VAR
484        use histcom_var
485    
486      INTEGER, INTENT(IN) :: pfileid, pitau, varid, &      INTEGER, INTENT(IN) :: pfileid, pitau, varid, &
487           &                      nbindex, nindex(nbindex), nbdpt           &                      nbindex, nindex(nbindex), nbdpt
# Line 499  CONTAINS Line 502  CONTAINS
502      REAL, ALLOCATABLE, SAVE :: buffer_used(:)      REAL, ALLOCATABLE, SAVE :: buffer_used(:)
503      INTEGER, SAVE          :: buffer_sz      INTEGER, SAVE          :: buffer_sz
504    
505      !---------------------------------------------------------------------      !--------------------------------------------------------------------
506    
507      ! The sizes which can be encoutered      ! The sizes which can be encoutered
508    
# Line 553  CONTAINS Line 556  CONTAINS
556         i = pfileid         i = pfileid
557         nbout = nbdpt         nbout = nbdpt
558    
559         !-- 3.4 We continue the sequence of operations         !- 3.4 We continue the sequence of operations
560         !--     we started in the interface routine         !-     we started in the interface routine
561    
562         DO io = 2, nbopp(i, varid), 2         DO io = 2, nbopp(i, varid), 2
563            nbin = nbout            nbin = nbout
# Line 577  CONTAINS Line 580  CONTAINS
580              &       scsize(i, varid, 1), scsize(i, varid, 2), scsize(i, varid, 3), &              &       scsize(i, varid, 1), scsize(i, varid, 2), scsize(i, varid, 3), &
581              &       buff_tmp, buff_tmp2_sz, buff_tmp2)              &       buff_tmp, buff_tmp2_sz, buff_tmp2)
582    
583         !-- 5.0 Do the operations if needed. In the case of instantaneous         !- 5.0 Do the operations if needed. In the case of instantaneous
584         !--     output we do not transfer to the buffer.         !-     output we do not transfer to the buffer.
585    
586         ipt = point(pfileid, varid)         ipt = point(pfileid, varid)
587    
# Line 600  CONTAINS Line 603  CONTAINS
603         ncvarid = ncvar_ids(pfileid, varid)         ncvarid = ncvar_ids(pfileid, varid)
604         ncid = ncdf_ids(pfileid)         ncid = ncdf_ids(pfileid)
605    
606         !-- 6.1 Do the operations that are needed before writting         !- 6.1 Do the operations that are needed before writting
607    
608         IF (     (TRIM(tmp_opp) /= "inst") &         IF (     (TRIM(tmp_opp) /= "inst") &
609              &    .AND.(TRIM(tmp_opp) /= "once") ) THEN              &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
610            rtime = (rtime+last_wrt(pfileid, varid)*deltat(pfileid))/2.0            rtime = (rtime+last_wrt(pfileid, varid)*deltat(pfileid))/2.0
611         ENDIF         ENDIF
612    
613         !-- 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
614    
615         IF (     (TRIM(tmp_opp) /= "l_max") &         IF (     (TRIM(tmp_opp) /= "l_max") &
616              &    .AND.(TRIM(tmp_opp) /= "l_min") &              &    .AND.(TRIM(tmp_opp) /= "l_min") &
# Line 625  CONTAINS Line 628  CONTAINS
628            itime=1            itime=1
629         ENDIF         ENDIF
630    
631         !-- 6.3 Write the data. Only in the case of instantaneous output         !- 6.3 Write the data. Only in the case of instantaneous output
632         !       we do not write the buffer.         !       we do not write the buffer.
633    
634         IF (scsize(pfileid, varid, 3) == 1) THEN         IF (scsize(pfileid, varid, 3) == 1) THEN
# Line 665  CONTAINS Line 668  CONTAINS
668         last_wrt(pfileid, varid) = pitau         last_wrt(pfileid, varid) = pitau
669         nb_wrt(pfileid, varid) = nb_wrt(pfileid, varid)+1         nb_wrt(pfileid, varid) = nb_wrt(pfileid, varid)+1
670         nb_opp(pfileid, varid) = 0         nb_opp(pfileid, varid) = 0
671         !---         !--
672         !   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
673         !   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
674         !   buffering and should only be used in debuging mode. A flag is         !   buffering and should only be used in debuging mode. A flag is
675         !   needed here to switch to this mode.         !   needed here to switch to this mode.
676         !---         !--
677         !   iret = NF90_SYNC (ncid)         !   iret = NF90_SYNC (ncid)
678    
679      ENDIF      ENDIF
680      !----------------------------      !---------------------------
681    END SUBROUTINE histwrite_real    END SUBROUTINE histwrite_real
682    
683    !*************************************************************    !*************************************************************
684    
685    SUBROUTINE histvar_seq (pfid, pvarname, pvid)    SUBROUTINE histvar_seq (pfid, pvarname, pvid)
686    
687      !- This subroutine optimized the search for the variable in the table.      ! This subroutine optimized the search for the variable in the table.
688      !- In a first phase it will learn the succession of the variables      ! In a first phase it will learn the succession of the variables
689      !- 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.
690      !- It is the best solution to avoid lengthy searches through array      ! It is the best solution to avoid lengthy searches through array
691      !- vectors.      ! vectors.
692    
693      !- ARGUMENTS :      ! ARGUMENTS :
694    
695      !- pfid  : id of the file on which we work      ! pfid  : id of the file on which we work
696      !- pvarname : The name of the variable we are looking for      ! pvarname : The name of the variable we are looking for
697      !- pvid     : The var id we found      ! pvid     : The var id we found
698    
699      USE stringop, ONLY: find_str      USE find_str_m, ONLY: find_str
700      USE errioipsl, ONLY : histerr      USE errioipsl, ONLY : histerr
701        use histcom_var
702    
703      INTEGER, INTENT(in)  :: pfid      INTEGER, INTENT(in)  :: pfid
704      CHARACTER(LEN=*), INTENT(IN) :: pvarname      CHARACTER(LEN=*), INTENT(IN) :: pvarname
# Line 712  CONTAINS Line 716  CONTAINS
716      CHARACTER(LEN=70) :: str70      CHARACTER(LEN=70) :: str70
717      INTEGER      :: tab_str20_length(nb_var_max)      INTEGER      :: tab_str20_length(nb_var_max)
718    
719      !---------------------------------------------------------------------      !--------------------------------------------------------------------
720      nb = nb_var(pfid)      nb = nb_var(pfid)
721    
722      IF (learning(pfid)) THEN      IF (learning(pfid)) THEN
723    
724         !-- 1.0 We compute the length over which we are going         !- 1.0 We compute the length over which we are going
725         !--     to check the overlap         !-     to check the overlap
726    
727         IF (overlap(pfid) <= 0) THEN         IF (overlap(pfid) <= 0) THEN
728            IF (nb_var(pfid) > 6) THEN            IF (nb_var(pfid) > 6) THEN
# Line 728  CONTAINS Line 732  CONTAINS
732            ENDIF            ENDIF
733         ENDIF         ENDIF
734    
735         !-- 1.1 Find the position of this string         !- 1.1 Find the position of this string
736    
737         str20 = pvarname         str20 = pvarname
738         tab_str20(1:nb) = name(pfid, 1:nb)         tab_str20(1:nb) = name(pfid, 1:nb)
# Line 745  CONTAINS Line 749  CONTAINS
749                 &      TRIM(str20))                 &      TRIM(str20))
750         ENDIF         ENDIF
751    
752         !-- 1.2 If we have not given up we store the position         !- 1.2 If we have not given up we store the position
753         !--     in the sequence of calls         !-     in the sequence of calls
754    
755         IF ( varseq_err(pfid) .GE. 0 ) THEN         IF ( varseq_err(pfid) .GE. 0 ) THEN
756            sp = varseq_len(pfid)+1            sp = varseq_len(pfid)+1
# Line 766  CONTAINS Line 770  CONTAINS
770               varseq_err(pfid) = -1               varseq_err(pfid) = -1
771            ENDIF            ENDIF
772    
773            !---- 1.3 Check if we have found the right overlap            !--- 1.3 Check if we have found the right overlap
774    
775            IF (varseq_len(pfid) .GE. overlap(pfid)*2) THEN            IF (varseq_len(pfid) .GE. overlap(pfid)*2) THEN
776    
777               !------ We skip a few variables if needed as they could come               !----- We skip a few variables if needed as they could come
778               !------ from the initialisation of the model.               !----- from the initialisation of the model.
779    
780               DO ib = 0, sp-overlap(pfid)*2               DO ib = 0, sp-overlap(pfid)*2
781                  IF ( learning(pfid) .AND.&                  IF ( learning(pfid) .AND.&
# Line 788  CONTAINS Line 792  CONTAINS
792         ENDIF         ENDIF
793      ELSE      ELSE
794    
795         !-- 2.0 Now we know how the calls to histwrite are sequenced         !- 2.0 Now we know how the calls to histwrite are sequenced
796         !--     and we can get a guess at the var ID         !-     and we can get a guess at the var ID
797    
798         nx = varseq_pos(pfid)+1         nx = varseq_pos(pfid)+1
799         IF (nx > varseq_len(pfid)) nx = 1         IF (nx > varseq_len(pfid)) nx = 1
# Line 812  CONTAINS Line 816  CONTAINS
816            varseq_err(pfid) = varseq_err(pfid)+1            varseq_err(pfid) = varseq_err(pfid)+1
817         ELSE         ELSE
818    
819            !---- We only keep the new position if we have found the variable            !--- We only keep the new position if we have found the variable
820            !---- this way. This way an out of sequence call to histwrite does            !--- this way. This way an out of sequence call to histwrite does
821            !---- not defeat the process.            !--- not defeat the process.
822    
823            varseq_pos(pfid) = nx            varseq_pos(pfid) = nx
824         ENDIF         ENDIF
Legend:
Removed from v.30  
changed lines
  Added in v.32
  ViewVC Help
Powered by ViewVC 1.1.21