File indexing completed on 2021-03-17 05:10:55 UTC
view on githubraw file Latest commit cab62edf on 2021-03-17 01:26:17 UTC
00b29feb62 Jean*0001 #include "CPP_OPTIONS.h"
0002
0003
0004
0005
72a058b866 Gael*0006 SUBROUTINE UPDATE_R_STAR( useLatest, myTime, myIter, myThid )
2c5c5e9c4a Jean*0007
00b29feb62 Jean*0008
0009
2c5c5e9c4a Jean*0010
0011
0012
00b29feb62 Jean*0013
0014
0015
0016
0017 IMPLICIT NONE
0018
0019 #include "SIZE.h"
0020 #include "EEPARAMS.h"
0021 #include "PARAMS.h"
0022 #include "GRID.h"
0023 #include "SURFACE.h"
0024
0025
0026
2c5c5e9c4a Jean*0027
0028
0029
0030
72a058b866 Gael*0031 LOGICAL useLatest
00b29feb62 Jean*0032 _RL myTime
0033 INTEGER myIter
0034 INTEGER myThid
0035
0036
0037 #ifdef NONLIN_FRSURF
0038
2c5c5e9c4a Jean*0039
00b29feb62 Jean*0040 INTEGER i,j,k,bi,bj
0041
0042
0043 DO bj=myByLo(myThid), myByHi(myThid)
2c5c5e9c4a Jean*0044 DO bi=myBxLo(myThid), myBxHi(myThid)
f36344f45a Patr*0045
00b29feb62 Jean*0046
0047
72a058b866 Gael*0048 IF (useLatest) THEN
0049
00b29feb62 Jean*0050 DO k=1,Nr
cab62edf37 Ou W*0051 DO j=1-OLy,sNy+OLy
0052 DO i=1-OLx,sNx+OLx
0499e7ef48 Patr*0053 # ifndef DISABLE_RSTAR_CODE
00b29feb62 Jean*0054
0055 hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
0056 & *rStarFacC(i,j,bi,bj)
0057 hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
0058 & *rStarFacW(i,j,bi,bj)
0059 hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
0060 & *rStarFacS(i,j,bi,bj)
0499e7ef48 Patr*0061 #endif
0062
00b29feb62 Jean*0063 #ifdef USE_MASK_AND_NO_IF
0064 recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)
616600b8d2 Patr*0065 & / ( _hFacC(i,j,k,bi,bj) + (1.-maskC(i,j,k,bi,bj)) )
00b29feb62 Jean*0066 recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj)
616600b8d2 Patr*0067 & / ( _hFacW(i,j,k,bi,bj) + (1.-maskW(i,j,k,bi,bj)) )
00b29feb62 Jean*0068 recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj)
616600b8d2 Patr*0069 & / ( _hFacS(i,j,k,bi,bj) + (1.-maskS(i,j,k,bi,bj)) )
00b29feb62 Jean*0070 #else
0071 IF (maskC(i,j,k,bi,bj).NE.0.)
616600b8d2 Patr*0072 & recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / _hFacC(i,j,k,bi,bj)
00b29feb62 Jean*0073 IF (maskW(i,j,k,bi,bj).NE.0.)
616600b8d2 Patr*0074 & recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / _hFacW(i,j,k,bi,bj)
00b29feb62 Jean*0075 IF (maskS(i,j,k,bi,bj).NE.0.)
616600b8d2 Patr*0076 & recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / _hFacS(i,j,k,bi,bj)
00b29feb62 Jean*0077 #endif
0078 ENDDO
0079 ENDDO
0080 ENDDO
0081
72a058b866 Gael*0082 ELSE
0083
0084 DO k=1,Nr
cab62edf37 Ou W*0085 DO j=1-OLy,sNy+OLy
0086 DO i=1-OLx,sNx+OLx
72a058b866 Gael*0087 # ifndef DISABLE_RSTAR_CODE
0088
0089
0090 hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
0091 & *rStarFacNm1C(i,j,bi,bj)
0092 hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
0093 & *rStarFacNm1W(i,j,bi,bj)
0094 hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
0095 & *rStarFacNm1S(i,j,bi,bj)
0096 #endif
0097
0098 #ifdef USE_MASK_AND_NO_IF
cab62edf37 Ou W*0099 recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj) /
0100 & ( _hFacC(i,j,k,bi,bj) + (oneRS - maskC(i,j,k,bi,bj)) )
0101 recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj) /
0102 & ( _hFacW(i,j,k,bi,bj) + (oneRS - maskW(i,j,k,bi,bj)) )
0103 recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj) /
0104 & ( _hFacS(i,j,k,bi,bj) + (oneRS - maskS(i,j,k,bi,bj)) )
72a058b866 Gael*0105 #else
cab62edf37 Ou W*0106 IF ( maskC(i,j,k,bi,bj).NE.zeroRS )
0107 & recip_hFacC(i,j,k,bi,bj) = oneRS / _hFacC(i,j,k,bi,bj)
0108 IF ( maskW(i,j,k,bi,bj).NE.zeroRS )
0109 & recip_hFacW(i,j,k,bi,bj) = oneRS / _hFacW(i,j,k,bi,bj)
0110 IF ( maskS(i,j,k,bi,bj).NE.zeroRS )
0111 & recip_hFacS(i,j,k,bi,bj) = oneRS / _hFacS(i,j,k,bi,bj)
72a058b866 Gael*0112 #endif
0113 ENDDO
0114 ENDDO
0115 ENDDO
0116
0117 ENDIF
0118
00b29feb62 Jean*0119
0120
0121
0122 ENDDO
0123 ENDDO
0124
0125
0126
0127
0128
0129
0130
0131 #endif /* NONLIN_FRSURF */
0132
0133 RETURN
0134 END