pkg/autodiff/copy_advar_outp.F

eaefeccd63 Jean*0001 #include "AUTODIFF_OPTIONS.h"
70bc3cb58c Jean*0002 #include "AD_CONFIG.h"
eaefeccd63 Jean*0003
                0004 CBOP
                0005 C !ROUTINE: COPY_ADVAR_OUTP
                0006 C !INTERFACE:
                0007       SUBROUTINE COPY_ADVAR_OUTP(
                0008      I                            inpFldRS, inpFldRL,
                0009      O                            outFld,
                0010      I                            nNz, vType, myThid )
                0011
                0012 C !DESCRIPTION:
                0013 C     Copy input AD-variable (RS or RL) into output array and then, according
                0014 C      to variable type, apply ADEXCH to output array.
                0015 C     vType (1rst digit):
                0016 C           = 1,3 : process RS input field ; = 2,4 : process RL input field
                0017 C           = 1,2 : without sign. ;          = 3,4 : with sign.
                0018 C     vType (2nd digit) = 10 : A-grid location (i.e., grid-cell center)
                0019 C                       = 20 : B-grid location (i.e., grid-cell corner)
                0020
                0021 C     !USES:
                0022       IMPLICIT NONE
                0023
                0024 C Global variables / common blocks
                0025 #include "EEPARAMS.h"
                0026 #include "SIZE.h"
                0027
                0028 C     !INPUT/OUTPUT PARAMETERS:
                0029 C Routine arguments
                0030 C inpFldRS ( RS )  :: input AD-variable field
                0031 C inpFldRL ( RL )  :: input AD-variable field
                0032 C outFld   ( RL )  :: copy of input field
                0033 C nNz     (integer):: third dimension of 3-D input/output field
                0034 C vType   (integer):: type of AD-variable (select which ADEXCH to use)
                0035 C myThid  (integer):: my Thread Id number
                0036       INTEGER nNz
                0037       _RS    inpFldRS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0038       _RL    inpFldRL(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0039       _RL    outFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0040       INTEGER vType
                0041       INTEGER myThid
                0042
                0043 #ifdef ALLOW_AUTODIFF_MONITOR
70bc3cb58c Jean*0044 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM))
eaefeccd63 Jean*0045 C !LOCAL VARIABLES:
                0046 C   i,j,k   :: loop indices
                0047 C   bi,bj   :: tile indices
                0048 C   gridloc :: advar horizontal-grid location
                0049       INTEGER i,j,k,bi,bj
                0050       INTEGER gridloc
                0051       LOGICAL wSign
                0052 CEOP
                0053
                0054       gridloc = vType/10
                0055       IF ( MOD(vType,10).LT.1 .OR. MOD(vType,10).GT.4
                0056      &      .OR. gridloc.LT.1 .OR. gridloc.GT.2 ) THEN
                0057         STOP 'ABNORMAL END: COPY_ADVAR_OUTP invalid vType'
                0058       ENDIF
                0059       wSign = MOD(vType,10).GE.3
                0060
                0061       IF ( MOD(vType,2).EQ.1 ) THEN
                0062        DO bj = myByLo(myThid), myByHi(myThid)
                0063         DO bi = myBxLo(myThid), myBxHi(myThid)
                0064          DO k=1,nNz
                0065           DO j=1-OLy,sNy+OLy
                0066            DO i=1-OLx,sNx+OLx
                0067              outFld(i,j,k,bi,bj) = inpFldRS(i,j,k,bi,bj)
                0068            ENDDO
                0069           ENDDO
                0070          ENDDO
                0071         ENDDO
                0072        ENDDO
                0073       ELSE
                0074        DO bj = myByLo(myThid), myByHi(myThid)
                0075         DO bi = myBxLo(myThid), myBxHi(myThid)
                0076          DO k=1,nNz
                0077           DO j=1-OLy,sNy+OLy
                0078            DO i=1-OLx,sNx+OLx
                0079              outFld(i,j,k,bi,bj) = inpFldRL(i,j,k,bi,bj)
                0080            ENDDO
                0081           ENDDO
                0082          ENDDO
                0083         ENDDO
                0084        ENDDO
                0085       ENDIF
                0086
61dfb3115e Jean*0087 #ifdef ALLOW_OPENAD
                0088 C--   need to all the correct OpenAD EXCH S/R ; left empty for now
                0089 #else /* ALLOW_OPENAD */
                0090
eaefeccd63 Jean*0091       IF ( gridloc.EQ.1 ) THEN
                0092        IF ( wSign ) THEN
                0093 #ifdef AUTODIFF_TAMC_COMPATIBILITY
                0094 c       CALL ADEXCH_SM_3D_RL( wSign, nNz, myThid, outFld )
                0095 #else
                0096 c       CALL ADEXCH_SM_3D_RL( outFld, wSign, nNz, myThid )
                0097 #endif
                0098         STOP 'ABNORMAL END: COPY_ADVAR_OUTP missing wSign,loc=1'
                0099        ELSE
                0100 #ifdef AUTODIFF_TAMC_COMPATIBILITY
                0101         CALL ADEXCH_3D_RL( nNz, myThid, outFld )
                0102 #else
                0103         CALL ADEXCH_3D_RL( outFld, nNz, myThid )
                0104 #endif
                0105        ENDIF
                0106       ELSEIF ( gridloc.EQ.2 ) THEN
                0107        IF ( wSign ) THEN
                0108         STOP 'ABNORMAL END: COPY_ADVAR_OUTP wSign,loc=2 not coded'
                0109        ELSE
                0110 #ifdef AUTODIFF_TAMC_COMPATIBILITY
                0111 c       CALL ADEXCH_Z_3D_RL( nNz, myThid, outFld )
                0112 #else
                0113 c       CALL ADEXCH_Z_3D_RL( outFld, nNz, myThid )
                0114 #endif
                0115         STOP 'ABNORMAL END: COPY_ADVAR_OUTP missing noSign,loc=2'
                0116        ENDIF
                0117       ENDIF
61dfb3115e Jean*0118 #endif /* ALLOW_OPENAD */
eaefeccd63 Jean*0119
70bc3cb58c Jean*0120 #endif /* ALLOW_ADJOINT_RUN or ALLOW_ADMTLM */
eaefeccd63 Jean*0121 #endif /* ALLOW_AUTODIFF_MONITOR */
                0122       RETURN
                0123       END