/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_write.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_write.F

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

revision 1.1 by molod, Thu Feb 12 16:18:21 2004 UTC revision 1.24 by edhill, Wed Jul 6 02:13:52 2005 UTC
# Line 1  Line 1 
1        subroutine diagnostics_write ( nymd,nhms,nymd0,nhms0,xlabel,  C $Header$
2       .                     vars,grid,earth,ocean,land,physics,coupling,  C $Name$
      .                     diag,plist,nplist,dlist,ndlist,nrtype )  
3    
4    #include "DIAG_OPTIONS.h"
5    
6          SUBROUTINE DIAGNOSTICS_WRITE ( myTime, myIter, myThid )
7  C***********************************************************************  C***********************************************************************
8  C  Purpose  C  Purpose
9  C  -------  C  -------
10  C     Output sequence for the (multiple) diagnostics output files  C    Output sequence for the (multiple) diagnostics output files
11  C  C
12  C  Arguments  Description  C  Arguments  Description
13  C  ----------------------  C  ----------------------
14  C     nymd ..... Current   YYMMDD  C     myTime :: Current time of simulation ( s )
15  C     nhms ..... Current   HHMMSS  C     myIter :: Current Iteration Number
16  C     nymd0 .... Beginning YYMMDD  C     myThid :: my Thread Id number
 C     nhms0 .... Beginning HHMMSS  
 C     xlabel ... Character*80 Description of Experiment  
 C     jobid .... Character*8  Job Identifier  
 C     vars ..... Dynamics State Data Structure  
 C     grid ..... Dynamics Grid  Data Structure  
 C     physics .. Physics  State Data Structure  
 C     land ..... Land State     Data Structure  
 C     earth .... Earth Model    Data Structure  
 C     ocean .... Ocean Model    Data Structure  
 C     coupling . Coupling       Data Structure  
 C     diag ..... Diagnostics    Data Structure  
 C      plist ... Prognostic History List Data Structure  
 C     nplist ... Number of distinct Prognostic History Lists  
 C      dlist ... Diagnostic History List Data Structure  
 C     ndlist ... Number of distinct Diagnostic History Lists  
 C     nrtype ... Output Record Type:  0   After  Analysis or Straight Forecast  
 C                                    -1   Before Analysis  
 C                                     1   Assimilation (w/IAU)  
 C  
17  C***********************************************************************  C***********************************************************************
18  c Diagnostics Common         IMPLICIT NONE
 c -----------------  
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
21  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
22  #include "diagnostics.h"  #include "EEPARAMS.h"
23    #include "PARAMS.h"
24        integer   nrtype  
25        integer   ndlist  C     !INPUT PARAMETERS:
26        integer   nplist        _RL     myTime
27        integer   ndindx (ndiagt)        INTEGER myIter, myThid
   
       character*80 xlabel  
       character* 8 jobid  
       integer      nymd,nhms,nymd0,nhms0  
28    
29  c Local variables  c Local variables
30  c ===============  c ===============
31        integer   nd        INTEGER   n
32        integer   ndsum        INTEGER   myItM1, wrIter
33        integer   n,rc        LOGICAL   dump2fileNow, write2file
34        integer   nymdt,nhmst        _RL       phiSec, freqSec, wrTime
35    #ifdef ALLOW_CAL
36          INTEGER thisdate(4), prevdate(4)
37  c HHMMSS event timestep counter  #endif
38  c =============================  #ifdef ALLOW_FIZHI
39        integer  alarm, nalarm,  mhms        logical alarm2
40        alarm( mhms ) = nalarm ( mhms, nymd, nhms, nymd0, 0     )        character *9 tagname
41    #endif
42    
43          LOGICAL  DIFF_PHASE_MULTIPLE
44          EXTERNAL DIFF_PHASE_MULTIPLE
45    
46          IF ( myIter.NE.nIter0 ) THEN
47            myItM1 = myIter - 1
48    
49    C***********************************************************************
50    C***   Check to see IF its time for Diagnostic Output                ***
51    C***********************************************************************
52    
53    #ifdef ALLOW_CAL
54            IF ( calendarDumps ) THEN
55    C-    Determine calendar dates for this and previous time step.
56               call cal_GetDate(myiter  ,mytime            ,thisdate,mythid)
57               call cal_GetDate(myiter-1,mytime-deltaTClock,prevdate,mythid)
58            ENDIF
59    #endif
60    
61            write2file = .FALSE.
62            DO n = 1,nlists
63              freqSec = freq(n)
64              phiSec = phase(n)
65    
66              IF ( freqSec.LT.0. ) THEN
67    C--     write snap-shot with suffix = myIter to be consistent with
68    C       time-average diagnostics (e.g., freq=-1 & freq=1):
69    c           wrIter = myIter
70    c           wrTime = myTime
71    C--     write snap-shot with suffix = myIter-1 to be consistent with
72    C       state-variable time-step:
73                wrIter = myItM1
74                wrTime = myTime - deltaTclock
75              ELSE
76                wrIter = myIter
77                wrTime = myTime
78              ENDIF
79              dump2fileNow = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
80         &                                        wrTime, deltaTclock )
81    #ifdef ALLOW_FIZHI
82             if( useFIZHI) then
83              write(tagname,'(A,I2.2)')'diagtag',n
84              dump2fileNow = alarm2(tagname)
85             endif
86    #endif
87    
88  C***********************************************************************  #ifdef ALLOW_CAL
89  C*                      Check for Prognostic Output                    *            IF ( calendarDumps .AND. (
90  C***********************************************************************       &     ( freqSec.GE. 2592000 .AND. freqSec.LE. 2678400 ) .OR.
91        do n=1,nplist       &     ( freqSec.GE.31104000 .AND. freqSec.LE.31968000 ))) THEN
92        if( alarm(plist(n)%frequency).eq.0 ) then  C--   Convert approximate months (30-31 days) and years (360-372 days)
93         call progsig (nymd,nhms,nymd0,nhms0,xlabel,jobid,nrtype,plist(n),  C     to exact calendar months and years.
94       .                   vars,grid,earth,ocean,land,physics,coupling )             dump2fileNow = .FALSE.
95        endif  C-    Monthly freqSec:
96        enddo             IF( freqSec.GE. 2592000 .AND. freqSec.LE. 2678400 .AND.
97  C***********************************************************************       &        (thisdate(1)-prevdate(1)).GT.50   ) dump2fileNow = .TRUE.
98  C*                      Check for Diagnostic Output                    *  C-    Yearly  freqSec:
99  C***********************************************************************             IF( freqSec.GE.31104000 .AND. freqSec.LE.31968000 .AND.
100        do n=1,ndlist       &        (thisdate(1)-prevdate(1)).GT.5000 ) dump2fileNow = .TRUE.
101        call chkdiag(dlist(n),nymd,nhms,nymd0,nhms0,ndindx,ndsum,nymdt,            ENDIF
102       .                                  nhmst)  #endif
103        if (ndsum.ne.0) then  
104        call diagout( nymdt,nhmst,nymd0,nhms0,xlabel,ndindx,nrtype,            IF ( dump2fileNow .OR.
105       .     dlist(n),qdiag)       &        (myTime.EQ.endTime .AND. dumpatlast) ) THEN
106        endif              write2file = .TRUE.
107        enddo              CALL DIAGNOSTICS_OUT(n,wrIter,myTime,myThid)
108              ENDIF
109  c Clear Outputed Diagnostics          ENDDO
110  c --------------------------  
111        do n=1,ndlist  C---   Check to see IF its time for Statistics Diag. Output
112        call chkdiag(n,nymd,nhms,nymd0,nhms0,ndindx,ndsum,nymdt,nhmst)  
113        if (ndsum.ne.0) then          DO n = 1,diagSt_nbLists
114        call clrindx ( diag,ndindx )            freqSec = diagSt_freq(n)
115        endif            phiSec = diagSt_phase(n)
116        enddo  
117              IF ( freqSec.LT.0. ) THEN
118        return  C--     write snap-shot with suffix = myIter to be consistent with
119        end  C       time-average diagnostics (e.g., freq=-1 & freq=1):
120        subroutine chkdiag(nl,nymd,nhms,nymd0,nhms0,ndindx,ndsum,nymdt,nhmst)  c           wrIter = myIter
121        implicit none  c           wrTime = myTime
122    C--     write snap-shot with suffix = myIter-1 to be consistent with
123    C       state-variable time-step:
124                wrIter = myItM1
125                wrTime = myTime - deltaTclock
126              ELSE
127                wrIter = myIter
128                wrTime = myTime
129              ENDIF
130              dump2fileNow = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
131         &                                        wrTime, deltaTclock )
132    #ifdef ALLOW_FIZHI
133             if( useFIZHI) then
134              write(tagname,'(A,I2.2)')'diagStg',n
135              dump2fileNow = alarm2(tagname)
136             endif
137    #endif
138    
139  #include "SIZE.h"            IF ( dump2fileNow .OR.
140  #include "fizhi_SIZE.h"       &        (myTime.EQ.endTime .AND. dumpatlast) ) THEN
141  #include "diagnostics_SIZE.h"              write2file = .TRUE.
142  #include "diagnostics.h"              CALL DIAGSTATS_OUTPUT(n,wrIter,myTime,myThid)
143              ENDIF
144        integer nymd,nhms,nymd0,nhms0,nymdt,nhmst,ndsum          ENDDO
145        integer ndindx(ndiagt)  
146    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
147        integer nymdd,nhmsd,ntick,nafreq,n,m,ndum  
148        integer nsecf,nalarm          IF ( write2file ) THEN
149              IF ( debugLevel.GE.debLevB ) THEN
150        nymdt = nymd              CALL DIAGNOSTICS_SUMMARY( myTime, myIter, myThid )
151        nhmst = nhms            ENDIF
152        nymdd = nymd0  C-      wait for everyone before setting arrays to zero:
153        nhmsd = nhms0            _BARRIER
154            ENDIF
155  c Initialize Diagnostic Index  
156  c ---------------------------  C--     Clear storage space:
157        do n=1,ndiagt  
158        ndindx(n) = 0          DO n = 1,nlists
159        enddo            freqSec = freq(n)
160              phiSec = phase(n)
161  c Fill Current Diagnostic Index  
162  c -----------------------------            wrTime = myTime
163        ndsum  = 0            IF ( freqSec.LT.0. ) wrTime = myTime - deltaTclock
164        nafreq = frequency(nl)            dump2fileNow = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
165        if( nalarm( nafreq,nymd,nhms,nymdd,nhmsd ).eq.0 ) then       &                                        wrTime, deltaTclock )
166    #ifdef ALLOW_FIZHI
167        do n=1,nfield(nl)            if( useFIZHI) then
168           do m=1,ndiagt             write(tagname,'(A,I2.2)')'diagtag',n
169           if( fields(nl,n).eq.cdiag_(m) .and. idiag(m).ne.0 ) then             dump2fileNow = alarm2(tagname)
170           ndsum = ndsum  + 1            endif
171           ndindx (ndsum) = m  #endif
172    
173    #ifdef ALLOW_CAL
174              IF ( calendarDumps .AND. (
175         &     ( freqSec.GE. 2592000 .AND. freqSec.LE. 2678400 ) .OR.
176         &     ( freqSec.GE.31104000 .AND. freqSec.LE.31968000 ))) THEN
177    C--   Convert approximate months (30-31 days) and years (360-372 days)
178    C     to exact calendar months and years.
179               dump2fileNow = .FALSE.
180    C-    Monthly freqSec:
181               IF( freqSec.GE. 2592000 .AND. freqSec.LE. 2678400 .AND.
182         &        (thisdate(1)-prevdate(1)).GT.50   ) dump2fileNow = .TRUE.
183    C-    Yearly  freqSec:
184               IF( freqSec.GE.31104000 .AND. freqSec.LE.31968000 .AND.
185         &        (thisdate(1)-prevdate(1)).GT.5000 ) dump2fileNow = .TRUE.
186              ENDIF
187    #endif
188    
189              IF ( dump2fileNow .OR.
190         &        (myTime.EQ.endTime .AND. dumpatlast)
191         &       ) CALL DIAGNOSTICS_CLEAR(n,myThid)
192            ENDDO
193    
194            DO n = 1,diagSt_nbLists
195              freqSec = diagSt_freq(n)
196              phiSec = diagSt_phase(n)
197              wrTime = myTime
198              IF ( freqSec.LT.0. ) wrTime = myTime - deltaTclock
199              dump2fileNow = DIFF_PHASE_MULTIPLE( phiSec, freqSec,
200         &                                        wrTime, deltaTclock )
201    #ifdef ALLOW_FIZHI
202             if( useFIZHI) then
203              write(tagname,'(A,I2.2)')'diagStg',n
204              dump2fileNow = alarm2(tagname)
205           endif           endif
206           enddo  #endif
207        enddo            IF ( dump2fileNow .OR.
208         &        (myTime.EQ.endTime .AND. dumpatlast)
209         &       ) CALL DIAGSTATS_CLEAR( n, myThid )
210            ENDDO
211    
212        endif  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
213        return        ENDIF
       end  
214    
215        function chklist (name,list)        RETURN
216        implicit none        END
 #include "SIZE.h"  
 #include "fizhi_SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
       logical  chklist  
       character*8 name  
       integer n  
       chklist = .false.  
       do n=1,nfield(nl)  
       if( fields(nl,n).eq.name ) chklist = .true.  
       enddo  
       return  
       end  
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22