Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:45:05 UTC

view on githubraw file Latest commit e17e409e on 2016-03-18 19:17:35 UTC
b2f1d2f236 Dani*0001 #include "STREAMICE_OPTIONS.h"
847eec441b Dani*0002 
                0003       SUBROUTINE template()
                0004       use OAD_cp
                0005       use OAD_tape
                0006       use OAD_rev
                0007 
                0008 C
                0009 C     **** Global Variables & Derived Type Definitions ****
                0010 C
                0011 
                0012 C
                0013 C     **** Parameters and Result ****
                0014 C
b11fa21b0e Dani*0015 #if (defined (ALLOW_STREAMICE_OAD_FP)) 
847eec441b Dani*0016 
e17e409e24 Dani*0017        err_max = 0. _d 0       
                0018        err_sum = 0. _d 0
                0019        if (streamice_err_norm .lt. 1. _d 0) conj_norm = 1.0
                0020        if (streamice_err_norm .eq. 1. _d 0) conj_norm = 0.0
                0021        if (streamice_err_norm .gt. 1. _d 0) conj_norm = 
                0022      & streamice_err_norm / (streamice_err_norm - 1.0)  
                0023 
                0024        DO bj = myByLo(myThid), myByHi(myThid)
                0025         DO bi = myBxLo(myThid), myBxHi(myThid)
                0026          err_sum_tile(bi,bj) = 0. _d 0  
                0027         ENDDO
                0028        ENDDO
                0029 
847eec441b Dani*0030 
                0031       if (our_rev_mode%plain) then
e17e409e24 Dani*0032        
                0033        if (streamice_err_norm .lt. 1.0) then
847eec441b Dani*0034 
                0035        DO bj = myByLo(myThid), myByHi(myThid)
                0036         DO bi = myBxLo(myThid), myBxHi(myThid)
                0037          DO j=1,sNy
                0038           DO i=1,sNx
                0039            err_tempu = 0. _d 0
                0040            err_tempv = 0. _d 0
                0041            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0042             err_tempu =
                0043      &       ABS (U_streamice(i,j,bi,bj)%v-u_new_SI(i,j,bi,bj)%v)
                0044            ENDIF
                0045            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0046             err_tempv = MAX( err_tempu,
                0047      &       ABS (V_streamice(i,j,bi,bj)%v-v_new_SI(i,j,bi,bj)%v))
                0048            ENDIF
                0049            IF (err_tempv .ge. err_max) err_max = err_tempv
                0050           ENDDO
                0051          ENDDO
                0052         ENDDO
                0053        ENDDO
                0054 
                0055        CALL GLOBAL_MAX_R8 (err_max, myThid)
e17e409e24 Dani*0056 
                0057        ELSE
                0058 
                0059        DO bj = myByLo(myThid), myByHi(myThid)
                0060         DO bi = myBxLo(myThid), myBxHi(myThid)
                0061          DO j=1,sNy
                0062           DO i=1,sNx
                0063            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0064             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) + 
                0065      &       (ABS(U_streamice(i,j,bi,bj)%v-
                0066      &              u_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0067            ENDIF
                0068            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0069             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) + 
                0070      &       (ABS(v_streamice(i,j,bi,bj)%v-
                0071      &              v_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0072            ENDIF
                0073           ENDDO
                0074          ENDDO
                0075         ENDDO
                0076        ENDDO
                0077 
                0078        CALL GLOBAL_SUM_TILE_RL( err_sum_tile, err_sum, myThid )
                0079 
                0080        err_max = err_sum ** (1./streamice_err_norm)
                0081 
                0082        ENDIF
                0083 
847eec441b Dani*0084       end if
                0085       
                0086 
                0087       if (our_rev_mode%tape) then
                0088       
e17e409e24 Dani*0089        IF (streamice_err_norm .lt. 1.0) then
847eec441b Dani*0090 
                0091        DO bj = myByLo(myThid), myByHi(myThid)
                0092         DO bi = myBxLo(myThid), myBxHi(myThid)
                0093          DO j=1,sNy
                0094           DO i=1,sNx
                0095            err_tempu = 0. _d 0
                0096            err_tempv = 0. _d 0
                0097            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0098             err_tempu =
                0099      &       ABS (U_streamice(i,j,bi,bj)%v-u_new_SI(i,j,bi,bj)%v)
                0100            ENDIF
                0101            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0102             err_tempv = MAX( err_tempu,
                0103      &       ABS (V_streamice(i,j,bi,bj)%v-v_new_SI(i,j,bi,bj)%v))
                0104            ENDIF
                0105            IF (err_tempv .ge. err_max) err_max = err_tempv
                0106           ENDDO
                0107          ENDDO
                0108         ENDDO
                0109        ENDDO
                0110 
                0111        CALL GLOBAL_MAX_R8 (err_max, myThid)
e17e409e24 Dani*0112 
                0113        ELSE
                0114 
                0115        DO bj = myByLo(myThid), myByHi(myThid)
                0116         DO bi = myBxLo(myThid), myBxHi(myThid)
                0117          DO j=1,sNy
                0118           DO i=1,sNx
                0119            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0120             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) + 
                0121      &       (ABS(U_streamice(i,j,bi,bj)%v-
                0122      &              u_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0123            ENDIF
                0124            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0125             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) + 
                0126      &       (ABS(v_streamice(i,j,bi,bj)%v-
                0127      &              v_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0128            ENDIF
                0129           ENDDO
                0130          ENDDO
                0131         ENDDO
                0132        ENDDO
                0133 
                0134        CALL GLOBAL_SUM_TILE_RL( err_sum_tile, err_sum, myThid )
                0135 
                0136        err_max = err_sum ** (1./streamice_err_norm)
                0137 
                0138        ENDIF
847eec441b Dani*0139      
                0140       end if
                0141 
                0142       if (our_rev_mode%adjoint) then
                0143 
e17e409e24 Dani*0144        if (conj_norm .lt. 1.0) then
847eec441b Dani*0145 
                0146        DO bj = myByLo(myThid), myByHi(myThid)
                0147         DO bi = myBxLo(myThid), myBxHi(myThid)
                0148          DO j=1,sNy
                0149           DO i=1,sNx
                0150            err_tempu = 0. _d 0
                0151            err_tempv = 0. _d 0
                0152            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0153             err_tempu =
                0154      &       ABS (U_streamice(i,j,bi,bj)%d-u_new_SI(i,j,bi,bj)%d)
                0155            ENDIF
                0156            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0157             err_tempv = MAX( err_tempu,
                0158      &       ABS (V_streamice(i,j,bi,bj)%d-v_new_SI(i,j,bi,bj)%d))
                0159            ENDIF
                0160            IF (err_tempv .ge. err_max) err_max = err_tempv
                0161           ENDDO
                0162          ENDDO
                0163         ENDDO
                0164        ENDDO
                0165 
                0166        CALL GLOBAL_MAX_R8 (err_max, myThid)
                0167 
e17e409e24 Dani*0168        ELSE
                0169 
                0170        DO bj = myByLo(myThid), myByHi(myThid)
                0171         DO bi = myBxLo(myThid), myBxHi(myThid)
                0172          DO j=1,sNy
                0173           DO i=1,sNx
                0174            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0175             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) + 
                0176      &       (ABS(U_streamice(i,j,bi,bj)%d-
                0177      &              u_new_SI(i,j,bi,bj)%d))**conj_norm
                0178            ENDIF
                0179            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0180             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) + 
                0181      &       (ABS(v_streamice(i,j,bi,bj)%d-
                0182      &              v_new_SI(i,j,bi,bj)%d))**conj_norm
                0183            ENDIF
                0184           ENDDO
                0185          ENDDO
                0186         ENDDO
                0187        ENDDO
                0188 
                0189        CALL GLOBAL_SUM_TILE_RL( err_sum_tile, err_sum, myThid )
                0190 
                0191        err_max = err_sum ** (1./conj_norm)
                0192 
                0193        ENDIF
                0194 
847eec441b Dani*0195       end if
b11fa21b0e Dani*0196 #endif
847eec441b Dani*0197       end subroutine template
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!