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

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

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

Revision 1.6 - (hide annotations) (download)
Thu Mar 6 00:47:33 2003 UTC (21 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint50c_post, checkpoint50c_pre, checkpoint50, checkpoint50d_post, checkpoint50b_pre, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint50g_post, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint50e_post, checkpoint50d_pre, checkpoint49, checkpoint50b_post
Changes since 1.5: +6 -6 lines 
merged from ecco-branch:
o exf:
  - Enable initialisation of forcing fields to constant
    (runtime) values.
  - in exf_getffields.F
    Reduce i-/j-loop to interior domain, discarding overlaps.
    That also fixes wrong TAF-key computations for key_1, key_2
    with bulf formulae.
  - exf_init.F modify #ifdef for exf_init_evap
  - exf_getffieldrec.F, ctrl_getrec.F
    The following INT-usages are not safe:
      fldsecs  = int(fldsecs/fldperiod)*fldperiod
      fldcount = int(fldsecs/fldperiod) + 1
    and were modified.
1 heimbach 1.6 c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_getffieldrec.F,v 1.5 2003/03/05 23:41:43 heimbach Exp $
2 heimbach 1.1
3     #include "CPP_OPTIONS.h"
4    
5    
6     subroutine exf_GetFFieldRec(
7     I fldstartdate, fldperiod,
8     O fac,
9     O first,
10     O changed,
11     O count0,
12     O count1,
13     I mytime,
14     I myiter,
15     I mythid
16     & )
17    
18     c ==================================================================
19     c SUBROUTINE exf_GetFFieldRec
20     c ==================================================================
21     c
22     c o Get flags, counters, and the linear interpolation factor for a
23     c given field.
24     c
25     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
26     c
27     c changed: Christian Eckert eckert@mit.edu 14-Jan-2000
28     c - Restructured the code in order to create a package
29     c for the MITgcmUV.
30     c
31     c Christian Eckert eckert@mit.edu 12-Feb-2000
32 dimitri 1.3 c - Changed Routine names (package prefix: exf_)
33     c
34     c Curtis Heisey cheisey@mit.edu 19-Dec-2002
35     c - added "repeatPeriod" for cycling of forcing datasets
36 heimbach 1.1 c
37 dimitri 1.3 c Dimitris Menemenlis menemenlis@jpl.nasa.gov 27-Dec-2002
38     c - bug fix for verification/global_with_exf
39 heimbach 1.1 c
40     c ==================================================================
41     c SUBROUTINE exf_GetFFieldRec
42     c ==================================================================
43    
44     implicit none
45    
46     c == global variables ==
47    
48     c cal: modelstart, modelstep
49     #include "EEPARAMS.h"
50     #include "cal.h"
51 cheisey 1.2 #include "exf_param.h"
52 heimbach 1.1
53     c == routine arguments ==
54    
55     integer fldstartdate(4)
56     _RL fldperiod
57     _RL fac
58     logical first
59     logical changed
60     integer count0
61     integer count1
62     _RL mytime
63     integer myiter
64     integer mythid
65    
66     c == local variables ==
67    
68     integer mydate(4)
69     integer previousdate(4)
70     integer difftime(4)
71    
72     integer fldcount
73     _RL fldsecs
74 cheisey 1.2 _RL fldsecs0
75     _RL fldsecs1
76 heimbach 1.1 integer prevfldcount
77     _RL prevfldsecs
78     integer flddate(4)
79    
80 dimitri 1.3
81 heimbach 1.1 #ifdef EXF_VERBOSE
82     character*(max_len_mbuf) msgbuf
83     #endif
84    
85     c == end of interface ==
86    
87     c Determine the current date.
88     call cal_GetDate( myiter, mytime, mydate, mythid )
89    
90     c Determine the flux record just before mycurrentdate.
91     call cal_TimePassed( fldstartdate, mydate, difftime, mythid )
92     call cal_ToSeconds( difftime, fldsecs, mythid )
93 heimbach 1.5 fldsecs = int((fldsecs+0.5)/fldperiod)*fldperiod
94     fldcount = int((fldsecs+0.5)/fldperiod) + 1
95 dimitri 1.3
96 cheisey 1.2 c If using repeating data (e.g. monthly means) then make
97 dimitri 1.3 c fldsecs cycle around
98 cheisey 1.2 if (repeatPeriod.ne.0.) then
99 dimitri 1.3 fldsecs0=mod(fldsecs,repeatPeriod)
100     c print *,'repeat: ',fldsecs
101 cheisey 1.2 c Determine the flux record just after mycurrentdate.
102 dimitri 1.3 count0 = int(fldsecs0/fldperiod) + 1
103 heimbach 1.6 fldsecs1 = int((fldsecs+fldperiod+0.5)/fldperiod)*fldperiod
104     fldsecs1=mod(fldsecs1,repeatPeriod+0.5)
105 dimitri 1.3 c print *,'repeat: ',fldsecs1
106 heimbach 1.6 count1 = int((fldsecs1+0.5)/fldperiod) + 1
107 cheisey 1.2 endif
108 heimbach 1.1
109     c Set switches for reading new records.
110     first = ((mytime - modelstart) .lt. 0.5*modelstep)
111    
112     if ( first) then
113     changed = .false.
114     else
115     call cal_GetDate( myiter-1, mytime-modelstep,
116     & previousdate, mythid )
117    
118     call cal_TimePassed( fldstartdate, previousdate, difftime,
119     & mythid )
120     call cal_ToSeconds( difftime, prevfldsecs, mythid )
121 heimbach 1.6 prevfldsecs = int((prevfldsecs+0.5)/fldperiod)*fldperiod
122     prevfldcount = int((prevfldsecs+0.5)/fldperiod) + 1
123 heimbach 1.1
124     if (fldcount .ne. prevfldcount) then
125     changed = .true.
126     else
127     changed = .false.
128     endif
129 dimitri 1.3 endif
130    
131     if (.NOT.repeatPeriod.ne.0.) then
132     count0 = fldcount
133     count1 = fldcount + 1
134 heimbach 1.1 endif
135    
136     call cal_TimeInterval( fldsecs, 'secs', difftime, mythid )
137     call cal_AddTime( fldstartdate, difftime, flddate, mythid )
138     call cal_TimePassed( flddate, mydate, difftime, mythid )
139     call cal_ToSeconds( difftime, fldsecs, mythid )
140    
141     c Weight belonging to irec for linear interpolation purposes.
142     c Note: The weight as chosen here is 1. - fac of the "old" MITgcm's
143     c estimation program.
144     fac = 1. - fldsecs/fldperiod
145    
146     #ifdef EXF_VERBOSE
147     c Do some printing for the protocol.
148     _BEGIN_MASTER( mythid )
149     write(msgbuf,'(a)') ' '
150     call print_message( msgbuf, standardmessageunit,
151     & SQUEEZE_RIGHT , mythid)
152     write(msgbuf,'(a,2x,l2,2x,l2,2x,D15.8)')
153     & ' exf_GetFFieldsRec: first, changed, fac:',
154     & first, changed, fac
155     call print_message( msgbuf, standardmessageunit,
156     & SQUEEZE_RIGHT , mythid)
157     write(msgbuf,'(a,i4,i4)')
158     & ' exf_GetFFieldsRec: count0, count1:',
159     & count0, count1
160     call print_message( msgbuf, standardmessageunit,
161     & SQUEEZE_RIGHT , mythid)
162     write(msgbuf,'(a)') ' '
163     call print_message( msgbuf, standardmessageunit,
164     & SQUEEZE_RIGHT , mythid)
165     _END_MASTER( mythid )
166     #endif
167    
168     end
  ViewVC Help
Powered by ViewVC 1.1.22