pkg/matrix/matrix_write_tendency.F

5d0c92356b Jean*0001 #include "MATRIX_OPTIONS.h"
a9544d2f65 Sama*0002
                0003 C !ROUTINE MATRIX_WRITE_TENDENCY.F
8f6dc1243d Jean*0004 C This routine writes both the explicit and implicit matrices
a9544d2f65 Sama*0005 C to file.
                0006
                0007       SUBROUTINE MATRIX_WRITE_TENDENCY( myTime, myIter, myThid )
8f6dc1243d Jean*0008
a9544d2f65 Sama*0009       IMPLICIT NONE
8f6dc1243d Jean*0010 #include "SIZE.h"
a9544d2f65 Sama*0011 #include "EEPARAMS.h"
                0012 #include "PARAMS.h"
8f6dc1243d Jean*0013 #include "PTRACERS_SIZE.h"
                0014 #include "PTRACERS_PARAMS.h"
                0015 #include "MATRIX.h"
                0016
a9544d2f65 Sama*0017       _RL myTime
                0018       INTEGER myIter
                0019       INTEGER myThid
                0020
                0021 #ifdef ALLOW_MATRIX
                0022
5d0c92356b Jean*0023       LOGICAL  DIFFERENT_MULTIPLE
                0024       EXTERNAL DIFFERENT_MULTIPLE
                0025
a9544d2f65 Sama*0026       INTEGER bi,bj,i,j,k,iTracer,iRec
5d0c92356b Jean*0027       CHARACTER*(MAX_LEN_FNAM) suff
                0028       CHARACTER*(MAX_LEN_MBUF) msgBuf
a9544d2f65 Sama*0029       _RL recipImpMatrixCounter, recipExpDeltaTtracer
                0030
5d0c92356b Jean*0031 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
a9544d2f65 Sama*0032
5d0c92356b Jean*0033       IF ( DIFFERENT_MULTIPLE(expMatrixWriteTime,myTime,deltaTClock)
                0034      &   ) THEN
                0035         bj=myByLo(myThid)
                0036         bi=myBxLo(myThid)
                0037         recipExpDeltaTtracer = expMatrixCounter(bi,bj)*dTtracerLev(1)
                0038         recipExpDeltaTtracer = 1. _d 0 / recipExpDeltaTtracer
                0039         iRec = expMatrixWriteCount
a9544d2f65 Sama*0040         DO iTracer=1,PTRACERS_numInUse
5d0c92356b Jean*0041           DO bj=myByLo(myThid),myByHi(myThid)
                0042            DO bi=myBxLo (myThid),myBxHi(myThid)
                0043              DO k=1,Nr
2c18da0d62 Jean*0044               DO j=1-OLy, sNy+OLy
                0045                DO i=1-OLx, sNx+OLx
5d0c92356b Jean*0046                  MATRIX(i,j,k,bi,bj,iTracer,1) =
8385b3bb5f Ed H*0047      &                   MATRIX(i,j,k,bi,bj,iTracer,1)
                0048      &                   *recipExpDeltaTtracer
5d0c92356b Jean*0049                ENDDO
a9544d2f65 Sama*0050               ENDDO
5d0c92356b Jean*0051              ENDDO
                0052            ENDDO
a9544d2f65 Sama*0053           ENDDO
2c18da0d62 Jean*0054           _BEGIN_MASTER(myThid)
5d0c92356b Jean*0055           bj=myByLo(myThid)
                0056           bi=myBxLo(myThid)
                0057           WRITE(msgBuf,'(A,I4,2I6)') 'Writing explicit matrix :',
                0058      &       iTracer, expMatrixWriteCount, expMatrixCounter(bi,bj)
                0059           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0060      &                        SQUEEZE_RIGHT, myThid )
2c18da0d62 Jean*0061           _END_MASTER(myThid)
a9544d2f65 Sama*0062           WRITE(suff,'(A9,I2.2)') 'MATRIXEXP',iTracer
                0063           CALL WRITE_REC_XYZ_RL(suff,
2c18da0d62 Jean*0064      &         MATRIX(1-OLx,1-OLy,1,1,1,iTracer,1),iRec,myIter,myThid)
a9544d2f65 Sama*0065         ENDDO
5d0c92356b Jean*0066         _BARRIER
                0067         _BEGIN_MASTER(myThid)
                0068          expMatrixWriteCount = expMatrixWriteCount + 1
                0069         _END_MASTER(myThid)
                0070
a9544d2f65 Sama*0071 C       Reset explicit matrix
5d0c92356b Jean*0072         DO bj=myByLo(myThid),myByHi(myThid)
                0073          DO bi=myBxLo (myThid),myBxHi(myThid)
                0074            expMatrixCounter(bi,bj) = 0
                0075          ENDDO
                0076         ENDDO
a9544d2f65 Sama*0077         DO iTracer=1,PTRACERS_numInUse
5d0c92356b Jean*0078           DO bj=myByLo(myThid),myByHi(myThid)
                0079            DO bi=myBxLo (myThid),myBxHi(myThid)
                0080              DO k=1,Nr
2c18da0d62 Jean*0081               DO j=1-OLy, sNy+OLy
                0082                DO i=1-OLx, sNx+OLx
5d0c92356b Jean*0083                  MATRIX(i,j,k,bi,bj,iTracer,1) = 0. _d 0
                0084                ENDDO
a9544d2f65 Sama*0085               ENDDO
5d0c92356b Jean*0086              ENDDO
                0087            ENDDO
a9544d2f65 Sama*0088           ENDDO
                0089         ENDDO
                0090       ENDIF
8f6dc1243d Jean*0091
5d0c92356b Jean*0092       IF ( DIFFERENT_MULTIPLE(impMatrixWriteTime,myTime,deltaTClock)
                0093      &   ) THEN
                0094         bj=myByLo(myThid)
                0095         bi=myBxLo(myThid)
                0096         recipImpMatrixCounter = impMatrixCounter(bi,bj)
                0097         recipImpMatrixCounter = 1. _d 0 / recipImpMatrixCounter
                0098         iRec = impMatrixWriteCount
a9544d2f65 Sama*0099         DO iTracer=1,PTRACERS_numInUse
                0100           DO bj=myByLo(myThid), myByHi (myThid)
5d0c92356b Jean*0101            DO bi=myBxLo (myThid), myBxHi (myThid)
                0102              DO k=1,Nr
2c18da0d62 Jean*0103               DO j=1-OLy, sNy+OLy
                0104                DO i=1-OLx, sNx+OLx
5d0c92356b Jean*0105                  MATRIX(i,j,k,bi,bj,iTracer,2) =
8385b3bb5f Ed H*0106      &                   MATRIX(i,j,k,bi,bj,iTracer,2)
                0107      &                   *recipImpMatrixCounter
5d0c92356b Jean*0108                ENDDO
a9544d2f65 Sama*0109               ENDDO
5d0c92356b Jean*0110              ENDDO
                0111            ENDDO
a9544d2f65 Sama*0112           ENDDO
2c18da0d62 Jean*0113           _BEGIN_MASTER(myThid)
5d0c92356b Jean*0114           bj=myByLo(myThid)
                0115           bi=myBxLo(myThid)
                0116           WRITE(msgBuf,'(A,I4,2I6)') 'Writing implicit matrix :',
                0117      &       iTracer, impMatrixWriteCount, impMatrixCounter(bi,bj)
                0118           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0119      &                        SQUEEZE_RIGHT, myThid )
2c18da0d62 Jean*0120           _END_MASTER(myThid)
a9544d2f65 Sama*0121           WRITE(suff,'(A9,I2.2)') 'MATRIXIMP',iTracer
                0122           CALL WRITE_REC_XYZ_RL(suff,
2c18da0d62 Jean*0123      &         MATRIX(1-OLx,1-OLy,1,1,1,iTracer,2),iRec,myIter,myThid)
8f6dc1243d Jean*0124         ENDDO
5d0c92356b Jean*0125         _BARRIER
                0126         _BEGIN_MASTER(myThid)
                0127          impMatrixWriteCount = impMatrixWriteCount + 1
                0128         _END_MASTER(myThid)
                0129
8f6dc1243d Jean*0130 C       Reset implicit matrix
5d0c92356b Jean*0131         DO bj=myByLo(myThid),myByHi(myThid)
                0132          DO bi=myBxLo (myThid),myBxHi(myThid)
                0133            impMatrixCounter(bi,bj) = 0
                0134          ENDDO
                0135         ENDDO
a9544d2f65 Sama*0136         DO iTracer=1,PTRACERS_numInUse
                0137           DO bj=myByLo(myThid), myByHi (myThid)
5d0c92356b Jean*0138            DO bi=myBxLo (myThid), myBxHi (myThid)
                0139              DO k=1,Nr
2c18da0d62 Jean*0140               DO j=1-OLy, sNy+OLy
                0141                DO i=1-OLx, sNx+OLx
5d0c92356b Jean*0142                  MATRIX(i,j,k,bi,bj,iTracer,2) = 0. _d 0
                0143                ENDDO
a9544d2f65 Sama*0144               ENDDO
5d0c92356b Jean*0145              ENDDO
                0146            ENDDO
a9544d2f65 Sama*0147           ENDDO
8f6dc1243d Jean*0148         ENDDO
a9544d2f65 Sama*0149       ENDIF
8f6dc1243d Jean*0150
a9544d2f65 Sama*0151 #endif /* ALLOW_MATRIX */
8f6dc1243d Jean*0152       RETURN
a9544d2f65 Sama*0153       END