Back to home page

MITgcm
 
 

    

File indexing completed on 2025-11-22 06:08:58 UTC

view on githubraw file Latest commit feb7fa5d on 2025-11-21 15:45:20 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
feb7fa5d1e dngo*0015 #if (defined(ALLOW_STREAMICE_FP_ADJ) && defined(ALLOW_OPENAD))
847eec441b Dani*0016 
feb7fa5d1e dngo*0017        err_max = 0. _d 0
e17e409e24 Dani*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
feb7fa5d1e dngo*0021        if (streamice_err_norm .gt. 1. _d 0) conj_norm =
                0022      & streamice_err_norm / (streamice_err_norm - 1.0)
e17e409e24 Dani*0023 
                0024        DO bj = myByLo(myThid), myByHi(myThid)
                0025         DO bi = myBxLo(myThid), myBxHi(myThid)
feb7fa5d1e dngo*0026          err_sum_tile(bi,bj) = 0. _d 0
e17e409e24 Dani*0027         ENDDO
                0028        ENDDO
                0029 
847eec441b Dani*0030       if (our_rev_mode%plain) then
feb7fa5d1e dngo*0031 
e17e409e24 Dani*0032        if (streamice_err_norm .lt. 1.0) then
847eec441b Dani*0033 
                0034        DO bj = myByLo(myThid), myByHi(myThid)
                0035         DO bi = myBxLo(myThid), myBxHi(myThid)
                0036          DO j=1,sNy
                0037           DO i=1,sNx
                0038            err_tempu = 0. _d 0
                0039            err_tempv = 0. _d 0
                0040            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0041             err_tempu =
                0042      &       ABS (U_streamice(i,j,bi,bj)%v-u_new_SI(i,j,bi,bj)%v)
                0043            ENDIF
                0044            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0045             err_tempv = MAX( err_tempu,
                0046      &       ABS (V_streamice(i,j,bi,bj)%v-v_new_SI(i,j,bi,bj)%v))
                0047            ENDIF
                0048            IF (err_tempv .ge. err_max) err_max = err_tempv
                0049           ENDDO
                0050          ENDDO
                0051         ENDDO
                0052        ENDDO
                0053 
                0054        CALL GLOBAL_MAX_R8 (err_max, myThid)
e17e409e24 Dani*0055 
                0056        ELSE
                0057 
                0058        DO bj = myByLo(myThid), myByHi(myThid)
                0059         DO bi = myBxLo(myThid), myBxHi(myThid)
                0060          DO j=1,sNy
                0061           DO i=1,sNx
                0062            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
feb7fa5d1e dngo*0063             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
e17e409e24 Dani*0064      &       (ABS(U_streamice(i,j,bi,bj)%v-
                0065      &              u_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0066            ENDIF
                0067            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
feb7fa5d1e dngo*0068             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
e17e409e24 Dani*0069      &       (ABS(v_streamice(i,j,bi,bj)%v-
                0070      &              v_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0071            ENDIF
                0072           ENDDO
                0073          ENDDO
                0074         ENDDO
                0075        ENDDO
                0076 
                0077        CALL GLOBAL_SUM_TILE_RL( err_sum_tile, err_sum, myThid )
                0078 
                0079        err_max = err_sum ** (1./streamice_err_norm)
                0080 
                0081        ENDIF
                0082 
847eec441b Dani*0083       end if
                0084 
                0085       if (our_rev_mode%tape) then
feb7fa5d1e dngo*0086 
e17e409e24 Dani*0087        IF (streamice_err_norm .lt. 1.0) then
847eec441b Dani*0088 
                0089        DO bj = myByLo(myThid), myByHi(myThid)
                0090         DO bi = myBxLo(myThid), myBxHi(myThid)
                0091          DO j=1,sNy
                0092           DO i=1,sNx
                0093            err_tempu = 0. _d 0
                0094            err_tempv = 0. _d 0
                0095            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0096             err_tempu =
                0097      &       ABS (U_streamice(i,j,bi,bj)%v-u_new_SI(i,j,bi,bj)%v)
                0098            ENDIF
                0099            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0100             err_tempv = MAX( err_tempu,
                0101      &       ABS (V_streamice(i,j,bi,bj)%v-v_new_SI(i,j,bi,bj)%v))
                0102            ENDIF
                0103            IF (err_tempv .ge. err_max) err_max = err_tempv
                0104           ENDDO
                0105          ENDDO
                0106         ENDDO
                0107        ENDDO
                0108 
                0109        CALL GLOBAL_MAX_R8 (err_max, myThid)
e17e409e24 Dani*0110 
                0111        ELSE
                0112 
                0113        DO bj = myByLo(myThid), myByHi(myThid)
                0114         DO bi = myBxLo(myThid), myBxHi(myThid)
                0115          DO j=1,sNy
                0116           DO i=1,sNx
                0117            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
feb7fa5d1e dngo*0118             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
e17e409e24 Dani*0119      &       (ABS(U_streamice(i,j,bi,bj)%v-
                0120      &              u_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0121            ENDIF
                0122            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
feb7fa5d1e dngo*0123             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
e17e409e24 Dani*0124      &       (ABS(v_streamice(i,j,bi,bj)%v-
                0125      &              v_new_SI(i,j,bi,bj)%v))**streamice_err_norm
                0126            ENDIF
                0127           ENDDO
                0128          ENDDO
                0129         ENDDO
                0130        ENDDO
                0131 
                0132        CALL GLOBAL_SUM_TILE_RL( err_sum_tile, err_sum, myThid )
                0133 
                0134        err_max = err_sum ** (1./streamice_err_norm)
                0135 
                0136        ENDIF
feb7fa5d1e dngo*0137 
847eec441b Dani*0138       end if
                0139 
                0140       if (our_rev_mode%adjoint) then
                0141 
e17e409e24 Dani*0142        if (conj_norm .lt. 1.0) then
847eec441b Dani*0143 
                0144        DO bj = myByLo(myThid), myByHi(myThid)
                0145         DO bi = myBxLo(myThid), myBxHi(myThid)
                0146          DO j=1,sNy
                0147           DO i=1,sNx
                0148            err_tempu = 0. _d 0
                0149            err_tempv = 0. _d 0
                0150            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0151             err_tempu =
                0152      &       ABS (U_streamice(i,j,bi,bj)%d-u_new_SI(i,j,bi,bj)%d)
                0153            ENDIF
                0154            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0155             err_tempv = MAX( err_tempu,
                0156      &       ABS (V_streamice(i,j,bi,bj)%d-v_new_SI(i,j,bi,bj)%d))
                0157            ENDIF
                0158            IF (err_tempv .ge. err_max) err_max = err_tempv
                0159           ENDDO
                0160          ENDDO
                0161         ENDDO
                0162        ENDDO
                0163 
                0164        CALL GLOBAL_MAX_R8 (err_max, myThid)
                0165 
e17e409e24 Dani*0166        ELSE
                0167 
                0168        DO bj = myByLo(myThid), myByHi(myThid)
                0169         DO bi = myBxLo(myThid), myBxHi(myThid)
                0170          DO j=1,sNy
                0171           DO i=1,sNx
                0172            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
feb7fa5d1e dngo*0173             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
e17e409e24 Dani*0174      &       (ABS(U_streamice(i,j,bi,bj)%d-
                0175      &              u_new_SI(i,j,bi,bj)%d))**conj_norm
                0176            ENDIF
                0177            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
feb7fa5d1e dngo*0178             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
e17e409e24 Dani*0179      &       (ABS(v_streamice(i,j,bi,bj)%d-
                0180      &              v_new_SI(i,j,bi,bj)%d))**conj_norm
                0181            ENDIF
                0182           ENDDO
                0183          ENDDO
                0184         ENDDO
                0185        ENDDO
                0186 
                0187        CALL GLOBAL_SUM_TILE_RL( err_sum_tile, err_sum, myThid )
                0188 
                0189        err_max = err_sum ** (1./conj_norm)
                0190 
                0191        ENDIF
                0192 
847eec441b Dani*0193       end if
b11fa21b0e Dani*0194 #endif
847eec441b Dani*0195       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!