/[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.5 by adcroft, Mon Jun 4 20:30:49 2001 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 47  C     _RL decayFac Line 48  C     _RL decayFac
48  C     _RL velDragHeightFac  C     _RL velDragHeightFac
49        _RL termP,kV,kF        _RL termP,kV,kF
50    
51    C--   Forcing term(s)
52        kF=1./86400.        kF=1./86400.
53        DO J=jMin,jMax        DO J=jMin,jMax
54         DO I=iMin,iMax         DO I=iMin,iMax
# Line 54  C     _RL velDragHeightFac Line 56  C     _RL velDragHeightFac
56  C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,  C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
57  C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )  C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )
58           termP=0.5*( rF(kLev) + rF(kLev+1) )           termP=0.5*( rF(kLev) + rF(kLev+1) )
59  C        termP=rC(kLev)           kV=kF*MAX(0. _d 0,
60           kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )       &   (termP*recip_Rcol(I,J,bi,bj)-0.7 _d 0)/(1. _d 0-0.7 _d 0) )
61           gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
62       &                      -kV*uVel(i,j,kLev,bi,bj)       &                      -kV*uVel(i,j,kLev,bi,bj)
63          ENDIF          ENDIF
# Line 109  C     _RL decayFac Line 111  C     _RL decayFac
111  C     _RL velDragHeightFac  C     _RL velDragHeightFac
112        _RL termP,kV,kF        _RL termP,kV,kF
113    
114    C--   Forcing term(s)
115        kF=1./86400.        kF=1./86400.
116        DO J=jMin,jMax        DO J=jMin,jMax
117         DO I=iMin,iMax         DO I=iMin,iMax
# Line 116  C     _RL velDragHeightFac Line 119  C     _RL velDragHeightFac
119  C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,  C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
120  C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )  C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )
121           termP=0.5*( rF(kLev) + rF(kLev+1) )           termP=0.5*( rF(kLev) + rF(kLev+1) )
122  C        termP=rC(kLev)           kV=kF*MAX(0. _d 0,
123           kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )       &   (termP*recip_Rcol(I,J,bi,bj)-0.7 _d 0)/(1. _d 0-0.7 _d 0) )
124           gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
125       &                      -kV*vVel(i,j,kLev,bi,bj)       &                      -kV*vVel(i,j,kLev,bi,bj)
126          ENDIF          ENDIF
# Line 129  C        termP=rC(kLev) Line 132  C        termP=rC(kLev)
132  CStartOfInterface  CStartOfInterface
133        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
134       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
135       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
136  C     /==========================================================\  C     /==========================================================\
137  C     | S/R EXTERNAL_FORCING_T                                   |  C     | S/R EXTERNAL_FORCING_T                                   |
# Line 154  C     iMax Line 156  C     iMax
156  C     jMin  C     jMin
157  C     jMax  C     jMax
158  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
159        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
160        _RL myCurrentTime        _RL myCurrentTime
161        INTEGER myThid        INTEGER myThid
# Line 165  C     Loop counters Line 166  C     Loop counters
166        INTEGER I, J        INTEGER I, J
167        _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf        _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf
168    
169        rSurf=1.E5  C--   Forcing term(s)
170        ka=1./(40.*86400.)        rSurf=1. _d 05
171        ks=1./(4. *86400.)        ka=1. _d 0/(40. _d 0*86400. _d 0)
172          ks=1. _d 0/(4. _d 0 *86400. _d 0)
173        DO J=jMin,jMax        DO J=jMin,jMax
174         term1=60.*(sin(yC(1,J,bi,bj)*deg2rad)**2)         term1=60. _d 0*(sin(yC(1,J,bi,bj)*deg2rad)**2)
175  C      termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )  C      termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )
176         termP=0.5*( rF(kLev) + rF(kLev+1) )         termP=0.5*( rF(kLev) + rF(kLev+1) )
177  C      termP=rC(kLev)         term2=10. _d 0*log(termP/rSurf)
        term2=10.*log(termP/rSurf)  
178       &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)       &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)
179         thetaLim = 200. / ((termP/rSurf)**(2./7.))         thetaLim = 200. _d 0/((termP/rSurf)**(2. _d 0/7. _d 0))
180         thetaEq=315.-term1-term2         thetaEq=315.-term1-term2
181         thetaEq=MAX(thetaLim,thetaEq)         thetaEq=MAX(thetaLim,thetaEq)
182         DO I=iMin,iMax         DO I=iMin,iMax
183          kT=ka+(ks-ka)          kT=ka+(ks-ka)
184       &    *MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )       &    *MAX(0.,
185         &    (termP*recip_Rcol(I,J,bi,bj)-0.7 _d 0)/(1. _d 0-0.7 _d 0) )
186       &    *COS((yC(1,J,bi,bj)*deg2rad))**4       &    *COS((yC(1,J,bi,bj)*deg2rad))**4
187           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
188       &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )       &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
189       &            *maskC(i,j)       &            *maskC(i,j,kLev,bi,bj)
190         ENDDO         ENDDO
191        ENDDO        ENDDO
192    
# Line 193  C      termP=rC(kLev) Line 195  C      termP=rC(kLev)
195  CStartOfInterface  CStartOfInterface
196        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
197       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
198       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
199  C     /==========================================================\  C     /==========================================================\
200  C     | S/R EXTERNAL_FORCING_S                                   |  C     | S/R EXTERNAL_FORCING_S                                   |
# Line 218  C     iMax Line 219  C     iMax
219  C     jMin  C     jMin
220  C     jMax  C     jMax
221  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
222        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
223        _RL myCurrentTime        _RL myCurrentTime
224        INTEGER myThid        INTEGER myThid
# Line 228  C     == Local variables == Line 228  C     == Local variables ==
228  C     Loop counters  C     Loop counters
229        INTEGER I, J        INTEGER I, J
230    
231    C--   Forcing term(s)
232    
233        RETURN        RETURN
234        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22