/[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.3 by molod, Thu Feb 26 22:08:49 2004 UTC
# Line 1  Line 1 
1        subroutine diagnostics_write ( nymd,nhms,nymd0,nhms0,xlabel,        subroutine diagnostics_write (myThid, myIter)
      .                     vars,grid,earth,ocean,land,physics,coupling,  
      .                     diag,plist,nplist,dlist,ndlist,nrtype )  
   
2  C***********************************************************************  C***********************************************************************
3  C  Purpose  C  Purpose
4  C  -------  C  -------
5  C     Output sequence for the (multiple) diagnostics output files  C    Output sequence for the (multiple) diagnostics output files
6  C  C
7  C  Arguments  Description  C  Arguments  Description
8  C  ----------------------  C  ----------------------
9  C     nymd ..... Current   YYMMDD  C     myIter ..... Current Iteration Number
10  C     nhms ..... Current   HHMMSS  C     myThid ..... Current Process(or)
 C     nymd0 .... Beginning YYMMDD  
 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  
11  C***********************************************************************  C***********************************************************************
12  c Diagnostics Common         implicit none
13  c -----------------  #include "CPP_OPTIONS.h"
14  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
15  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
16  #include "diagnostics.h"  #include "diagnostics.h"
17    
18        integer   nrtype        integer myThid, myIter
       integer   ndlist  
       integer   nplist  
       integer   ndindx (ndiagt)  
   
       character*80 xlabel  
       character* 8 jobid  
       integer      nymd,nhms,nymd0,nhms0  
19    
20  c Local variables  c Local variables
21  c ===============  c ===============
22        integer   nd        integer   n
       integer   ndsum  
       integer   n,rc  
       integer   nymdt,nhmst  
   
   
 c HHMMSS event timestep counter  
 c =============================  
       integer  alarm, nalarm,  mhms  
       alarm( mhms ) = nalarm ( mhms, nymd, nhms, nymd0, 0     )  
23    
24  C***********************************************************************  C***********************************************************************
25  C*                      Check for Prognostic Output                    *  C***   Check to see if its time for Diagnostic Output                ***
 C***********************************************************************  
       do n=1,nplist  
       if( alarm(plist(n)%frequency).eq.0 ) then  
        call progsig (nymd,nhms,nymd0,nhms0,xlabel,jobid,nrtype,plist(n),  
      .                   vars,grid,earth,ocean,land,physics,coupling )  
       endif  
       enddo  
 C***********************************************************************  
 C*                      Check for Diagnostic Output                    *  
26  C***********************************************************************  C***********************************************************************
27        do n=1,ndlist        do n=1,nlists
28        call chkdiag(dlist(n),nymd,nhms,nymd0,nhms0,ndindx,ndsum,nymdt,        if ( mod(freq(n),myIter).eq.0 ) then
29       .                                  nhmst)         call diagout(myThid,myIter,n)
30        if (ndsum.ne.0) then         call clrindx(myThid,n)
       call diagout( nymdt,nhmst,nymd0,nhms0,xlabel,ndindx,nrtype,  
      .     dlist(n),qdiag)  
31        endif        endif
32        enddo        enddo
33    
 c Clear Outputed Diagnostics  
 c --------------------------  
       do n=1,ndlist  
       call chkdiag(n,nymd,nhms,nymd0,nhms0,ndindx,ndsum,nymdt,nhmst)  
       if (ndsum.ne.0) then  
       call clrindx ( diag,ndindx )  
       endif  
       enddo  
   
       return  
       end  
       subroutine chkdiag(nl,nymd,nhms,nymd0,nhms0,ndindx,ndsum,nymdt,nhmst)  
       implicit none  
   
 #include "SIZE.h"  
 #include "fizhi_SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
   
       integer nymd,nhms,nymd0,nhms0,nymdt,nhmst,ndsum  
       integer ndindx(ndiagt)  
   
       integer nymdd,nhmsd,ntick,nafreq,n,m,ndum  
       integer nsecf,nalarm  
   
       nymdt = nymd  
       nhmst = nhms  
       nymdd = nymd0  
       nhmsd = nhms0  
   
 c Initialize Diagnostic Index  
 c ---------------------------  
       do n=1,ndiagt  
       ndindx(n) = 0  
       enddo  
   
 c Fill Current Diagnostic Index  
 c -----------------------------  
       ndsum  = 0  
       nafreq = frequency(nl)  
       if( nalarm( nafreq,nymd,nhms,nymdd,nhmsd ).eq.0 ) then  
   
       do n=1,nfield(nl)  
          do m=1,ndiagt  
          if( fields(nl,n).eq.cdiag_(m) .and. idiag(m).ne.0 ) then  
          ndsum = ndsum  + 1  
          ndindx (ndsum) = m  
          endif  
          enddo  
       enddo  
   
       endif  
       return  
       end  
   
       function chklist (name,list)  
       implicit none  
 #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  
34        return        return
35        end        end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22