File indexing completed on 2022-01-06 06:12:04 UTC
view on githubraw file Latest commit 9f5240b5 on 2022-01-05 15:24:45 UTC
b6b8988e60 Jean*0001 #include "PACKAGES_CONFIG.h"
074ef64531 Jean*0002 #include "CPP_OPTIONS.h"
0003
9366854e02 Chri*0004
0005
0006
074ef64531 Jean*0007 SUBROUTINE INI_LINEAR_PHISURF( myThid )
0008
9366854e02 Chri*0009
0010
05f412be17 Jean*0011
0012
9366854e02 Chri*0013
c8f29584cf Jean*0014
05f412be17 Jean*0015
0016
463053c692 Jean*0017
9366854e02 Chri*0018
0019
0020
0021
0022 IMPLICIT NONE
074ef64531 Jean*0023
0024 #include "SIZE.h"
0025 #include "EEPARAMS.h"
0026 #include "PARAMS.h"
0027 #include "GRID.h"
0028 #include "SURFACE.h"
0029
9366854e02 Chri*0030
aa03c27196 Jean*0031
074ef64531 Jean*0032 INTEGER myThid
0033
46ac67bdf3 Jean*0034
3bffe370e9 Jean*0035
0036
46ac67bdf3 Jean*0037
9366854e02 Chri*0038
3bffe370e9 Jean*0039
e437317be2 Jean*0040
065ea7c980 Jean*0041
9f5240b52a Jean*0042 #ifndef ALLOW_AUTODIFF
e437317be2 Jean*0043 _RS topoHloc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
9f5240b52a Jean*0044 #endif
074ef64531 Jean*0045 INTEGER bi, bj
065ea7c980 Jean*0046 INTEGER i, j, k
69d75ba75d Jean*0047 _RL pLoc, rhoLoc
074ef64531 Jean*0048 _RL dPIdp
9366854e02 Chri*0049
074ef64531 Jean*0050
065ea7c980 Jean*0051
b6b8988e60 Jean*0052 #ifdef ALLOW_AUTODIFF
5c39e917f7 Patr*0053 DO bj=myByLo(myThid),myByHi(myThid)
0054 DO bi=myBxLo(myThid),myBxHi(myThid)
8885a61e2b Jean*0055 DO j=1-OLy,sNy+OLy
0056 DO i=1-OLx,sNx+OLx
065ea7c980 Jean*0057 Bo_surf(i,j,bi,bj) = 0. _d 0
0058 recip_Bo(i,j,bi,bj) = 0. _d 0
0059 ENDDO
0060 ENDDO
8885a61e2b Jean*0061 ENDDO
0062 ENDDO
b6b8988e60 Jean*0063 #endif /* ALLOW_AUTODIFF */
3bffe370e9 Jean*0064
0065
0066
c8f29584cf Jean*0067
05f412be17 Jean*0068
0069
0070
074ef64531 Jean*0071
c8f29584cf Jean*0072
05f412be17 Jean*0073
0074
0075
0076
074ef64531 Jean*0077
aa03c27196 Jean*0078 IF ( usingZCoords ) THEN
074ef64531 Jean*0079
0080 DO bj=myByLo(myThid),myByHi(myThid)
0081 DO bi=myBxLo(myThid),myBxHi(myThid)
cfbe180681 Jean*0082 DO j=1-OLy,sNy+OLy
0083 DO i=1-OLx,sNx+OLx
0084 Bo_surf(i,j,bi,bj) = gBaro
0085 recip_Bo(i,j,bi,bj) = 1. _d 0 / gBaro
074ef64531 Jean*0086 ENDDO
0087 ENDDO
0088 ENDDO
0089 ENDDO
0090 ELSEIF ( uniformLin_PhiSurf ) THEN
0091
0092 DO bj=myByLo(myThid),myByHi(myThid)
0093 DO bi=myBxLo(myThid),myBxHi(myThid)
cfbe180681 Jean*0094 DO j=1-OLy,sNy+OLy
0095 DO i=1-OLx,sNx+OLx
0096
0097
0098 Bo_surf(i,j,bi,bj) = recip_rhoConst
0099 recip_Bo(i,j,bi,bj) = rhoConst
074ef64531 Jean*0100 ENDDO
0101 ENDDO
0102 ENDDO
0103 ENDDO
aa03c27196 Jean*0104 ELSEIF ( fluidIsWater ) THEN
cfbe180681 Jean*0105
0106
60c223928f Mart*0107 DO bj=myByLo(myThid),myByHi(myThid)
0108 DO bi=myBxLo(myThid),myBxHi(myThid)
cfbe180681 Jean*0109 DO j=1-OLy,sNy+OLy
0110 DO i=1-OLx,sNx+OLx
0111 IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
0112 & .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
0113 pLoc = Ro_surf(i,j,bi,bj)
1177955fb6 Jean*0114 #ifdef ALLOW_OPENAD
0115 CALL FIND_RHO_SCALAR(
cfbe180681 Jean*0116 I tRef(kSurfC(i,j,bi,bj)),
0117 I sRef(kSurfC(i,j,bi,bj)),
1177955fb6 Jean*0118 I pLoc,
0119 O rhoLoc, myThid )
0120 #else /* ALLOW_OPENAD */
cfbe180681 Jean*0121 k = kSurfC(i,j,bi,bj)
05f412be17 Jean*0122 CALL FIND_RHO_SCALAR(
69d75ba75d Jean*0123 I tRef(k), sRef(k), pLoc,
0124 O rhoLoc, myThid )
1177955fb6 Jean*0125 #endif /* ALLOW_OPENAD */
05f412be17 Jean*0126 IF ( rhoLoc .EQ. 0. _d 0 ) THEN
cfbe180681 Jean*0127 Bo_surf(i,j,bi,bj) = 0. _d 0
05f412be17 Jean*0128 ELSE
cfbe180681 Jean*0129 Bo_surf(i,j,bi,bj) = 1. _d 0/rhoLoc
05f412be17 Jean*0130 ENDIF
cfbe180681 Jean*0131 recip_Bo(i,j,bi,bj) = rhoLoc
60c223928f Mart*0132 ELSE
cfbe180681 Jean*0133 Bo_surf(i,j,bi,bj) = 0. _d 0
0134 recip_Bo(i,j,bi,bj) = 0. _d 0
60c223928f Mart*0135 ENDIF
0136 ENDDO
0137 ENDDO
0138 ENDDO
0139 ENDDO
aa03c27196 Jean*0140 ELSEIF ( fluidIsAir ) THEN
074ef64531 Jean*0141
cfbe180681 Jean*0142
0143
074ef64531 Jean*0144 DO bj=myByLo(myThid),myByHi(myThid)
0145 DO bi=myBxLo(myThid),myBxHi(myThid)
cfbe180681 Jean*0146 IF ( select_rStar.GE.1 .OR. selectSigmaCoord.GE.1 ) THEN
0147
0148 DO j=1-OLy,sNy+OLy
0149 DO i=1-OLx,sNx+OLx
0150 IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
0151 & .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
0152 dPIdp = (atm_Rd/atm_Po)*
0153 & (Ro_surf(i,j,bi,bj)/atm_Po)**(atm_kappa-1. _d 0)
0154 Bo_surf(i,j,bi,bj) = dPIdp*thetaConst
0155 recip_Bo(i,j,bi,bj) = 1. _d 0 / Bo_surf(i,j,bi,bj)
0156 ELSE
0157 Bo_surf(i,j,bi,bj) = 0.
0158 recip_Bo(i,j,bi,bj) = 0.
0159 ENDIF
0160 ENDDO
074ef64531 Jean*0161 ENDDO
cfbe180681 Jean*0162 ELSE
0163
0164 DO j=1-OLy,sNy+OLy
0165 DO i=1-OLx,sNx+OLx
0166 IF ( Ro_surf(i,j,bi,bj).GT.0. _d 0
0167 & .AND. kSurfC(i,j,bi,bj).LE.Nr ) THEN
0168 dPIdp = (atm_Rd/atm_Po)*
0169 & (Ro_surf(i,j,bi,bj)/atm_Po)**(atm_kappa-1. _d 0)
0170 Bo_surf(i,j,bi,bj) = dPIdp*tRef(kSurfC(i,j,bi,bj))
0171 recip_Bo(i,j,bi,bj) = 1. _d 0 / Bo_surf(i,j,bi,bj)
0172 ELSE
0173 Bo_surf(i,j,bi,bj) = 0.
0174 recip_Bo(i,j,bi,bj) = 0.
0175 ENDIF
0176 ENDDO
0177 ENDDO
0178 ENDIF
074ef64531 Jean*0179 ENDDO
0180 ENDDO
60c223928f Mart*0181 ELSE
0182 STOP 'INI_LINEAR_PHISURF: We should never reach this point!'
074ef64531 Jean*0183 ENDIF
0184
0185
0186
05f412be17 Jean*0187
cfbe180681 Jean*0188
0189
074ef64531 Jean*0190
aa03c27196 Jean*0191 IF ( usingPCoords .AND. .NOT.uniformLin_PhiSurf ) THEN
05f412be17 Jean*0192 CALL WRITE_FLD_XY_RL( 'Bo_surf',' ',Bo_surf,0,myThid)
074ef64531 Jean*0193 ENDIF
0194
463053c692 Jean*0195
0196
05f412be17 Jean*0197
463053c692 Jean*0198
0199
0320e25227 Mart*0200 DO bj=myByLo(myThid),myByHi(myThid)
0201 DO bi=myBxLo(myThid),myBxHi(myThid)
0202 DO j=1-OLy,sNy+OLy
0203 DO i=1-OLx,sNx+OLx
0204 phi0surf(i,j,bi,bj) = 0.
463053c692 Jean*0205 ENDDO
0206 ENDDO
0320e25227 Mart*0207 ENDDO
0208 ENDDO
0209
0210 IF ( geoPotAnomFile .NE. ' ' ) THEN
0211 CALL READ_FLD_XY_RS( geoPotAnomFile, ' ', phi0Surf, 0, myThid )
0212 ENDIF
0213 CALL EXCH_XY_RS( phi0Surf , myThid )
463053c692 Jean*0214
aa03c27196 Jean*0215 IF ( fluidIsAir .AND. topoFile.NE.' ' ) THEN
463053c692 Jean*0216
b6b8988e60 Jean*0217 #ifdef ALLOW_AUTODIFF
ecaea33887 Patr*0218 STOP 'CANNOT PRESENTLY USE THIS OPTION WITH ADJOINT'
0219 #else
0220
05f412be17 Jean*0221
46ac67bdf3 Jean*0222
0223
0224
0225
05f412be17 Jean*0226 CALL INI_P_GROUND( -2,
0227 O topoHloc,
463053c692 Jean*0228 I Ro_surf, myThid )
0229
46ac67bdf3 Jean*0230 IF (selectFindRoSurf.NE.0) THEN
463053c692 Jean*0231 _EXCH_XY_RS(phi0surf, myThid)
05f412be17 Jean*0232 CALL WRITE_FLD_XY_RS( 'phi0surf',' ',phi0surf,0,myThid)
46ac67bdf3 Jean*0233 ENDIF
463053c692 Jean*0234
06bb0cec77 Jean*0235 CALL WRITE_FLD_XY_RS( 'topo_H',' ',topoHloc,0,myThid)
0236
b6b8988e60 Jean*0237 #endif /* ALLOW_AUTODIFF */
ecaea33887 Patr*0238
463053c692 Jean*0239 ENDIF
0240
0241
074ef64531 Jean*0242 RETURN
0243 END