File indexing completed on 2023-09-21 05:10:51 UTC
view on githubraw file Latest commit 96b00645 on 2023-09-20 15:15:14 UTC
5ca83cd8f7 Dani*0001 #include "CPP_OPTIONS.h"
0002 #include "STREAMICE_OPTIONS.h"
0003
0004 SUBROUTINE STREAMICE_INVERT_SURF_FORTHICK (
0005 O H,
0006 I S,
0007 I R,
0008 I delta,
0009 I myThid)
0010
96b006450c dngo*0011
1f04afc3fd Dani*0012
5ca83cd8f7 Dani*0013 #include "SIZE.h"
0014 #include "GRID.h"
0015 #include "SET_GRID.h"
0016 #include "EEPARAMS.h"
0017 #include "PARAMS.h"
0018 #include "STREAMICE.h"
0019
1f04afc3fd Dani*0020 #ifdef ALLOW_OPENAD
0021 use OAD_tape
0022 use OAD_rev
0023 use OAD_cp
0024 #endif
0025
5ca83cd8f7 Dani*0026 _RL H(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0027 _RL S(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0028 _RL R(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0029 _RL DELTA
0030 INTEGER myThid
1f04afc3fd Dani*0031 #ifdef ALLOW_OPENAD
0032 type(active) :: ETA_GL_STREAMICE
0033 type(active) :: X,Y0
0034 type(modeType) :: our_orig_mode
0035 #endif
5ca83cd8f7 Dani*0036
0037 #ifdef ALLOW_STREAMICE
0038
96b006450c dngo*0039 _RL resid, fp, hf, htmp
5ca83cd8f7 Dani*0040 INTEGER i, j, bi, bj, ITER
1f04afc3fd Dani*0041 _RL ETA_GL_PRIME_STREAMICE
0042 #ifndef ALLOW_OPENAD
5ca83cd8f7 Dani*0043 _RL ETA_GL_STREAMICE
0044 EXTERNAL ETA_GL_STREAMICE
1f04afc3fd Dani*0045 #endif
96b006450c dngo*0046
5ca83cd8f7 Dani*0047
0048 DO bj=myByLo(myThid), myByHi(myThid)
0049 DO bi=myBxLo(myThid), myBxHi(myThid)
0050 DO j = 1,sNy
0051 DO i = 1,sNx
0052 IF (STREAMICE_hmask(i,j,bi,bj).eq.1.0) THEN
0053 hf = (-1. _d 0) * R(i,j,bi,bj) /
0054 & (1. _d 0 - delta)
0055
0056 IF (S(i,j,bi,bj) .gt. delta*HF) THEN
0057 htmp = S(i,j,bi,bj)-R(i,j,bi,bj)
0058 ELSE
0059 htmp = S(i,j,bi,bj)/delta
887f427c62 Jean*0060 ENDIF
0061
5ca83cd8f7 Dani*0062 IF (streamice_smooth_gl_width.gt.0.) THEN
0063
0064 RESID=1. _d 0
0065
0066 DO ITER=1,20
0067 IF ((RESID .gt. .005) .and.
887f427c62 Jean*0068 & ( STREAMICE_hmask(i,j,bi,bj).eq.1.0)) THEN
0069
0070 hf = (-1. _d 0) * R(i,j,bi,bj) /
5ca83cd8f7 Dani*0071 & (1. _d 0 - delta)
0072
0073 IF (S(i,j,bi,bj) .gt. delta*HF) THEN
0074 htmp = S(i,j,bi,bj)-R(i,j,bi,bj)
0075 ELSE
0076 htmp = S(i,j,bi,bj)/delta
0077 ENDIF
887f427c62 Jean*0078
1f04afc3fd Dani*0079 #ifdef ALLOW_OPENAD
0080
0081 our_orig_mode = our_rev_mode
0082 our_rev_mode%arg_store=.FALSE.
0083 our_rev_mode%arg_restore=.FALSE.
0084 our_rev_mode%plain=.TRUE.
0085 our_rev_mode%tape=.FALSE.
0086 our_rev_mode%adjoint=.FALSE.
0087
0088 X%v = htmp-HF
0089 Y0%v = delta*HF
0090
0091 CALL OpenAD_oad_s_eta_gl_streamice(
0092 & X,
0093 & delta,
0094 & 1. _d 0,
0095 & Y0,
0096 & streamice_smooth_gl_width,
0097 & ETA_GL_STREAMICE)
0098
0099 RESID = ETA_GL_STREAMICE%v
0100 our_rev_mode = our_orig_mode
0101
0102 #else
5ca83cd8f7 Dani*0103 RESID = ETA_GL_STREAMICE (
0104 & htmp-HF,
0105 & delta,
0106 & 1. _d 0,
0107 & delta*HF,
0108 & streamice_smooth_gl_width)
1f04afc3fd Dani*0109 #endif
5ca83cd8f7 Dani*0110 RESID = RESID - S(i,j,bi,bj)
1f04afc3fd Dani*0111 FP = ETA_GL_PRIME_STREAMICE (
5ca83cd8f7 Dani*0112 & htmp-HF,
0113 & delta,
0114 & 1. _d 0,
0115 & delta*HF,
0116 & streamice_smooth_gl_width)
0117 Htmp = HTMP-RESID/FP
0118 ENDIF
0119 ENDDO
0120 ENDIF
887f427c62 Jean*0121 H(i,j,bi,bj) = Htmp
5ca83cd8f7 Dani*0122 ENDIF
0123 ENDDO
0124 ENDDO
0125 ENDDO
887f427c62 Jean*0126 ENDDO
0127
5ca83cd8f7 Dani*0128 #endif
0129 RETURN
887f427c62 Jean*0130 END
