pkg/autodiff/dump_adj_xy.F

a10c595eb6 Timo*0001 #include "AUTODIFF_OPTIONS.h"
                0002 #include "AD_CONFIG.h"
                0003
                0004 CBOP
                0005 C !ROUTINE: DUMP_ADJ_XY
                0006 C !INTERFACE:
                0007       SUBROUTINE DUMP_ADJ_XY(
                0008      I           var2DRS, var2DRL, diagName, dumpName, vType,
                0009      I           doDump, dumpAdRec, myTime, myIter, myThid )
                0010
                0011 C !DESCRIPTION:
                0012 C     Helper subroutine to dump to file and fill corresponding diagnostics
                0013 C     for 2-D single variable given the millions of autodiff options
                0014
                0015 C !USES:
                0016       IMPLICIT NONE
                0017
                0018 C     == Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "AUTODIFF_PARAMS.h"
                0023 #ifdef ALLOW_AUTODIFF_MONITOR
                0024 # ifdef ALLOW_DIAGNOSTICS
41c4545f8f Jean*0025 #  include "DIAGNOSTICS_P2SHARE.h"
a10c595eb6 Timo*0026 # endif
                0027 #endif /* ALLOW_AUTODIFF_MONITOR */
                0028
                0029 C !INPUT/OUTPUT PARAMETERS:
                0030 C   var2DRS ( RS ) :: input 2-D AD-variable field
                0031 C   var2DRL ( RL ) :: input 2-D AD-variable field
                0032 C   diagName ( C ) :: diagnostics name
                0033 C   dumpName ( C ) :: output file prefix
                0034 C   vType  ( Int ) :: type of AD-variable (select which ADEXCH to use)
                0035 C       vType (1rst digit):
                0036 C           = 1,3 : process RS input field ; = 2,4 : process RL input field
                0037 C           = 1,2 : without sign. ;          = 3,4 : with sign.
                0038 C       vType (2nd digit) = 10 : A-grid location (i.e., grid-cell center)
                0039 C                         = 20 : B-grid location (i.e., grid-cell corner)
                0040 C   doDump   ( L ) :: do write field to file
                0041 C   dumpAdRec (I)  :: record number in file
                0042 C   myTime         :: time counter for this thread
                0043 C   myIter         :: iteration counter for this thread
                0044 C   myThid         :: Thread number for this instance of the routine.
                0045       _RS var2DRS(*)
                0046       _RL var2DRL(*)
                0047       CHARACTER*(8) diagName
                0048       CHARACTER*(*) dumpName
                0049       INTEGER vType
                0050       LOGICAL doDump
                0051       INTEGER dumpAdRec
                0052       _RL     myTime
                0053       INTEGER myIter
                0054       INTEGER myThid
                0055
                0056 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM))
                0057 #ifdef ALLOW_AUTODIFF_MONITOR
                0058
                0059 C !LOCAL VARIABLES:
                0060 C   suff           :: Hold suffix part of a filename
                0061 C   var2Dc ( RL )  :: copy of input field
                0062       CHARACTER*(10) suff
                0063       _RL var2Dc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0064 CEOP
                0065
                0066 C-----------------------------------------------------------------------
                0067 C--- Output adj variables in diagnostics
                0068 C-----------------------------------------------------------------------
                0069
                0070 C --- 1. Write out dump fields
                0071       IF ( doDump ) THEN
                0072
                0073 C--     Set suffix for this set of data files.
                0074         IF ( rwSuffixType.EQ.0 ) THEN
                0075           WRITE(suff,'(I10.10)') myIter
                0076         ELSE
                0077           CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0078         ENDIF
                0079
                0080         IF ( dumpAdVarExch.EQ.2 ) THEN
                0081
                0082 C--       Copy first
                0083           CALL COPY_ADVAR_OUTP( var2DRS, var2DRL,
                0084      &                          var2Dc, 1, vType, myThid )
                0085           IF ( dumpAdByRec ) THEN
                0086             CALL WRITE_REC_XY_RL( dumpName, var2Dc, dumpAdRec,
                0087      &                            myIter, myThid )
                0088           ELSE
                0089             CALL WRITE_FLD_XY_RL( dumpName, suff, var2Dc,
                0090      &                            myIter, myThid )
                0091           ENDIF
                0092
                0093         ELSE ! dumpAdVarExch.eq.2
                0094
                0095 C--       Write directly
                0096           IF ( MOD(vType,2).NE.1 ) THEN
                0097             IF ( dumpAdByRec ) THEN
                0098               CALL WRITE_REC_XY_RL( dumpName, var2DRL, dumpAdRec,
                0099      &                              myIter, myThid )
                0100             ELSE
                0101               CALL WRITE_FLD_XY_RL( dumpName, suff, var2DRL,
                0102      &                              myIter, myThid )
                0103             ENDIF
                0104           ELSE ! is RL
                0105             IF ( dumpAdByRec ) THEN
                0106               CALL WRITE_REC_XY_RS( dumpName, var2DRS, dumpAdRec,
                0107      &                              myIter, myThid )
                0108             ELSE
                0109               CALL WRITE_FLD_XY_RS( dumpName, suff, var2DRS,
                0110      &                              myIter, myThid )
                0111             ENDIF
                0112           ENDIF
                0113
                0114         ENDIF
                0115       ENDIF
                0116
                0117 C --- 2. Fill diagnostics
                0118 #ifdef ALLOW_DIAGNOSTICS
                0119       IF ( useDiag4AdjOutp .AND. diagName.NE.'- None -' ) THEN
                0120         IF ( dumpAdVarExch.EQ.2 ) THEN
                0121           IF ( .NOT.doDump )
                0122      &      CALL COPY_ADVAR_OUTP( var2DRS, var2DRL,
                0123      &                            var2Dc, 1, vType, myThid )
                0124           CALL DIAGNOSTICS_FILL( var2Dc, diagName, 0,1, 0,1,1, myThid )
                0125         ELSE
                0126           IF ( MOD(vType,2).NE.1 ) THEN
                0127             CALL DIAGNOSTICS_FILL( var2DRL, diagName,
                0128      &                             0, 1, 0, 1, 1, myThid )
                0129           ELSE
                0130             CALL DIAGNOSTICS_FILL_RS( var2DRS, diagName,
                0131      &                             0, 1, 0, 1, 1, myThid )
                0132           ENDIF
                0133         ENDIF
                0134       ENDIF
                0135 #endif /* ALLOW_DIAGNOSTICS */
                0136
                0137 #endif /* ALLOW_AUTODIFF_MONITOR */
                0138 #endif /* ALLOW_ADJOINT_RUN */
                0139
                0140       RETURN
                0141       END