pkg/autodiff/dump_adj_xyz.F

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