/[MITgcm]/MITgcm/pkg/exf/exf_set_lwflux.F
ViewVC logotype

Annotation of /MITgcm/pkg/exf/exf_set_lwflux.F

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

Revision 1.2 - (hide annotations) (download)
Thu Feb 7 20:00:09 2002 UTC (22 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint44b_post, checkpoint44e_post, checkpoint46i_post, checkpoint46f_post, checkpoint46l_pre, checkpoint46d_pre, checkpoint46e_post, checkpoint46c_post, checkpoint46e_pre, checkpoint45d_post, checkpoint46j_pre, checkpoint45b_post, checkpoint44g_post, release1_final_v1, checkpoint46c_pre, checkpoint45, checkpoint44f_post, checkpoint46l_post, checkpoint46h_post, checkpoint44h_pre, chkpt44d_post, checkpoint46h_pre, checkpoint46g_pre, checkpoint46a_post, chkpt44c_post, checkpoint46m_post, checkpoint46j_post, checkpoint44f_pre, checkpoint46a_pre, checkpoint45c_post, checkpoint46k_post, checkpoint44e_pre, checkpoint46b_pre, checkpoint46b_post, checkpoint44h_post, checkpoint46d_post, checkpoint46g_post, checkpoint45a_post, checkpoint46, chkpt44c_pre
Branch point for: release1_final
Changes since 1.1: +12 -26 lines 
o merge of relevant stuff from the ecco-branch:
  - genmake: removed $S64 overwrite for case SunOS
  - pkg/exf: update and corrections for field swapping and obcs
  - pkg/ecco: parameter lists for the_model_main, the_main_loop
              harmonized between ECCO and MITgcm
  - pkg/autodiff: added flow directives for obcs, mdsio_gl_slice
                  updated checkpointing_lev... lists for obcs
  - model/src: minor changes in forward_step, plot_field
               added directive for divided adjoint in the_main_loop
  - pkg/mdsio: added mdsio_gl_slice
1 heimbach 1.1 #include "EXF_CPPOPTIONS.h"
2    
3 heimbach 1.2 subroutine exf_set_lwflux( mycurrenttime, mycurrentiter, mythid )
4 heimbach 1.1
5     c ==================================================================
6     c SUBROUTINE exf_set_lwflux
7     c ==================================================================
8     c
9     c o set external forcing lwflux
10     c
11     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
12 heimbach 1.2 c changed: heimbach@mit.edu 10-Jan-2002
13 heimbach 1.1
14     c ==================================================================
15     c SUBROUTINE exf_set_lwflux
16     c ==================================================================
17    
18     implicit none
19    
20     c == global variables ==
21    
22     #include "EEPARAMS.h"
23     #include "SIZE.h"
24     #include "GRID.h"
25    
26     #include "exf_param.h"
27     #include "exf_constants.h"
28 heimbach 1.2 #include "exf_fields.h"
29 heimbach 1.1
30     c == routine arguments ==
31    
32     _RL mycurrenttime
33     integer mycurrentiter
34     integer mythid
35    
36 heimbach 1.2 #ifdef ALLOW_ATM_TEMP
37 heimbach 1.1 c == local variables ==
38    
39     logical first, changed
40     integer count0, count1
41     _RL fac
42    
43     integer bi, bj
44     integer i, j
45    
46     c == end of interface ==
47    
48     c get record numbers and interpolation factor for lwflux
49     call exf_GetFFieldRec(
50     I lwfluxstartdate, lwfluxperiod
51     O , fac, first, changed
52     O , count0, count1
53     I , mycurrenttime, mycurrentiter, mythid
54     & )
55    
56     if ( first ) then
57     call mdsreadfield( lwfluxfile, exf_iprec, exf_yftype, 1
58     & , lwflux1, count0, mythid
59     & )
60     if (exf_yftype .eq. 'RL') then
61     call exf_filter_rl( lwflux1, lwfluxmask, mythid )
62     else
63     call exf_filter_rs( lwflux1, lwfluxmask, mythid )
64     end if
65     endif
66    
67     if (( first ) .or. ( changed )) then
68     call exf_SwapFFields( lwflux0, lwflux1, mythid )
69    
70     call mdsreadfield( lwfluxfile, exf_iprec, exf_yftype, 1
71     & , lwflux1, count1, mythid
72     & )
73     if (exf_yftype .eq. 'RL') then
74     call exf_filter_rl( lwflux1, lwfluxmask, mythid )
75     else
76     call exf_filter_rs( lwflux1, lwfluxmask, mythid )
77     end if
78     endif
79    
80     c Loop over tiles.
81     do bj = mybylo(mythid),mybyhi(mythid)
82     do bi = mybxlo(mythid),mybxhi(mythid)
83     do j = 1,sny
84     do i = 1,snx
85    
86     c Interpolate linearly onto the current time.
87    
88     lwflux(i,j,bi,bj) = fac *lwflux0(i,j,bi,bj)+
89     & (exf_one - fac) *lwflux1(i,j,bi,bj)
90    
91     enddo
92     enddo
93     enddo
94     enddo
95    
96 heimbach 1.2 #endif
97    
98 heimbach 1.1 end
99    
100    
101    
102 heimbach 1.2 subroutine exf_init_lwflux( mythid )
103 heimbach 1.1
104     c ==================================================================
105     c SUBROUTINE exf_init_lwflux
106     c ==================================================================
107     c
108     c o
109     c
110     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
111 heimbach 1.2 c changed: heimbach@mit.edu 10-Jan-2002
112 heimbach 1.1 c
113     c ==================================================================
114     c SUBROUTINE exf_init_lwflux
115     c ==================================================================
116    
117     implicit none
118    
119     c == global variables ==
120    
121     #include "EEPARAMS.h"
122     #include "SIZE.h"
123    
124     #include "exf_param.h"
125 heimbach 1.2 #include "exf_fields.h"
126 heimbach 1.1
127     c == routine arguments ==
128    
129     integer mythid
130    
131 heimbach 1.2 #ifdef ALLOW_ATM_TEMP
132 heimbach 1.1 c == local variables ==
133    
134     integer bi, bj
135     integer i, j
136    
137     c == end of interface ==
138    
139     do bj = mybylo(mythid), mybyhi(mythid)
140     do bi = mybxlo(mythid), mybxhi(mythid)
141     do j = 1, sny
142     do i = 1, snx
143     lwflux0(i,j,bi,bj) = 0. _d 0
144     lwflux1(i,j,bi,bj) = 0. _d 0
145     enddo
146     enddo
147     enddo
148     enddo
149 heimbach 1.2
150     #endif
151 heimbach 1.1
152     end
  ViewVC Help
Powered by ViewVC 1.1.22