pkg/streamice/streamice_get_vel_fp_err.F

813a6901ae Dani*0001 #include "STREAMICE_OPTIONS.h"
16cc32c739 Mart*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
813a6901ae Dani*0005
                0006 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0007
                0008 CBOP
0fbff46b46 dngo*0009       SUBROUTINE STREAMICE_GET_VEL_FP_ERR ( err_max,
                0010 #ifdef ALLOW_AUTODIFF_TAMC
                0011      I     ikey_nl,
                0012 #endif
                0013      I     myThid )
813a6901ae Dani*0014 C     /============================================================\
                0015 C     | SUBROUTINE                                                 |
                0016 C     | o                                                          |
                0017 C     |============================================================|
                0018 C     |                                                            |
                0019 C     \============================================================/
                0020       IMPLICIT NONE
                0021
                0022 C     === Global variables ===
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "STREAMICE.h"
                0027 #include "STREAMICE_CG.h"
18a089944d Dani*0028
813a6901ae Dani*0029 C     !INPUT/OUTPUT ARGUMENTS
                0030       _RL err_max
0fbff46b46 dngo*0031 #ifdef ALLOW_AUTODIFF_TAMC
                0032       INTEGER ikey_nl
                0033 #endif
813a6901ae Dani*0034       INTEGER myThid
1705d3e404 Jean*0035
813a6901ae Dani*0036 #ifdef ALLOW_STREAMICE
                0037
0fbff46b46 dngo*0038       INTEGER i, j, bi, bj
1705d3e404 Jean*0039
                0040       _RL err_tempu, err_tempv
bbd6229661 Dani*0041
                0042       _RL err_sum
                0043       _RL err_sum_tile (nSx,nSy)
813a6901ae Dani*0044
                0045        err_max = 0. _d 0
bbd6229661 Dani*0046        err_sum = 0. _d 0
                0047
                0048        DO bj = myByLo(myThid), myByHi(myThid)
                0049         DO bi = myBxLo(myThid), myBxHi(myThid)
0fbff46b46 dngo*0050          err_sum_tile(bi,bj) = 0. _d 0
bbd6229661 Dani*0051         ENDDO
                0052        ENDDO
                0053
                0054        if (streamice_err_norm .lt. 1.0) then
813a6901ae Dani*0055
                0056        DO bj = myByLo(myThid), myByHi(myThid)
                0057         DO bi = myBxLo(myThid), myBxHi(myThid)
                0058          DO j=1,sNy
                0059           DO i=1,sNx
0fbff46b46 dngo*0060 #ifdef ALLOW_AUTODIFF_TAMC
                0061 !$TAF STORE err_max = comlev1_stream_nl, key=ikey_nl
                0062 #endif
813a6901ae Dani*0063            err_tempu = 0. _d 0
                0064            err_tempv = 0. _d 0
                0065            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
                0066             err_tempu =
351fd6b6a4 Dani*0067 #ifdef ALLOW_STREAMICE_OAD_FP
                0068      &       ABS (U_streamice(i,j,bi,bj)-u_new_SI(i,j,bi,bj))
                0069 #else
813a6901ae Dani*0070      &       ABS (U_streamice(i,j,bi,bj)-u_old_SI(i,j,bi,bj))
351fd6b6a4 Dani*0071 #endif
813a6901ae Dani*0072            ENDIF
                0073            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
                0074             err_tempv = MAX( err_tempu,
351fd6b6a4 Dani*0075 #ifdef ALLOW_STREAMICE_OAD_FP
                0076      &       ABS (V_streamice(i,j,bi,bj)-v_new_SI(i,j,bi,bj)))
                0077 #else
813a6901ae Dani*0078      &       ABS (V_streamice(i,j,bi,bj)-v_old_SI(i,j,bi,bj)))
351fd6b6a4 Dani*0079 #endif
813a6901ae Dani*0080            ENDIF
                0081            IF (err_tempv .ge. err_max) err_max = err_tempv
                0082           ENDDO
                0083          ENDDO
                0084         ENDDO
                0085        ENDDO
                0086
06d8e51223 Dani*0087        CALL GLOBAL_MAX_R8 (err_max, myThid)
813a6901ae Dani*0088
bbd6229661 Dani*0089        ELSE
                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            IF (STREAMICE_umask(i,j,bi,bj).eq.1) THEN
0fbff46b46 dngo*0096             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
bbd6229661 Dani*0097 #ifdef ALLOW_STREAMICE_OAD_FP
                0098      &       (ABS(U_streamice(i,j,bi,bj)-
                0099      &              u_new_SI(i,j,bi,bj)))**streamice_err_norm
                0100 #else
                0101      &       (ABS(U_streamice(i,j,bi,bj)-
                0102      &               u_old_SI(i,j,bi,bj)))**streamice_err_norm
                0103 #endif
                0104            ENDIF
                0105            IF (STREAMICE_vmask(i,j,bi,bj).eq.1) THEN
0fbff46b46 dngo*0106             err_sum_tile(bi,bj) = err_sum_tile(bi,bj) +
bbd6229661 Dani*0107 #ifdef ALLOW_STREAMICE_OAD_FP
                0108      &       (ABS(v_streamice(i,j,bi,bj)-
                0109      &              v_new_SI(i,j,bi,bj)))**streamice_err_norm
                0110 #else
                0111      &       (ABS(v_streamice(i,j,bi,bj)-
                0112      &               v_old_SI(i,j,bi,bj)))**streamice_err_norm
                0113 #endif
                0114            ENDIF
                0115           ENDDO
                0116          ENDDO
                0117         ENDDO
                0118        ENDDO
                0119
                0120        CALL GLOBAL_SUM_TILE_RL( err_sum_tile, err_sum, myThid )
                0121
                0122        err_max = err_sum ** (1./streamice_err_norm)
                0123
                0124        ENDIF
                0125
813a6901ae Dani*0126 #endif
                0127       RETURN
                0128       END