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

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

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

Revision 1.3 - (hide annotations) (download)
Tue Dec 15 00:20:34 1998 UTC (26 years, 7 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint19, checkpoint20
Changes since 1.2: +12 -5 lines 
 o Added "natural BCs" as alternative to "virtual salt flux"
 o Re-difined precFloat32 and precFloat64 to be 32 and 64
   so that their values can be meaningfuly set in the data file
 o Modified read_write.F to create an exception if readBinaryPrec
   is not set
 o Replaced CPP control of viscous BCs with run-time control
 o Tidied up input-data precision (ie. ini_depths cnh_dbg...)
 o ini_forcing.F now initialises *all* forcing arrays to zero
 o Definitively tested verification experiments 0,1,2 and 4
   (3 is atmospheric set-up which is in a state of flux)
1 adcroft 1.3 C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.2 1998/11/06 22:44:46 cnh Exp $
2 cnh 1.1
3     #include "CPP_OPTIONS.h"
4    
5     CStartOfInterface
6     SUBROUTINE EXTERNAL_FORCING_U(
7     I iMin, iMax, jMin, jMax,bi,bj,kLev,
8     I myCurrentTime,myThid)
9     C /==========================================================\
10     C | S/R EXTERNAL_FORCING_U |
11     C | o Contains problem specific forcing for zonal velocity. |
12     C |==========================================================|
13     C | Adds terms to gU for forcing by external sources |
14     C | e.g. wind stress, bottom friction etc.................. |
15     C \==========================================================/
16 cnh 1.2 IMPLICIT NONE
17 cnh 1.1
18     C == Global data ==
19     #include "SIZE.h"
20     #include "EEPARAMS.h"
21     #include "PARAMS.h"
22     #include "GRID.h"
23     #include "DYNVARS.h"
24 cnh 1.2 #include "FFIELDS.h"
25 cnh 1.1
26     C == Routine arguments ==
27     C iMin - Working range of tile for applying forcing.
28     C iMax
29     C jMin
30     C jMax
31     C kLev
32     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
33     INTEGER myCurrentTime, myThid
34     CEndOfInterface
35    
36 cnh 1.2 C == Local variables ==
37     C Loop counters
38     INTEGER I, J
39    
40     C-- Forcing term
41     C Add windstress momentum impulse into the top-layer
42     IF ( kLev .EQ. 1 ) THEN
43     DO j=jMin,jMax
44     DO i=iMin,iMax
45     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
46 adcroft 1.3 & +foFacMom*fu(i,j,bi,bj)
47     & *horiVertRatio*recip_rhoNil*recip_dRf(kLev)
48     & *_maskW(i,j,kLev,bi,bj)
49 cnh 1.2 ENDDO
50     ENDDO
51     ENDIF
52    
53 cnh 1.1 RETURN
54     END
55     CStartOfInterface
56     SUBROUTINE EXTERNAL_FORCING_V(
57     I iMin, iMax, jMin, jMax,bi,bj,kLev,
58     I myCurrentTime,myThid)
59     C /==========================================================\
60     C | S/R EXTERNAL_FORCING_V |
61     C | o Contains problem specific forcing for merid velocity. |
62     C |==========================================================|
63     C | Adds terms to gV for forcing by external sources |
64     C | e.g. wind stress, bottom friction etc.................. |
65     C \==========================================================/
66 cnh 1.2 IMPLICIT NONE
67 cnh 1.1
68     C == Global data ==
69     #include "SIZE.h"
70     #include "EEPARAMS.h"
71     #include "PARAMS.h"
72     #include "GRID.h"
73     #include "DYNVARS.h"
74 cnh 1.2 #include "FFIELDS.h"
75    
76 cnh 1.1
77     C == Routine arguments ==
78     C iMin - Working range of tile for applying forcing.
79     C iMax
80     C jMin
81     C jMax
82     C kLev
83     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
84     INTEGER myCurrentTime, myThid
85     CEndOfInterface
86 cnh 1.2 C == Local variables ==
87     C Loop counters
88     INTEGER I, J
89    
90     C-- Forcing term
91     C Add windstress momentum impulse into the top-layer
92     IF ( kLev .EQ. 1 ) THEN
93     DO j=jMin,jMax
94     DO i=iMin,iMax
95     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
96 adcroft 1.3 & +foFacMom*fv(i,j,bi,bj)
97     & *horiVertRatio*recip_rhoNil*recip_dRf(kLev)
98     & *_maskS(i,j,kLev,bi,bj)
99 cnh 1.2 ENDDO
100     ENDDO
101     ENDIF
102 cnh 1.1
103     RETURN
104     END
105     CStartOfInterface
106     SUBROUTINE EXTERNAL_FORCING_T(
107     I iMin, iMax, jMin, jMax,bi,bj,kLev,
108 cnh 1.2 I maskC,
109 cnh 1.1 I myCurrentTime,myThid)
110     C /==========================================================\
111     C | S/R EXTERNAL_FORCING_T |
112     C | o Contains problem specific forcing for temperature. |
113     C |==========================================================|
114     C | Adds terms to gT for forcing by external sources |
115     C | e.g. heat flux, climatalogical relaxation.............. |
116     C \==========================================================/
117 cnh 1.2 IMPLICIT NONE
118 cnh 1.1
119     C == Global data ==
120     #include "SIZE.h"
121     #include "EEPARAMS.h"
122     #include "PARAMS.h"
123     #include "GRID.h"
124     #include "DYNVARS.h"
125     #include "FFIELDS.h"
126    
127     C == Routine arguments ==
128     C iMin - Working range of tile for applying forcing.
129     C iMax
130     C jMin
131     C jMax
132     C kLev
133 cnh 1.2 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
134 cnh 1.1 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
135     INTEGER myCurrentTime, myThid
136     CEndOfInterface
137    
138 cnh 1.2 C == Local variables ==
139     C Loop counters
140     INTEGER I, J
141    
142     C-- Forcing term
143     C Add heat in top-layer
144     IF ( kLev .EQ. 1 ) THEN
145     DO j=jMin,jMax
146     DO i=iMin,iMax
147     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
148     & +maskC(i,j)*(
149     & -lambdaThetaClimRelax*(theta(i,j,kLev,bi,bj)-SST(i,j,bi,bj))
150 adcroft 1.3 & -Qnet(i,j,bi,bj)*recip_Cp*recip_rhoNil*recip_dRf(kLev) )
151 cnh 1.2 ENDDO
152     ENDDO
153     ENDIF
154    
155 cnh 1.1 RETURN
156     END
157     CStartOfInterface
158     SUBROUTINE EXTERNAL_FORCING_S(
159     I iMin, iMax, jMin, jMax,bi,bj,kLev,
160 cnh 1.2 I maskC,
161 cnh 1.1 I myCurrentTime,myThid)
162     C /==========================================================\
163     C | S/R EXTERNAL_FORCING_S |
164     C | o Contains problem specific forcing for merid velocity. |
165     C |==========================================================|
166     C | Adds terms to gS for forcing by external sources |
167     C | e.g. fresh-water flux, climatalogical relaxation....... |
168     C \==========================================================/
169 cnh 1.2 IMPLICIT NONE
170 cnh 1.1
171     C == Global data ==
172     #include "SIZE.h"
173     #include "EEPARAMS.h"
174     #include "PARAMS.h"
175     #include "GRID.h"
176     #include "DYNVARS.h"
177 cnh 1.2 #include "FFIELDS.h"
178 cnh 1.1
179     C == Routine arguments ==
180     C iMin - Working range of tile for applying forcing.
181     C iMax
182     C jMin
183     C jMax
184     C kLev
185 cnh 1.2 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
186 cnh 1.1 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
187     INTEGER myCurrentTime, myThid
188     CEndOfInterface
189 cnh 1.2
190     C == Local variables ==
191     C Loop counters
192     INTEGER I, J
193    
194     C-- Forcing term
195     C Add fresh-water in top-layer
196     IF ( kLev .EQ. 1 ) THEN
197     DO j=jMin,jMax
198     DO i=iMin,iMax
199     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
200     & +maskC(i,j)*(
201     & -lambdaSaltClimRelax*(salt(i,j,kLev,bi,bj)-SSS(i,j,bi,bj))
202 adcroft 1.3 #ifndef USE_NATURAL_BCS
203     & +EmPmR(i,j,bi,bj)*recip_dRf(1)*35.
204     #endif
205     & )
206 cnh 1.2 ENDDO
207     ENDDO
208     ENDIF
209 cnh 1.1
210     RETURN
211     END
  ViewVC Help
Powered by ViewVC 1.1.22