MITgcm |
|
|
|
|||
File indexing completed on 2018-03-02 18:37:27 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTCb3097ed02d Jean*0001 #include "AIM_OPTIONS.h" 0002 0003 CBOP 0004 C !ROUTINE: SUFLUX_PREP 0005 C !INTERFACE: 0006 SUBROUTINE SUFLUX_PREP( 0007 I PSA,TA,QA,RH,ThA,Vsurf2,WVS,CLAT,FOROG, 0008 I FMASK,TLAND,TSEA,TSICE,SSR, e749d70ece Jean*0009 O SPEED0,DRAG,DENVV,dTskin,T1,T0,Q0, b3097ed02d Jean*0010 I kGrd,bi,bj,myThid) 0011 0012 C !DESCRIPTION: \bv 0013 C *==========================================================* 0014 C | S/R SUFLUX_PREP 0015 C | o prepare surface flux calculation 0016 C *==========================================================* 0017 C | o contain 1rst part of original S/R SUFLUX (Speedy code) 0018 C *==========================================================* 0019 C-- 0020 C-- SUBROUTINE SUFLUX (PSA,UA,VA,TA,QA,RH,PHI, 0021 C-- & PHI0,FMASK,TLAND,TSEA,SWAV,SSR,SLRD, 0022 C-- & USTR,VSTR,SHF,EVAP,SLRU, 0023 C-- & TSFC,TSKIN,U0,V0,T0,Q0) 0024 C-- 0025 C-- Purpose: Compute surface fluxes of momentum, energy and moisture, 0026 C-- and define surface skin temperature from energy balance 0027 C *==========================================================* 0028 C \ev 0029 0030 C !USES: 0031 IMPLICIT NONE 0032 0033 C Resolution parameters 0034 0035 C-- size for MITgcm & Physics package : 0036 #include "AIM_SIZE.h" 0037 0038 #include "EEPARAMS.h" 0039 0040 C Physical constants + functions of sigma and latitude 0041 #include "com_physcon.h" 0042 0043 C Surface flux constants 0044 #include "com_sflcon.h" 0045 0046 C !INPUT/OUTPUT PARAMETERS: 0047 C == Routine Arguments == 0048 C-- Input: 0049 C PSA :: norm. surface pressure [p/p0] (2-dim) 0050 C TA :: temperature (3-dim) 0051 C QA :: specific humidity [g/kg] (3-dim) 0052 C RH :: relative humidity [0-1] (3-dim) 0053 C ThA :: Pot.temperature [K] (3-dim) 0054 C Vsurf2 :: square of surface wind speed (2-dim,input) 0055 C ==> UA,VA are no longer used 0056 C WVS :: weights for near surf interp (2-dim) 0057 C CLAT :: cos(lat) (2-dim) 0058 C FOROG :: orographic factor (surf. drag) (2-dim) 0059 C FMASK :: fraction land - sea - sea-ice (2.5-dim) 0060 C TLAND :: land-surface temperature (2-dim) 0061 C TSEA :: sea-surface temperature (2-dim) 0062 C TSICE :: sea-ice surface temperature (2-dim) 0063 C SSR :: sfc sw radiation (net flux) (2-dim) 0064 C-- Output: 0065 C SPEED0 :: effective surface wind speed (2-dim) 0066 C DRAG :: surface Drag term (= Cd*Rho*|V|)(2-dim) 0067 C ==> USTR,VSTR are no longer used e749d70ece Jean*0068 C DENVV :: surface flux (sens,lat.) coeff. (=Rho*|V|) [kg/m2/s] b3097ed02d Jean*0069 C dTskin :: temp. correction for daily-cycle heating [K] e749d70ece Jean*0070 C T1 :: near-surface air temperature (from Pot.Temp) b3097ed02d Jean*0071 C T0 :: near-surface air temperature (2-dim) 0072 C Q0 :: near-surface sp. humidity [g/kg](2-dim) 0073 C-- Input: 0074 C kGrd :: Ground level index (2-dim) 0075 C bi,bj :: tile index 0076 C myThid :: Thread number for this instance of the routine 0077 C-- 0078 _RL PSA(NGP), TA(NGP,NLEV), QA(NGP,NLEV), RH(NGP,NLEV) 0079 _RL ThA(NGP,NLEV) 0080 _RL Vsurf2(NGP), WVS(NGP), CLAT(NGP), FOROG(NGP) 0081 _RL FMASK(NGP,3), TLAND(NGP), TSEA(NGP), TSICE(NGP) 0082 _RL SSR(NGP) 0083 e749d70ece Jean*0084 _RL SPEED0(NGP), DRAG(NGP,0:3), T1(NGP), DENVV(NGP) b3097ed02d Jean*0085 _RL dTskin(NGP), T0(NGP), Q0(NGP) 0086 0087 INTEGER kGrd(NGP) 0088 INTEGER bi,bj,myThid 0089 CEOP 0090 0091 #ifdef ALLOW_AIM 0092 0093 C-- Local variables: e749d70ece Jean*0094 _RL QSAT0(NGP,2) b3097ed02d Jean*0095 0096 INTEGER J, Ktmp, NL1 0097 _RL tmpRH(NGP) 0098 _RL factWind2, kappa 0099 0100 C- jmc: declare all local variables: e749d70ece Jean*0101 _RL GTEMP0, GHUM0, RCP, PRD, VG2 0102 c _RL RDTH, FSLAND, FSSEA, FSSICE b3097ed02d Jean*0103 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0104 0105 C-- 1. Extrapolation of wind, temp, hum. and density to the surface 0106 0107 C 1.1 Wind components 0108 0109 c DO J=1,NGP 0110 c U0(J) = 0.0 0111 c V0(J) = 0.0 0112 c Ktmp = kGrd(J) 0113 c IF ( Ktmp.GT.0 ) THEN 0114 c U0(J) = FWIND0*UA(J,Ktmp) 0115 c V0(J) = FWIND0*VA(J,Ktmp) 0116 c ENDIF 0117 c ENDDO 0118 0119 C 1.2 Temperature 0120 0121 GTEMP0 = 1.-FTEMP0 0122 RCP = 1. _d 0 /CP 0123 kappa = RD/CP 0124 C 0125 DO J=1,NGP 0126 Ktmp = kGrd(J) 0127 NL1 = Ktmp-1 0128 IF ( Ktmp.GT.1 ) THEN 0129 c_FM T0(J) = TA(J,NLEV)+WVI(NLEV,2)*(TA(J,NLEV)-TA(J,NL1)) 0130 c_FM T1(J) = TA(J,NLEV)+RCP*(PHI(J,NLEV)-PHI0(J)) 0131 T0(J) = TA(J,Ktmp) + WVS(J)*(TA(J,Ktmp)-TA(J,NL1)) 0132 Cjmc: used previously but not valid with partial cell ! 0133 c T1(J) = TA(J,Ktmp)*(SIGH(Ktmp)/SIG(Ktmp))**kappa 0134 T1(J) = ThA(J,Ktmp)*(PSA(J)**kappa) 0135 tmpRH(J)=RH(J,Ktmp) 0136 ELSE 0137 T0(J) = 273.16 _d 0 0138 T1(J) = 273.16 _d 0 0139 tmpRH(J)= 0. 0140 ENDIF 0141 ENDDO 0142 0143 DO J=1,NGP d454168a5d Jean*0144 c T0(J) = FTEMP0*T0(J)+GTEMP0*T1(J) 0145 T0(J) = FTEMP0*MIN(T0(J),T1(J))+GTEMP0*T1(J) b3097ed02d Jean*0146 ENDDO 0147 0148 C 1.3 Spec. humidity 0149 0150 GHUM0 = 1.-FHUM0 0151 0152 CALL SHTORH (-1,NGP,T0, PSA, 1. _d 0, Q0, tmpRH, QSAT0, myThid) 0153 0154 DO J=1,NGP 0155 IF ( kGrd(J) .GT. 0 ) THEN 0156 Q0(J)=FHUM0*Q0(J)+GHUM0*QA(J,kGrd(J)) 0157 ENDIF 0158 ENDDO 0159 0160 C 1.4 Density * wind speed (including gustiness factor) 0161 0162 PRD = P0/RD 0163 VG2 = VGUST*VGUST 0164 factWind2 = FWIND0*FWIND0 0165 0166 DO J=1,NGP 0167 c_FM DENVV(J)=(PRD*PSA(J)/T0(J))* 0168 c_FM & SQRT(U0(J)*U0(J)+V0(J)*V0(J)+VG2) 0169 SPEED0(J)=SQRT(factWind2*Vsurf2(J)+VG2) 0170 DENVV(J)=(PRD*PSA(J)/T0(J))*SPEED0(J) 0171 ENDDO 0172 0173 C 1.5 Define effective skin temperature to compensate for 0174 C non-linearity of heat/moisture fluxes during the daily cycle 0175 C Tskin = Tland + dTskin 0176 0177 DO J=1,NGP 0178 dTskin(J)=CTDAY*CLAT(J)*SSR(J)*PSA(J) 0179 ENDDO 0180 0181 0182 C-- 2. Computation of fluxes over land and sea 0183 0184 C 2.1 Wind stress 0185 0186 C Orographic correction 0187 0188 DO J=1,NGP 0189 c CDENVV(J,1)=CDL*DENVV(J)*FOROG(J) 0190 c CDENVV(J,2)=CDS*DENVV(J) 0191 DRAG(J,1) = CDL*DENVV(J)*FOROG(J) 0192 DRAG(J,2) = CDS*DENVV(J) 0193 DRAG(J,3) = CDS*DENVV(J) 0194 ENDDO 0195 0196 C - Notes: 0197 C Because of a different mapping between the Drag and the Wind (A/C-grid) 0198 C the surface stress is computed later, in "External Forcing", 0199 C Here compute only surface drag term (= C_drag*Rho*|V| ) 0200 0201 c DO J=1,NGP 0202 c USTR(J,1) = -CDENVV(J,1)*UA(J,NLEV) 0203 c VSTR(J,1) = -CDENVV(J,1)*VA(J,NLEV) 0204 c USTR(J,2) = -CDENVV(J,2)*UA(J,NLEV) 0205 c VSTR(J,2) = -CDENVV(J,2)*VA(J,NLEV) 0206 c ENDDO 0207 0208 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0209 #endif /* ALLOW_AIM */ 0210 0211 RETURN 0212 END 0213 0214 SUBROUTINE SFLSET (PHI0, FOROG, bi,bj,myThid) 0215 C-- 0216 C-- SUBROUTINE SFLSET (PHI0) 0217 C-- 0218 C-- Purpose: compute orographic factor for land surface drag 0219 C-- Input: PHI0 = surface geopotential (2-dim) 0220 C Output: FOROG = orographic factor (surf. drag) (2-dim) 0221 C-- (originally in common blocks: SFLFIX) 0222 0223 IMPLICIT NONE 0224 0225 C Resolution parameters 0226 0227 C-- size for MITgcm & Physics package : 0228 #include "AIM_SIZE.h" 0229 0230 #include "EEPARAMS.h" 0231 0232 C Physical constants + functions of sigma and latitude 0233 #include "com_physcon.h" 0234 0235 C Surface flux constants 0236 #include "com_sflcon.h" 0237 0238 C-- Routine arguments: 0239 INTEGER bi,bj,myThid 0240 _RL PHI0(NGP) 0241 _RL FOROG(NGP) 0242 0243 #ifdef ALLOW_AIM 0244 0245 C-- Local variables: 0246 INTEGER J 0247 _RL RHDRAG 0248 0249 RHDRAG = 1./(GG*HDRAG) 0250 0251 DO J=1,NGP 0252 FOROG(J) = 1. _d 0 0253 & + FHDRAG*(1. _d 0 - EXP(-MAX(PHI0(J),0. _d 0)*RHDRAG) ) 0254 ENDDO 0255 0256 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 0257 #endif /* ALLOW_AIM */ 0258 0259 RETURN 0260 END
| [ Source navigation ] | [ Diff markup ] | [ Identifier search ] | [ general search ] |
|
This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine. The LXR team |
|