/[MITgcm]/MITgcm/pkg/ecco/cost_bp_read.F
ViewVC logotype

Annotation of /MITgcm/pkg/ecco/cost_bp_read.F

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

Revision 1.5 - (hide annotations) (download)
Mon Sep 29 16:47:49 2014 UTC (9 years, 8 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65f, checkpoint65g, HEAD
Changes since 1.4: +30 -22 lines 
- remove includes from pkg/ctrl, add missing CCP switches,
  remove unused variable, replace optimiter with eccoiter :
  cost_averagesgeneric.F, cost_gencost*.F,
  cost_generic.F, ecco_check.F, ecco_phys.F
- include ecco.h rather than ecco.h : ecco_cost_driver.F,
  ecco_phys.F, cost_averagesgeneric.F, cost_gencost*.F,
- rename xx_genbar_dummy as gencost_dummy : cost_averagesfields.F,
  cost_averagesinit.F, cost_gencost_*.F, ecco_cost_init_barfiles.F


- cost_bp.F : modify calls to cost_bp_read (added arguments)
- cost_bp_read.F added arguments (localobsfile, localstartdate,
     localobs, localmask) replacing use of common blocs
- cost_generic.F : add ALLOW_OLD_ESTIM_CODES bracket
- ecco_check.F :
    use gencost_startdate rather than modelstartdate, rename
    using_topex as using_tpj, add ALLOW_OLD_ESTIM_CODES brackets
- cost_gencost_all.F : remove un-necessary CPP brackets of
    cost_gencost_*v4 calls, add cost_gencost_bpv4 call,
    use gencost_startdate rather than modelstartdate
- cost_averagesgeneric.F : added DEBUG code
- ecco_cost_final.F : added ifdef ALLOW_ECCO
- ecco_cost_init_fixed.F : copy optimcycle to eccoiter
  when ALLOW_CTRL, set eccoiter to 0 otherwise;
  revise gencost conditionality
- ecco_cost_summary.F : add ALLOW_OLD_ESTIM_CODES brackets,
  rename using_topex as using_tpj
- ecco_init_varia.F : initialize RHOsumGlob_0, VOLsumGlob_0
- ecco_phys.F : compute etanFull
- ecco_readparms.F : rename using_topex as using_tpj, add
  bpv4-grace to gencost list, initialize added parameters
- ecco_summary.F : include SIZE.h needed for augmented ecco.h
1 gforget 1.5 C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_bp_read.F,v 1.4 2012/08/10 19:45:25 jmc Exp $
2 gforget 1.1 C $Name: $
3    
4 jmc 1.4 #include "ECCO_OPTIONS.h"
5 gforget 1.1
6    
7     subroutine cost_bp_read(
8 gforget 1.5 I localobsfile, localstartdate,
9     O localobs, localmask,
10     I irec,myThid)
11 gforget 1.1
12     c ==================================================================
13     c SUBROUTINE cost_bp_read
14     c ==================================================================
15     c
16     c o Read a given record of the GRACE data.
17     c
18     c started: Gael Forget Oct-2009
19     c
20     c ==================================================================
21     c SUBROUTINE cost_bp_read
22     c ==================================================================
23    
24     implicit none
25    
26     c == global variables ==
27    
28     #include "EEPARAMS.h"
29     #include "SIZE.h"
30     #include "PARAMS.h"
31     #include "GRID.h"
32    
33 gforget 1.5 #ifdef ALLOW_CAL
34     # include "cal.h"
35     #endif
36     #ifdef ALLOW_ECCO
37     # include "ecco_cost.h"
38     #endif
39 gforget 1.1
40     c == routine arguments ==
41    
42 gforget 1.5 character*(MAX_LEN_FNAM) localobsfile
43     integer localstartdate(4)
44     _RL localobs (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
45     _RL localmask (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
46 gforget 1.1 integer irec
47     integer mythid
48    
49 gforget 1.5 #ifdef ALLOW_ECCO
50 gforget 1.1
51     c == local variables ==
52    
53     integer bi,bj
54     integer i,j,k
55     integer itlo,ithi
56     integer jtlo,jthi
57     integer jmin,jmax
58     integer imin,imax
59     integer nobs
60     integer bprec
61     integer beginbp
62     integer beginrun
63    
64 gforget 1.3 INTEGER beginlocal, beginmodel, obsrec
65    
66 gforget 1.1 _RL spval
67     _RL vartile
68    
69     cnew(
70     integer il
71     integer mody, modm
72     integer iyear, imonth
73     character*(80) fnametmp
74     logical exst
75     cnew)
76    
77     c == external functions ==
78    
79     integer ilnblnk
80     external ilnblnk
81    
82     c == end of interface ==
83    
84     parameter (spval = -998. )
85     ce --> there is certainly a better place for this.
86    
87     jtlo = mybylo(mythid)
88     jthi = mybyhi(mythid)
89     itlo = mybxlo(mythid)
90     ithi = mybxhi(mythid)
91     jmin = 1
92     jmax = sny
93     imin = 1
94     imax = snx
95    
96 gforget 1.3
97 gforget 1.5 beginlocal = localstartdate(1)/10000
98 gforget 1.3 beginmodel = modelstartdate(1)/10000
99     obsrec = ( beginmodel - beginlocal )*nmonthyear
100     & + ( mod(modelstartdate(1)/100,100)
101 gforget 1.5 & -mod(localstartdate(1)/100,100) )
102 gforget 1.3 & + irec
103    
104 gforget 1.1 mody = modelstartdate(1)/10000
105     modm = modelstartdate(1)/100 - mody*100
106     iyear = mody + INT((modm-1+irec-1)/12)
107     imonth = 1 + MOD(modm-1+irec-1,12)
108    
109 gforget 1.5 il=ilnblnk(localobsfile)
110 gforget 1.1 write(fnametmp(1:80),'(2a,i4)')
111 gforget 1.5 & localobsfile(1:il), '_', iyear
112 gforget 1.1 inquire( file=fnametmp, exist=exst )
113     if (.NOT. exst) then
114 gforget 1.5 write(fnametmp(1:80),'(a)') localobsfile(1:il)
115 gforget 1.3 imonth = obsrec
116 gforget 1.1 endif
117    
118 gforget 1.3 if ( (obsrec.GT.0).AND.(imonth.GT.0) ) then
119     call mdsreadfield( fnametmp, cost_iprec, cost_yftype, 1,
120 gforget 1.5 & localobs, imonth, mythid )
121 gforget 1.3 else
122     do bj = jtlo,jthi
123     do bi = itlo,ithi
124     do j = jmin,jmax
125     do i = imin,imax
126 gforget 1.5 localobs(i,j,bi,bj) = spval
127 gforget 1.3 enddo
128     enddo
129     enddo
130     enddo
131     endif
132 gforget 1.1
133     nobs = 0
134    
135     do bj = jtlo,jthi
136     do bi = itlo,ithi
137     k = 1
138     do j = jmin,jmax
139     do i = imin,imax
140 gforget 1.2 c if (maskC(i,j,k,bi,bj) .eq. 0.) then
141 gforget 1.5 c localmask(i,j,bi,bj) = 0. _d 0
142 gforget 1.2 c else
143 gforget 1.5 c localmask(i,j,bi,bj) = 1. _d 0
144 gforget 1.2 c endif
145 gforget 1.5 if (localobs(i,j,bi,bj) .le. spval) then
146     localmask(i,j,bi,bj) = 0. _d 0
147 gforget 1.1 else
148 gforget 1.5 localmask(i,j,bi,bj) = 1. _d 0
149 gforget 1.1 endif
150 gforget 1.5 localobs(i,j,bi,bj) = localobs(i,j,bi,bj)*
151     & localmask(i,j,bi,bj)
152     nobs = nobs + int(localmask(i,j,bi,bj))
153 gforget 1.1 enddo
154     enddo
155     enddo
156     enddo
157    
158     #endif
159    
160     return
161     end
162    
  ViewVC Help
Powered by ViewVC 1.1.22