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

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

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

revision 1.3 by cnh, Sun Feb 4 14:38:53 2001 UTC revision 1.4 by adcroft, Tue May 29 14:01:58 2001 UTC
# Line 14  C     |================================= Line 14  C     |=================================
14  C     | Adds terms to gU for forcing by external sources         |  C     | Adds terms to gU for forcing by external sources         |
15  C     | e.g. wind stress, bottom friction etc..................  |  C     | e.g. wind stress, bottom friction etc..................  |
16  C     \==========================================================/  C     \==========================================================/
17          IMPLICIT NONE
18    
19  C     == Global data ==  C     == Global data ==
20  #include "SIZE.h"  #include "SIZE.h"
# Line 23  C     == Global data == Line 24  C     == Global data ==
24  #include "DYNVARS.h"  #include "DYNVARS.h"
25  #include "FFIELDS.h"  #include "FFIELDS.h"
26    
 #ifdef USE_FRANCO_PHYSICS  
 #include "atparam0.h"  
 #include "atparam1.h"  
       INTEGER NGP  
       INTEGER NLON  
       INTEGER NLAT  
       INTEGER NLEV  
       PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )  
 #include "com_physvar.h"  
 #define _KDKA( KD ) Nr-KD+1  
 #endif  
   
27  C     == Routine arguments ==  C     == Routine arguments ==
28  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
29  C     iMax  C     iMax
# Line 64  C--   Forcing term(s) Line 53  C--   Forcing term(s)
53        DO J=jMin,jMax        DO J=jMin,jMax
54         DO I=iMin,iMax         DO I=iMin,iMax
55          IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN          IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
56    C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
57    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           kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )           kV=kF*MAX(0., (termP*recip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
60           gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
61       &                      -kV*uVel(i,j,kLev,bi,bj)       &                      -kV*uVel(i,j,kLev,bi,bj)
62          ENDIF          ENDIF
# Line 124  C--   Forcing term(s) Line 115  C--   Forcing term(s)
115        DO J=jMin,jMax        DO J=jMin,jMax
116         DO I=iMin,iMax         DO I=iMin,iMax
117          IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN          IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
118    C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
119    C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )
120           termP=0.5*( rF(kLev) + rF(kLev+1) )           termP=0.5*( rF(kLev) + rF(kLev+1) )
121           kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )           kV=kF*MAX(0., (termP*recip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
122           gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
123       &                      -kV*vVel(i,j,kLev,bi,bj)       &                      -kV*vVel(i,j,kLev,bi,bj)
124          ENDIF          ENDIF
# Line 134  C--   Forcing term(s) Line 127  C--   Forcing term(s)
127    
128        RETURN        RETURN
129        END        END
   
130  CStartOfInterface  CStartOfInterface
131        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
132       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
133       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
134  C     /==========================================================\  C     /==========================================================\
135  C     | S/R EXTERNAL_FORCING_T                                   |  C     | S/R EXTERNAL_FORCING_T                                   |
# Line 157  C     == Global data == Line 148  C     == Global data ==
148  #include "DYNVARS.h"  #include "DYNVARS.h"
149  #include "FFIELDS.h"  #include "FFIELDS.h"
150    
 #ifdef USE_FRANCO_PHYSICS  
 #include "atparam0.h"  
 #include "atparam1.h"  
       INTEGER NGP  
       INTEGER NLON  
       INTEGER NLAT  
       INTEGER NLEV  
       PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )  
 #include "com_physvar.h"  
 #define _KDKA( KD ) Nr-KD+1  
 #endif  
   
151  C     == Routine arguments ==  C     == Routine arguments ==
152  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
153  C     iMax  C     iMax
154  C     jMin  C     jMin
155  C     jMax  C     jMax
156  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
157        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
158        _RL myCurrentTime        _RL myCurrentTime
159        INTEGER myThid        INTEGER myThid
# Line 194  C--   Forcing term(s) Line 172  C--   Forcing term(s)
172         term1=60.*(sin(yC(1,J,bi,bj)*deg2rad)**2)         term1=60.*(sin(yC(1,J,bi,bj)*deg2rad)**2)
173  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) ) )
174         termP=0.5*( rF(kLev) + rF(kLev+1) )         termP=0.5*( rF(kLev) + rF(kLev+1) )
 C      termP=rC(kLev)  
175         term2=10.*log(termP/rSurf)         term2=10.*log(termP/rSurf)
176       &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)       &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)
177         thetaLim = 200. / ((termP/rSurf)**(2./7.))         thetaLim = 200. / ((termP/rSurf)**(2./7.))
 C      thetaLim = 170. / ((termP/rSurf)**(2./7.))  
178         thetaEq=315.-term1-term2         thetaEq=315.-term1-term2
179         thetaEq=MAX(thetaLim,thetaEq)         thetaEq=MAX(thetaLim,thetaEq)
180         DO I=iMin,iMax         DO I=iMin,iMax
181          kT=ka+(ks-ka)          kT=ka+(ks-ka)
182       &    *MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )       &    *MAX(0., (termP*recip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
183       &    *COS((yC(1,J,bi,bj)*deg2rad))**4       &    *COS((yC(1,J,bi,bj)*deg2rad))**4
184           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
185       &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )       &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
186       &            *maskC(i,j)       &            *maskC(i,j,kLev,bi,bj)
187         ENDDO         ENDDO
188        ENDDO        ENDDO
189    
190        RETURN        RETURN
191        END        END
   
192  CStartOfInterface  CStartOfInterface
193        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
194       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
195       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
196  C     /==========================================================\  C     /==========================================================\
197  C     | S/R EXTERNAL_FORCING_S                                   |  C     | S/R EXTERNAL_FORCING_S                                   |
# Line 236  C     == Global data == Line 210  C     == Global data ==
210  #include "DYNVARS.h"  #include "DYNVARS.h"
211  #include "FFIELDS.h"  #include "FFIELDS.h"
212    
 #ifdef USE_FRANCO_PHYSICS  
 #include "atparam0.h"  
 #include "atparam1.h"  
       INTEGER NGP  
       INTEGER NLON  
       INTEGER NLAT  
       INTEGER NLEV  
       PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )  
 #include "com_physvar.h"  
 #define _KDKA( KD ) Nr-KD+1  
 #endif  
   
213  C     == Routine arguments ==  C     == Routine arguments ==
214  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
215  C     iMax  C     iMax
216  C     jMin  C     jMin
217  C     jMax  C     jMax
218  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
219        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
220        _RL myCurrentTime        _RL myCurrentTime
221        INTEGER myThid        INTEGER myThid
# Line 262  CEndOfInterface Line 223  CEndOfInterface
223    
224  C     == Local variables ==  C     == Local variables ==
225  C     Loop counters  C     Loop counters
226          INTEGER I, J
227    
228  C--   Forcing term  C--   Forcing term(s)
229    
230        RETURN        RETURN
231        END        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22