pkg/ptracers/ptracers_write_timeave.F

55966bc737 Mart*0001 #include "PTRACERS_OPTIONS.h"
                0002
                0003 CBOP 1
                0004 C     !ROUTINE: PTRACERS_WRITE_TIMEAVE
                0005
                0006 C     !INTERFACE:
bcfd640adc Jean*0007       SUBROUTINE PTRACERS_WRITE_TIMEAVE( myTime, myIter, myThid )
55966bc737 Mart*0008
                0009 C     !DESCRIPTION:
                0010 C     At the end of average period, write the time-average
                0011 C     state-variables on file; then reset for next period
                0012
                0013 C     !USES:
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
                0018 #include "PTRACERS_SIZE.h"
0a278985fd Jean*0019 #include "PTRACERS_PARAMS.h"
bcfd640adc Jean*0020 #include "PTRACERS_TAVE.h"
                0021
                0022 C     !FUNCTIONS:
94a46dfe0d Jean*0023       LOGICAL  DIFFERENT_MULTIPLE
                0024       EXTERNAL DIFFERENT_MULTIPLE
55966bc737 Mart*0025       INTEGER  IO_ERRCOUNT
                0026       EXTERNAL IO_ERRCOUNT
                0027
                0028 C     !INPUT PARAMETERS:
bcfd640adc Jean*0029 C     myTime  :: Current time of simulation ( s )
                0030 C     myIter  :: Iteration number
                0031 C     myThid  :: my Thread Id number
55966bc737 Mart*0032       _RL     myTime
d197c88195 Jean*0033       INTEGER myIter
                0034       INTEGER myThid
55966bc737 Mart*0035 CEOP
                0036
                0037 #if ( defined ALLOW_PTRACERS && defined ALLOW_TIMEAVE )
                0038
                0039 C     !LOCAL VARIABLES:
                0040 C     suff    ::  Hold suffix part of a filename
0676f3988d Jean*0041       CHARACTER*(10) suff
                0042       CHARACTER*(MAX_LEN_FNAM) prefix
bcfd640adc Jean*0043       INTEGER bi, bj, iTr
55966bc737 Mart*0044       INTEGER beginIOErrCount
                0045       INTEGER endIOErrCount
                0046       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0047 #ifdef ALLOW_MNC
bcfd640adc Jean*0048       INTEGER jj, ilnb
55966bc737 Mart*0049 C     Functions
bcfd640adc Jean*0050       INTEGER  ILNBLNK
                0051       EXTERNAL ILNBLNK
b22b541fe9 Ed H*0052       CHARACTER*(1) pf
55966bc737 Mart*0053 #endif /*  ALLOW_MNC  */
                0054
bcfd640adc Jean*0055 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0056
55966bc737 Mart*0057 C     Final Time Averages and Dump Files if needed
94a46dfe0d Jean*0058       IF ( DIFFERENT_MULTIPLE( PTRACERS_taveFreq, myTime, deltaTClock )
                0059      &   ) THEN
d197c88195 Jean*0060
55966bc737 Mart*0061         DO bj = myByLo(myThid), myByHi(myThid)
                0062           DO bi = myBxLo(myThid), myBxHi(myThid)
bcfd640adc Jean*0063 C--         Normalize by integrated time
                0064             DO iTr=1,PTRACERS_numInUse
                0065               CALL TIMEAVE_NORMALIZE(
0676f3988d Jean*0066      &                     ptracerFluxtave(1-OLx,1-OLy,  1,1,iTr),
bcfd640adc Jean*0067      &                     ptracer_full,  1, bi, bj, myThid )
                0068               CALL TIMEAVE_NORMALIZE(
0676f3988d Jean*0069      &                     ptracertave    (1-OLx,1-OLy,1,1,1,iTr),
bcfd640adc Jean*0070      &                     ptracer_half, Nr, bi, bj, myThid )
55966bc737 Mart*0071             ENDDO
                0072           ENDDO
                0073         ENDDO
                0074
bcfd640adc Jean*0075 C--     Write to files
55966bc737 Mart*0076
                0077 #ifdef ALLOW_MNC
50653b81f1 Ed H*0078         IF ( PTRACERS_timeave_mnc ) THEN
b22b541fe9 Ed H*0079           IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
                0080             pf(1:1) = 'D'
                0081           ELSE
                0082             pf(1:1) = 'R'
                0083           ENDIF
55966bc737 Mart*0084           CALL MNC_CW_SET_UDIM('ptr_tave', -1, myThid)
987ff12cb6 Ed H*0085           CALL MNC_CW_RL_W_S('D','ptr_tave',0,0,'T',myTime,myThid)
55966bc737 Mart*0086           CALL MNC_CW_SET_UDIM('ptr_tave', 0, myThid)
987ff12cb6 Ed H*0087           CALL MNC_CW_I_W_S('I','ptr_tave',0,0,'iter',myIter,myThid)
                0088
55966bc737 Mart*0089           CALL MNC_CW_SET_UDIM('ptr_flux_tave', -1, myThid)
987ff12cb6 Ed H*0090           CALL MNC_CW_RL_W_S('D','ptr_flux_tave',0,0,'T',myTime,
55966bc737 Mart*0091      &         myThid)
                0092           CALL MNC_CW_SET_UDIM('ptr_flux_tave', 0, myThid)
987ff12cb6 Ed H*0093           CALL MNC_CW_I_W_S('I','ptr_flux_tave',0,0,'iter',myIter,
                0094      &         myThid)
                0095
bcfd640adc Jean*0096           DO iTr = 1,PTRACERS_numInUse
                0097             CALL MNC_CW_RL_W(pf,'ptr_tave',0,0,PTRACERS_names(iTr),
                0098      &           ptracertave(1-OLx,1-OLy,1,1,1,iTr),myThid)
55966bc737 Mart*0099             DO jj = 1,MAX_LEN_FNAM
0676f3988d Jean*0100               prefix(jj:jj) = ' '
55966bc737 Mart*0101             ENDDO
bcfd640adc Jean*0102             ilnb = ILNBLNK(PTRACERS_names(iTr))
0676f3988d Jean*0103             WRITE(prefix,'(A,A)') 'surf_',PTRACERS_names(iTr)(1:ilnb)
                0104             CALL MNC_CW_RL_W(pf,'ptr_flux_tave',0,0, prefix,
bcfd640adc Jean*0105      &           ptracerFluxtave(1-OLx,1-OLy,1,1,iTr),myThid)
55966bc737 Mart*0106           ENDDO
                0107         ENDIF
                0108 #endif /*  ALLOW_MNC  */
                0109
50653b81f1 Ed H*0110         IF ( PTRACERS_timeave_mdsio ) THEN
d197c88195 Jean*0111
55966bc737 Mart*0112 C         Read IO error counter
                0113           beginIOErrCount = IO_ERRCOUNT(myThid)
d197c88195 Jean*0114
0676f3988d Jean*0115           IF ( rwSuffixType.EQ.0 ) THEN
                0116             WRITE(suff,'(I10.10)') myIter
                0117           ELSE
                0118             CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0119           ENDIF
                0120
bcfd640adc Jean*0121           DO iTr=1,PTRACERS_numInUse
0676f3988d Jean*0122             WRITE(prefix,'(A11,I2.2,A1)') 'PtrFluxtave', iTr, '.'
                0123             CALL WRITE_FLD_XY_RL ( prefix, suff,
                0124      &                 ptracerFluxtave(1-OLx,1-OLy,  1,1,iTr),
bcfd640adc Jean*0125      &                 myIter, myThid )
0676f3988d Jean*0126             WRITE(prefix,'(A7, I2.2,A1)') 'PTRtave', iTr, '.'
                0127             CALL WRITE_FLD_XYZ_RL( prefix, suff,
                0128      &                 ptracertave    (1-OLx,1-OLy,1,1,1,iTr),
bcfd640adc Jean*0129      &                 myIter, myThid )
d197c88195 Jean*0130           ENDDO
55966bc737 Mart*0131
                0132 C         Reread IO error counter
                0133           endIOErrCount = IO_ERRCOUNT(myThid)
d197c88195 Jean*0134
55966bc737 Mart*0135 C         Check for IO errors
                0136           IF ( endIOErrCount .NE. beginIOErrCount ) THEN
d197c88195 Jean*0137 C-          any thread that detects an error should report
55966bc737 Mart*0138             WRITE(msgBuf,'(A)')  'S/R PTRACERS_WRITE_TIMEAVE'
d197c88195 Jean*0139             CALL PRINT_ERROR( msgBuf, myThid )
55966bc737 Mart*0140             WRITE(msgBuf,'(A)')  'Error writing out data'
d197c88195 Jean*0141             CALL PRINT_ERROR( msgBuf, myThid )
55966bc737 Mart*0142             WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
d197c88195 Jean*0143             CALL PRINT_ERROR( msgBuf, myThid )
55966bc737 Mart*0144           ELSE
d197c88195 Jean*0145 C-          normal case: 1 message is enough
                0146             _BEGIN_MASTER( myThid )
                0147             WRITE(msgBuf,'(A,I10)')
55966bc737 Mart*0148      &           '// PTRACER time-average data written, t-step', myIter
d197c88195 Jean*0149             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0150      &           SQUEEZE_RIGHT, myThid )
55966bc737 Mart*0151             WRITE(msgBuf,'(A)')  ' '
d197c88195 Jean*0152             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0153      &           SQUEEZE_RIGHT, myThid )
                0154             _END_MASTER( myThid )
55966bc737 Mart*0155           ENDIF
d197c88195 Jean*0156
55966bc737 Mart*0157         ENDIF
                0158
                0159         DO bj = myByLo(myThid), myByHi(myThid)
                0160           DO bi = myBxLo(myThid), myBxHi(myThid)
                0161
                0162 C           Like before the 1rst iteration,
bcfd640adc Jean*0163 C           ==> call TIMEAVE_TIMEAVE with myIter=nIter0 :
55966bc737 Mart*0164 C           1) Reset the averages to zero ;
                0165 C           2) Start to cumulate state-variables with Half time step.
                0166
bcfd640adc Jean*0167             CALL PTRACERS_TIMEAVE( myTime, nIter0, bi, bj, myThid )
55966bc737 Mart*0168
                0169           ENDDO
                0170         ENDDO
                0171
                0172       ENDIF
d197c88195 Jean*0173
55966bc737 Mart*0174 #endif /* ALLOW_PTRACERS and ALLOW_TIMEAVE */
                0175
                0176       RETURN
                0177       END