File indexing completed on 2025-11-22 06:08:49 UTC
view on githubraw file Latest commit feb7fa5d on 2025-11-21 15:45:20 UTC
feb7fa5d1e dngo*0001 #include "STREAMICE_OPTIONS.h"
0002
0003 INTEGER FUNCTION ADFIXEDPOINT_NOTREDUCED(CUMUL, REDUCTION)
0004 IMPLICIT NONE
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014 #include "SIZE.h"
0015 #include "EEPARAMS.h"
0016 #include "PARAMS.h"
0017 #include "STREAMICE_FP.h"
0018
0019
0020
0021 _RL CUMUL
0022 _RL REDUCTION
0023 #ifdef ALLOW_TAPENADE
0024 _RL CUMUL_GLOB
0025 _RL CUMUL_TILE(1:nSx, 1:nSy)
0026 INTEGER iterate
0027 INTEGER growth
0028 INTEGER bi, bj, jtlo, jthi, itlo, ithi
0029
0030
0031 IF (nTx.gt.1 .or. nTy.gt.1) THEN
0032 STOP 'ADFIXEDPOINT_NOTREDUCED: multithread not available'
0033 ENDIF
0034
0035 DO bi=1,nSx
0036 DO bj=1,nSy
0037 CUMUL_TILE(bi,bj)=0.0
0038 ENDDO
0039 ENDDO
0040 CUMUL_TILE(1,1) = CUMUL
0041
0042 CALL GLOBAL_SUM_TILE_RL
0043 & ( CUMUL_TILE, CUMUL_GLOB, 1 )
0044
0045 CUMUL = CUMUL_GLOB
0046
0047 IF (cumul .LT. 0.0D0) THEN
0048
0049 IF (fpDepth .GE. 5) THEN
0050 adFixedPoint_notReduced = 0
0051 RETURN
0052 ENDIF
0053 fpDepth = fpDepth + 1
0054 refCumuls(fpDepth) = -1.0D0
0055 prevCumuls(fpDepth) = -1.0D0
0056 adjIters(fpDepth) = 1
0057 adFixedPoint_notReduced = 1
0058 #ifdef ALLOW_PETSC
0059 if (STREAMICE_OAD_petsc_reuse) then
0060 streamice_need2createmat=.true.
0061 streamice_need2destroymat=.false.
0062 endif
0063 #endif
0064 RETURN
0065 ELSE
0066
0067 IF (refCumuls(fpDepth) .LT. 0.0D0) THEN
0068
0069 refCumuls(fpDepth) = cumul
0070 prevCumuls(fpDepth) = cumul
0071 IF (cumul .GT. 1.0D-10) THEN
0072 iterate = 1
0073 ELSE
0074 iterate = 0
0075 ENDIF
0076 growth = 0
0077 ELSE
0078
0079 IF (cumul .GT. streamice_nonlin_tol_adjoint_rl *
0080 & refCumuls(fpDepth)) THEN
0081 iterate = 1
0082 ELSE
0083 iterate = 0
0084 ENDIF
0085 IF (adjIters(fpDepth) .GT. 5 .AND.
0086 & cumul .GT. prevCumuls(fpDepth)) THEN
0087 growth = 1
0088 ELSE
0089 growth = 0
0090 ENDIF
0091 prevCumuls(fpDepth) = cumul
0092 ENDIF
0093
0094 IF (iterate .EQ. 1 .AND. growth .EQ. 0) THEN
0095 adjIters(fpDepth) = adjIters(fpDepth) + 1
0096 WRITE(*,*) adjIters(fpDepth),
0097 & ' adjoint iterations (reduced ',
0098 & refCumuls(fpDepth), ' -> ', cumul, ')'
0099 adFixedPoint_notReduced = 1
0100 #ifdef ALLOW_PETSC
0101 if (STREAMICE_OAD_petsc_reuse) then
0102 streamice_need2createmat=.false.
0103 streamice_need2destroymat=.false.
0104 endif
0105 #endif
0106 RETURN
0107 ELSE
0108 IF (growth .EQ. 1) THEN
0109 WRITE(*,*) adjIters(fpDepth),
0110 & ' adjoint iterations (reduced ',
0111 & refCumuls(fpDepth), ' -> ', cumul,
0112 & ', TERMINATED)'
0113 #ifdef ALLOW_PETSC
0114 if (STREAMICE_OAD_petsc_reuse) then
0115 streamice_need2createmat=.false.
0116 streamice_need2destroymat=.true.
0117
0118 endif
0119 #endif
0120 ELSE
0121 WRITE(*,*) adjIters(fpDepth),
0122 & ' adjoint iterations (reduced ',
0123 & refCumuls(fpDepth), ' -> ', cumul,
0124 & '), CONVERGED'
0125 #ifdef ALLOW_PETSC
0126 if (STREAMICE_OAD_petsc_reuse) then
0127 streamice_need2createmat=.false.
0128 streamice_need2destroymat=.true.
0129
0130 endif
0131 #endif
0132 ENDIF
0133
0134 IF (fpDepth .LT. 0) THEN
0135 adFixedPoint_notReduced = 0
0136 #ifdef ALLOW_PETSC
0137 if (STREAMICE_OAD_petsc_reuse) then
0138 streamice_need2createmat=.false.
0139 streamice_need2destroymat=.true.
0140
0141 endif
0142 #endif
0143 RETURN
0144 ENDIF
0145 fpDepth = fpDepth - 1
0146 adFixedPoint_notReduced = 0
0147 RETURN
0148 ENDIF
0149 ENDIF
0150 #endif /* ALLOW_TAPENADE */
0151 END
