Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:38:00 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
eaefeccd63 Jean*0001 #include "AUTODIFF_OPTIONS.h"
70bc3cb58c Jean*0002 #include "AD_CONFIG.h"
eaefeccd63 Jean*0003 
                0004 CBOP
                0005 C !ROUTINE: COPY_AD_UV_OUTP
                0006 C !INTERFACE:
                0007       SUBROUTINE COPY_AD_UV_OUTP(
                0008      I                            uFldRS, vFldRS,  uFldRL, vFldRL,
                0009      O                            uFldOut, vFldOut,
                0010      I                            nNz, vType, myThid )
                0011 
                0012 C !DESCRIPTION:
                0013 C     Copy 2-components input AD-variable (RS or RL) into output array and then,
                0014 C      according 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 C                       = 30 : C-grid location ; = 40 : D-grid location
                0021 
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024 
                0025 C Global variables / common blocks
                0026 #include "EEPARAMS.h"
                0027 #include "SIZE.h"
                0028 
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C Routine arguments
                0031 C uFldRS   ( RS )  :: input AD-vector field, 1rst component
                0032 C vFldRS   ( RS )  :: input AD-vector field, 2nd  component
                0033 C uFldRL   ( RL )  :: input AD-vector field, 1rst component
                0034 C vFldRL   ( RL )  :: input AD-vector field, 2nd  component
                0035 C uFldOut  ( RL )  :: copy of input field, 1rst component
                0036 C vFldOut  ( RL )  :: copy of input field, 1rst component
                0037 C nNz     (integer):: third dimension of 3-D input/output field
                0038 C vType   (integer):: type of AD-variable (select which ADEXCH to use)
                0039 C myThid  (integer):: my Thread Id number
                0040       INTEGER nNz
                0041       _RS    uFldRS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0042       _RS    vFldRS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0043       _RL    uFldRL (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0044       _RL    vFldRL (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0045       _RL    uFldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0046       _RL    vFldOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nNz,nSx,nSy)
                0047       INTEGER vType
                0048       INTEGER myThid
                0049 
                0050 #ifdef ALLOW_AUTODIFF_MONITOR
70bc3cb58c Jean*0051 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM))
eaefeccd63 Jean*0052 C !LOCAL VARIABLES:
                0053 C   i,j,k   :: loop indices
                0054 C   bi,bj   :: tile indices
                0055 C   gridloc :: advar horizontal-grid location
                0056       INTEGER i,j,k,bi,bj
                0057       INTEGER gridloc
                0058       LOGICAL wSign
                0059 CEOP
                0060 
                0061       gridloc = vType/10
                0062       IF ( MOD(vType,10).LT.1 .OR. MOD(vType,10).GT.4
                0063      &      .OR. gridloc.LT.1 .OR. gridloc.GT.4 ) THEN
                0064         STOP 'ABNORMAL END: COPY_AD_UV_OUTP invalid vType'
                0065       ENDIF
                0066       wSign = MOD(vType,10).GE.3
                0067 
                0068       IF ( MOD(vType,2).EQ.1 ) THEN
                0069        DO bj = myByLo(myThid), myByHi(myThid)
                0070         DO bi = myBxLo(myThid), myBxHi(myThid)
                0071          DO k=1,nNz
                0072           DO j=1-OLy,sNy+OLy
                0073            DO i=1-OLx,sNx+OLx
                0074              uFldOut(i,j,k,bi,bj) = uFldRS(i,j,k,bi,bj)
                0075              vFldOut(i,j,k,bi,bj) = vFldRS(i,j,k,bi,bj)
                0076            ENDDO
                0077           ENDDO
                0078          ENDDO
                0079         ENDDO
                0080        ENDDO
                0081       ELSE
                0082        DO bj = myByLo(myThid), myByHi(myThid)
                0083         DO bi = myBxLo(myThid), myBxHi(myThid)
                0084          DO k=1,nNz
                0085           DO j=1-OLy,sNy+OLy
                0086            DO i=1-OLx,sNx+OLx
                0087              uFldOut(i,j,k,bi,bj) = uFldRL(i,j,k,bi,bj)
                0088              vFldOut(i,j,k,bi,bj) = vFldRL(i,j,k,bi,bj)
                0089            ENDDO
                0090           ENDDO
                0091          ENDDO
                0092         ENDDO
                0093        ENDDO
                0094       ENDIF
                0095 
61dfb3115e Jean*0096 #ifdef ALLOW_OPENAD
                0097 C--   need to all the correct OpenAD EXCH S/R ; left empty for now
                0098 #else /* ALLOW_OPENAD */
                0099 
eaefeccd63 Jean*0100       IF ( gridloc.EQ.1 ) THEN
                0101 #ifdef AUTODIFF_TAMC_COMPATIBILITY
                0102 c       CALL ADEXCH_UV_AGRID_3D_RL( wSign,nNz,myThid, uFldOut,vFldOut )
                0103 #else
                0104 c       CALL ADEXCH_UV_AGRID_3D_RL( uFldOut,vFldOut, wSign,nNz,myThid )
                0105 #endif
                0106         STOP 'ABNORMAL END: COPY_AD_UV_OUTP missing vType=11-14'
                0107       ELSEIF ( gridloc.EQ.2 ) THEN
                0108 #ifdef AUTODIFF_TAMC_COMPATIBILITY
                0109 c       CALL ADEXCH_UV_BGRID_3D_RL( wSign,nNz,myThid, uFldOut,vFldOut )
                0110 #else
                0111 c       CALL ADEXCH_UV_BGRID_3D_RL( uFldOut,vFldOut, wSign,nNz,myThid )
                0112 #endif
                0113         STOP 'ABNORMAL END: COPY_AD_UV_OUTP missing vType=21-24'
                0114       ELSEIF ( gridloc.EQ.3 ) THEN
                0115 #ifdef AUTODIFF_TAMC_COMPATIBILITY
                0116         CALL ADEXCH_UV_3D_RL( wSign,nNz,myThid, uFldOut,vFldOut )
                0117 #else
                0118         CALL ADEXCH_UV_3D_RL( uFldOut,vFldOut, wSign,nNz,myThid )
                0119 #endif
                0120       ELSEIF ( gridloc.EQ.4 ) THEN
                0121 #ifdef AUTODIFF_TAMC_COMPATIBILITY
                0122 c       CALL ADEXCH_UV_DGRID_3D_RL( wSign,nNz,myThid, uFldOut,vFldOut )
                0123 #else
                0124 c       CALL ADEXCH_UV_DGRID_3D_RL( uFldOut,vFldOut, wSign,nNz,myThid )
                0125 #endif
                0126         STOP 'ABNORMAL END: COPY_AD_UV_OUTP missing vType=41-44'
                0127       ENDIF
                0128 
61dfb3115e Jean*0129 #endif /* ALLOW_OPENAD */
                0130 
70bc3cb58c Jean*0131 #endif /* ALLOW_ADJOINT_RUN or ALLOW_ADMTLM */
eaefeccd63 Jean*0132 #endif /* ALLOW_AUTODIFF_MONITOR */
                0133       RETURN
                0134       END