/[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.9 - (hide annotations) (download)
Wed Nov 29 22:29:23 2000 UTC (23 years, 6 months ago) by adcroft
Branch: MAIN
CVS Tags: branch-atmos-merge-freeze, branch-atmos-merge-start, branch-atmos-merge-shapiro, checkpoint33, checkpoint34, branch-atmos-merge-zonalfilt, branch-atmos-merge-phase5, branch-atmos-merge-phase4, branch-atmos-merge-phase7, branch-atmos-merge-phase6, branch-atmos-merge-phase1, branch-atmos-merge-phase3, branch-atmos-merge-phase2
Branch point for: branch-atmos-merge
Changes since 1.8: +3 -2 lines 
Fixed confusion about units of forcing arrays in FFIELDS.h
namely Fu,Fv,Qnet,Qsw,EmPmR:
  - Removed verification/natl_box/code/external_fields_scale.F
        (did not differ from that in model/src)
  - Changed units of fu,fv,Qnet,Qsw,EmPmR back to proper units
     (see FFIELDS.h for description)
  - Scale fu,fv,Qnet,Qsw,EmPmR when used in external_forcing_surf.F,
    kpp_calc.F and kpp_transport_t.F
  - Removed model/src/external_fields_scale.F and calls to it
  - verification/natl_box uses flux data with "atmospheric" sign so
    a special version of external_fields_load.F is used to
    change the data as it's read in. This way, the arrays
    have the right units and signs at all times tha a user could
    possibly use them.
1 adcroft 1.9 C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.8 2000/11/13 16:32:58 heimbach 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 C == Routine arguments ==
26     C iMin - Working range of tile for applying forcing.
27     C iMax
28     C jMin
29     C jMax
30     C kLev
31     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
32 adcroft 1.4 _RL myCurrentTime
33     INTEGER myThid
34 cnh 1.1 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 heimbach 1.7 & +foFacMom*surfaceTendencyU(i,j,bi,bj)
47 adcroft 1.3 & *_maskW(i,j,kLev,bi,bj)
48 cnh 1.2 ENDDO
49     ENDDO
50     ENDIF
51    
52 cnh 1.1 RETURN
53     END
54     CStartOfInterface
55     SUBROUTINE EXTERNAL_FORCING_V(
56     I iMin, iMax, jMin, jMax,bi,bj,kLev,
57     I myCurrentTime,myThid)
58     C /==========================================================\
59     C | S/R EXTERNAL_FORCING_V |
60     C | o Contains problem specific forcing for merid velocity. |
61     C |==========================================================|
62     C | Adds terms to gV for forcing by external sources |
63     C | e.g. wind stress, bottom friction etc.................. |
64     C \==========================================================/
65 cnh 1.2 IMPLICIT NONE
66 cnh 1.1
67     C == Global data ==
68     #include "SIZE.h"
69     #include "EEPARAMS.h"
70     #include "PARAMS.h"
71     #include "GRID.h"
72     #include "DYNVARS.h"
73 cnh 1.2 #include "FFIELDS.h"
74    
75 cnh 1.1
76     C == Routine arguments ==
77     C iMin - Working range of tile for applying forcing.
78     C iMax
79     C jMin
80     C jMax
81     C kLev
82     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
83 adcroft 1.4 _RL myCurrentTime
84     INTEGER myThid
85 cnh 1.1 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 heimbach 1.7 & +foFacMom*surfaceTendencyV(i,j,bi,bj)
97 adcroft 1.3 & *_maskS(i,j,kLev,bi,bj)
98 cnh 1.2 ENDDO
99     ENDDO
100     ENDIF
101 cnh 1.1
102     RETURN
103     END
104     CStartOfInterface
105     SUBROUTINE EXTERNAL_FORCING_T(
106     I iMin, iMax, jMin, jMax,bi,bj,kLev,
107 cnh 1.2 I maskC,
108 cnh 1.1 I myCurrentTime,myThid)
109     C /==========================================================\
110     C | S/R EXTERNAL_FORCING_T |
111     C | o Contains problem specific forcing for temperature. |
112     C |==========================================================|
113     C | Adds terms to gT for forcing by external sources |
114     C | e.g. heat flux, climatalogical relaxation.............. |
115     C \==========================================================/
116 cnh 1.2 IMPLICIT NONE
117 cnh 1.1
118     C == Global data ==
119     #include "SIZE.h"
120     #include "EEPARAMS.h"
121     #include "PARAMS.h"
122     #include "GRID.h"
123     #include "DYNVARS.h"
124     #include "FFIELDS.h"
125 heimbach 1.7 #ifdef SHORTWAVE_HEATING
126 heimbach 1.8 integer two
127     _RL minusone
128     parameter (two=2,minusone=-1.)
129     _RL swfracb(two)
130 heimbach 1.7 #endif
131    
132 cnh 1.1
133     C == Routine arguments ==
134     C iMin - Working range of tile for applying forcing.
135     C iMax
136     C jMin
137     C jMax
138     C kLev
139 cnh 1.2 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
140 cnh 1.1 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
141 adcroft 1.4 _RL myCurrentTime
142     INTEGER myThid
143 cnh 1.1 CEndOfInterface
144    
145 cnh 1.2 C == Local variables ==
146     C Loop counters
147     INTEGER I, J
148    
149     C-- Forcing term
150     C Add heat in top-layer
151     IF ( kLev .EQ. 1 ) THEN
152     DO j=jMin,jMax
153     DO i=iMin,iMax
154     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
155 heimbach 1.7 & +maskC(i,j)*surfaceTendencyT(i,j,bi,bj)
156 cnh 1.2 ENDDO
157     ENDDO
158     ENDIF
159 adcroft 1.5
160     #ifdef SHORTWAVE_HEATING
161     C Penetrating SW radiation
162 heimbach 1.8 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 adcroft 1.5 DO j=jMin,jMax
169     DO i=iMin,iMax
170 heimbach 1.7 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
171 adcroft 1.9 & -maskC(i,j)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
172     & *recip_Cp*recip_rhoNil*recip_dRf(1)
173 adcroft 1.5 ENDDO
174     ENDDO
175     #endif
176 cnh 1.1 RETURN
177     END
178     CStartOfInterface
179     SUBROUTINE EXTERNAL_FORCING_S(
180     I iMin, iMax, jMin, jMax,bi,bj,kLev,
181 cnh 1.2 I maskC,
182 cnh 1.1 I myCurrentTime,myThid)
183     C /==========================================================\
184     C | S/R EXTERNAL_FORCING_S |
185     C | o Contains problem specific forcing for merid velocity. |
186     C |==========================================================|
187     C | Adds terms to gS for forcing by external sources |
188     C | e.g. fresh-water flux, climatalogical relaxation....... |
189     C \==========================================================/
190 cnh 1.2 IMPLICIT NONE
191 cnh 1.1
192     C == Global data ==
193     #include "SIZE.h"
194     #include "EEPARAMS.h"
195     #include "PARAMS.h"
196     #include "GRID.h"
197     #include "DYNVARS.h"
198 cnh 1.2 #include "FFIELDS.h"
199 cnh 1.1
200     C == Routine arguments ==
201     C iMin - Working range of tile for applying forcing.
202     C iMax
203     C jMin
204     C jMax
205     C kLev
206 cnh 1.2 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
207 cnh 1.1 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
208 adcroft 1.4 _RL myCurrentTime
209     INTEGER myThid
210 cnh 1.1 CEndOfInterface
211 cnh 1.2
212     C == Local variables ==
213     C Loop counters
214     INTEGER I, J
215    
216     C-- Forcing term
217     C Add fresh-water in top-layer
218     IF ( kLev .EQ. 1 ) THEN
219     DO j=jMin,jMax
220     DO i=iMin,iMax
221     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
222 heimbach 1.7 & +maskC(i,j)*surfaceTendencyS(i,j,bi,bj)
223 cnh 1.2 ENDDO
224     ENDDO
225     ENDIF
226 cnh 1.1
227     RETURN
228     END
  ViewVC Help
Powered by ViewVC 1.1.22