/[MITgcm]/MITgcm/verification/hs94.128x64x5/code/external_forcing.F
ViewVC logotype

Diff of /MITgcm/verification/hs94.128x64x5/code/external_forcing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by adcroft, Fri Feb 2 21:36:33 2001 UTC revision 1.7 by jmc, Wed May 1 00:56:11 2002 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
# Line 37  CEndOfInterface Line 38  CEndOfInterface
38  C     == Local variables ==  C     == Local variables ==
39  C     Loop counters  C     Loop counters
40        INTEGER I, J        INTEGER I, J
41  C     _RL uKf        _RL recip_P0g,termP,kV,kF,sigma_b
 C     _RL levelOfGround  
 C     _RL criticalLevel  
 C     _RL levelOfVelPoint  
 C     _RL dist1  
 C     _RL dist2  
 C     _RL decayFac  
 C     _RL velDragHeightFac  
       _RL termP,kV,kF  
42    
43        kF=1./86400.  C--   Forcing term(s)
44        DO J=jMin,jMax        kF=1. _d 0/86400. _d 0
45         DO I=iMin,iMax        sigma_b = 0.7 _d 0
46          IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN  c     DO J=jMin,jMax
47  C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,  c      DO I=iMin,iMax
48  C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )        DO J=1,sNy
49           termP=0.5*( rF(kLev) + rF(kLev+1) )         DO I=1,sNx+1
50  C        termP=rC(kLev)          IF ( hFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
51           kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )           recip_P0g=MAX(recip_Rcol(I,J,bi,bj),recip_Rcol(I-1,J,bi,bj))
52             termP=0.5 _d 0*( MIN(rF(kLev)*recip_P0g,1. _d 0)
53         &                   +rF(kLev+1)*recip_P0g )
54             kV=kF*MAX( 0. _d 0, (termP-sigma_b)/(1. _d 0-sigma_b) )
55           gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
56       &                      -kV*uVel(i,j,kLev,bi,bj)       &                      -kV*uVel(i,j,kLev,bi,bj)
57          ENDIF          ENDIF
# Line 99  CEndOfInterface Line 95  CEndOfInterface
95  C     == Local variables ==  C     == Local variables ==
96  C     Loop counters  C     Loop counters
97        INTEGER I, J        INTEGER I, J
98  C     _RL uKf        _RL recip_P0g,termP,kV,kF,sigma_b
 C     _RL levelOfGround  
 C     _RL criticalLevel  
 C     _RL levelOfVelPoint  
 C     _RL dist1  
 C     _RL dist2  
 C     _RL decayFac  
 C     _RL velDragHeightFac  
       _RL termP,kV,kF  
99    
100        kF=1./86400.  C--   Forcing term(s)
101        DO J=jMin,jMax        kF=1. _d 0/86400. _d 0
102         DO I=iMin,iMax        sigma_b = 0.7 _d 0
103          IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN  c     DO J=jMin,jMax
104  C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,  c      DO I=iMin,iMax
105  C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )        DO J=1,sNy+1
106           termP=0.5*( rF(kLev) + rF(kLev+1) )         DO I=1,sNx
107  C        termP=rC(kLev)          IF ( hFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
108           kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )           recip_P0g=MAX(recip_Rcol(I,J,bi,bj),recip_Rcol(I,J-1,bi,bj))
109             termP=0.5 _d 0*( MIN(rF(kLev)*recip_P0g,1. _d 0)
110         &                   +rF(kLev+1)*recip_P0g )
111             kV=kF*MAX( 0. _d 0, (termP-sigma_b)/(1. _d 0-sigma_b) )
112           gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
113       &                      -kV*vVel(i,j,kLev,bi,bj)       &                      -kV*vVel(i,j,kLev,bi,bj)
114          ENDIF          ENDIF
# Line 129  C        termP=rC(kLev) Line 120  C        termP=rC(kLev)
120  CStartOfInterface  CStartOfInterface
121        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
122       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
123       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
124  C     /==========================================================\  C     /==========================================================\
125  C     | S/R EXTERNAL_FORCING_T                                   |  C     | S/R EXTERNAL_FORCING_T                                   |
# Line 154  C     iMax Line 144  C     iMax
144  C     jMin  C     jMin
145  C     jMax  C     jMax
146  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
147        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
148        _RL myCurrentTime        _RL myCurrentTime
149        INTEGER myThid        INTEGER myThid
# Line 163  CEndOfInterface Line 152  CEndOfInterface
152  C     == Local variables ==  C     == Local variables ==
153  C     Loop counters  C     Loop counters
154        INTEGER I, J        INTEGER I, J
155        _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf        _RL thetaLim,kT,ka,ks,sigma_b,term1,term2,thetaEq,termP
156    
157        rSurf=1.E5  C--   Forcing term(s)
158        ka=1./(40.*86400.)        ka=1. _d 0/(40. _d 0*86400. _d 0)
159        ks=1./(4. *86400.)        ks=1. _d 0/(4. _d 0 *86400. _d 0)
160          sigma_b = 0.7 _d 0
161        DO J=jMin,jMax        DO J=jMin,jMax
        term1=60.*(sin(yC(1,J,bi,bj)*deg2rad)**2)  
 C      termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )  
        termP=0.5*( rF(kLev) + rF(kLev+1) )  
 C      termP=rC(kLev)  
        term2=10.*log(termP/rSurf)  
      &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)  
        thetaLim = 200. / ((termP/rSurf)**(2./7.))  
        thetaEq=315.-term1-term2  
        thetaEq=MAX(thetaLim,thetaEq)  
162         DO I=iMin,iMax         DO I=iMin,iMax
163          kT=ka+(ks-ka)           term1=60. _d 0*(sin(yC(I,J,bi,bj)*deg2rad)**2)
164       &    *MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )           termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )
165       &    *COS((yC(1,J,bi,bj)*deg2rad))**4           term2=10. _d 0*log(termP/atm_po)
166         &            *(cos(yC(I,J,bi,bj)*deg2rad)**2)
167             thetaLim = 200. _d 0/ ((termP/atm_po)**atm_kappa)
168             thetaEq=315. _d 0-term1-term2
169             thetaEq=MAX(thetaLim,thetaEq)
170             termP=0.5 _d 0*( MIN(rF(kLev),Ro_surf(I,J,bi,bj))+rF(kLev+1) )
171             kT=ka+(ks-ka)
172         &     *MAX(0. _d 0,
173         &       (termP*recip_Rcol(I,J,bi,bj)-sigma_b)/(1. _d 0-sigma_b) )
174         &     *COS((yC(I,J,bi,bj)*deg2rad))**4
175           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
176       &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )       &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
177       &            *maskC(i,j)       &            *maskC(i,j,kLev,bi,bj)
178         ENDDO         ENDDO
179        ENDDO        ENDDO
180    
# Line 193  C      termP=rC(kLev) Line 183  C      termP=rC(kLev)
183  CStartOfInterface  CStartOfInterface
184        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
185       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
186       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
187  C     /==========================================================\  C     /==========================================================\
188  C     | S/R EXTERNAL_FORCING_S                                   |  C     | S/R EXTERNAL_FORCING_S                                   |
# Line 218  C     iMax Line 207  C     iMax
207  C     jMin  C     jMin
208  C     jMax  C     jMax
209  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
210        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
211        _RL myCurrentTime        _RL myCurrentTime
212        INTEGER myThid        INTEGER myThid
# Line 228  C     == Local variables == Line 216  C     == Local variables ==
216  C     Loop counters  C     Loop counters
217        INTEGER I, J        INTEGER I, J
218    
219    C--   Forcing term(s)
220    
221        RETURN        RETURN
222        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22