/[MITgcm]/MITgcm/model/src/external_forcing.F
ViewVC logotype

Diff of /MITgcm/model/src/external_forcing.F

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

revision 1.2 by cnh, Fri Nov 6 22:44:46 1998 UTC revision 1.8 by heimbach, Mon Nov 13 16:32:58 2000 UTC
# Line 1  Line 1 
1  C $Header$  C     $Header$
2    
3  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
4    
# Line 22  C     == Global data == Line 22  C     == Global data ==
22  #include "GRID.h"  #include "GRID.h"
23  #include "DYNVARS.h"  #include "DYNVARS.h"
24  #include "FFIELDS.h"  #include "FFIELDS.h"
   
25  C     == Routine arguments ==  C     == Routine arguments ==
26  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
27  C     iMax  C     iMax
# Line 30  C     jMin Line 29  C     jMin
29  C     jMax  C     jMax
30  C     kLev  C     kLev
31        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
32        INTEGER myCurrentTime, myThid        _RL myCurrentTime
33          INTEGER myThid
34  CEndOfInterface  CEndOfInterface
35    
36  C     == Local variables ==  C     == Local variables ==
# Line 43  C     Add windstress momentum impulse in Line 43  C     Add windstress momentum impulse in
43         DO j=jMin,jMax         DO j=jMin,jMax
44          DO i=iMin,iMax          DO i=iMin,iMax
45           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
46       &    + foFacMom*fu(i,j,bi,bj)*_maskW(i,j,kLev,bi,bj)       &   +foFacMom*surfaceTendencyU(i,j,bi,bj)
47         &   *_maskW(i,j,kLev,bi,bj)
48          ENDDO          ENDDO
49         ENDDO         ENDDO
50        ENDIF        ENDIF
# Line 79  C     jMin Line 80  C     jMin
80  C     jMax  C     jMax
81  C     kLev  C     kLev
82        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
83        INTEGER myCurrentTime, myThid        _RL myCurrentTime
84          INTEGER myThid
85  CEndOfInterface  CEndOfInterface
86  C     == Local variables ==  C     == Local variables ==
87  C     Loop counters  C     Loop counters
# Line 91  C     Add windstress momentum impulse in Line 93  C     Add windstress momentum impulse in
93         DO j=jMin,jMax         DO j=jMin,jMax
94          DO i=iMin,iMax          DO i=iMin,iMax
95           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
96       &    + foFacMom*fv(i,j,bi,bj)*_maskS(i,j,kLev,bi,bj)       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)
97         &   *_maskS(i,j,kLev,bi,bj)
98          ENDDO          ENDDO
99         ENDDO         ENDDO
100        ENDIF        ENDIF
# Line 119  C     == Global data == Line 122  C     == Global data ==
122  #include "GRID.h"  #include "GRID.h"
123  #include "DYNVARS.h"  #include "DYNVARS.h"
124  #include "FFIELDS.h"  #include "FFIELDS.h"
125    #ifdef SHORTWAVE_HEATING
126          integer two
127          _RL minusone
128          parameter (two=2,minusone=-1.)
129          _RL swfracb(two)
130    #endif
131    
132    
133  C     == Routine arguments ==  C     == Routine arguments ==
134  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
# Line 128  C     jMax Line 138  C     jMax
138  C     kLev  C     kLev
139        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
140        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
141        INTEGER myCurrentTime, myThid        _RL myCurrentTime
142          INTEGER myThid
143  CEndOfInterface  CEndOfInterface
144    
145  C     == Local variables ==  C     == Local variables ==
# Line 141  C     Add heat in top-layer Line 152  C     Add heat in top-layer
152         DO j=jMin,jMax         DO j=jMin,jMax
153          DO i=iMin,iMax          DO i=iMin,iMax
154           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
155       &  +maskC(i,j)*(       &     +maskC(i,j)*surfaceTendencyT(i,j,bi,bj)
      &   -lambdaThetaClimRelax*(theta(i,j,kLev,bi,bj)-SST(i,j,bi,bj))  
      &   -Qnet(i,j,bi,bj) )  
156          ENDDO          ENDDO
157         ENDDO         ENDDO
158        ENDIF        ENDIF
159    
160    #ifdef SHORTWAVE_HEATING
161    C Penetrating SW radiation
162          swfracb(1)=abs(rF(klev))
163          swfracb(2)=abs(rF(klev+1))
164          call SWFRAC(
165         I     two,minusone,
166         I     myCurrentTime,myThid,
167         O     swfracb)
168          DO j=jMin,jMax
169           DO i=iMin,iMax
170            gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
171         &    +maskC(i,j)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
172           ENDDO
173          ENDDO
174    #endif
175        RETURN        RETURN
176        END        END
177  CStartOfInterface  CStartOfInterface
# Line 180  C     jMax Line 204  C     jMax
204  C     kLev  C     kLev
205        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
206        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
207        INTEGER myCurrentTime, myThid        _RL myCurrentTime
208          INTEGER myThid
209  CEndOfInterface  CEndOfInterface
210    
211  C     == Local variables ==  C     == Local variables ==
# Line 193  C     Add fresh-water in top-layer Line 218  C     Add fresh-water in top-layer
218         DO j=jMin,jMax         DO j=jMin,jMax
219          DO i=iMin,iMax          DO i=iMin,iMax
220           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
221       &   +maskC(i,j)*(       &   +maskC(i,j)*surfaceTendencyS(i,j,bi,bj)
      &   -lambdaSaltClimRelax*(salt(i,j,kLev,bi,bj)-SSS(i,j,bi,bj))  
      &   +EmPmR(i,j,bi,bj) )  
222          ENDDO          ENDDO
223         ENDDO         ENDDO
224        ENDIF        ENDIF

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.22