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

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

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


Revision 1.14 - (hide annotations) (download)
Sat Feb 6 02:43:03 2010 UTC (14 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint63p, checkpoint63q, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63, checkpoint62c, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.13: +3 -3 lines
Preparing usage of generic cost function terms.
Enable with CPP option
#ifdef ALLOW_GENCOST_CONTRIBUTION
First usage is adding air-sea flux constraints when using bulk controls.
---> NOT YET READY FOR PRIME TIME <---

1 heimbach 1.14 C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_mean_saltflux.F,v 1.13 2009/09/30 15:48:31 mlosch Exp $
2 jmc 1.12 C $Name: $
3 heimbach 1.1
4     #include "COST_CPPOPTIONS.h"
5    
6    
7     subroutine cost_mean_saltflux(
8     I myiter,
9     I mytime,
10     I mythid
11     & )
12    
13     c ==================================================================
14     c SUBROUTINE cost_mean_saltflux
15     c ==================================================================
16     c
17     c o Evaluate cost function contribution of sea surface salinity.
18     c
19     c started: Elisabeth Remy 19-mar-2001 copy from cost_sst.F
20     c
21     c ==================================================================
22     c SUBROUTINE cost_mean_saltflux
23     c ==================================================================
24    
25     implicit none
26    
27     c == global variables ==
28    
29     #include "EEPARAMS.h"
30     #include "SIZE.h"
31     #include "GRID.h"
32     #include "DYNVARS.h"
33     #include "PARAMS.h"
34    
35     #include "cal.h"
36     #include "ecco_cost.h"
37     #include "ctrl.h"
38     #include "ctrl_dummy.h"
39     #include "optim.h"
40    
41     c == routine arguments ==
42    
43     integer myiter
44     _RL mytime
45     integer mythid
46    
47     c == local variables ==
48    
49     integer bi,bj
50 heimbach 1.2 integer i,j,kk
51 heimbach 1.1 integer itlo,ithi
52     integer jtlo,jthi
53     integer jmin,jmax
54     integer imin,imax
55     integer irec
56     integer levmon
57     integer levoff
58     integer ilsalt
59    
60 heimbach 1.7 _RL tmpx
61 heimbach 1.5 _RL sumtot
62     _RL fctiletot
63 heimbach 1.1
64    
65     character*(80) fnamesflux
66    
67     logical doglobalread
68     logical ladinit
69    
70     character*(MAX_LEN_MBUF) msgbuf
71    
72     c == external functions ==
73    
74     integer ilnblnk
75     external ilnblnk
76    
77     c == end of interface ==
78    
79     jtlo = mybylo(mythid)
80     jthi = mybyhi(mythid)
81     itlo = mybxlo(mythid)
82     ithi = mybxhi(mythid)
83     jmin = 1
84     jmax = sny
85     imin = 1
86     imax = snx
87    
88     c-- Read tiled data.
89     doglobalread = .false.
90     ladinit = .false.
91    
92     #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
93    
94     if (optimcycle .ge. 0) then
95 heimbach 1.14 ilsalt = ilnblnk( sfluxmeanbarfile )
96 heimbach 1.1 write(fnamesflux(1:80),'(2a,i10.10)')
97 heimbach 1.14 & sfluxmeanbarfile(1:ilsalt),'.',optimcycle
98 heimbach 1.1 endif
99    
100 heimbach 1.5 do irec = 1, MAX(1,nyearsrec)
101 heimbach 1.1
102     c-- Read time averages and the monthly mean data.
103     call active_read_xy( fnamesflux, tmpfld2d, irec,
104     & doglobalread, ladinit,
105     & optimcycle, mythid,
106     & xx_sflux_mean_dummy )
107    
108 heimbach 1.7 sumtot = 0.
109     fctiletot = 0.
110 heimbach 1.1 do bj = jtlo,jthi
111     do bi = itlo,ithi
112     kk = 1
113     do j = jmin,jmax
114     do i = imin,imax
115     tmpx=tmpfld2d(i,j,bi,bj)
116 heimbach 1.2 if (maskC(i,j,kk,bi,bj) .ne. 0.) then
117 heimbach 1.7 fctiletot = fctiletot
118 mlosch 1.13 & + tmpx* _rA(i,j,bi,bj)/rhoConstFresh
119 heimbach 1.7 sumtot = sumtot
120 mlosch 1.13 & + _rA(i,j,bi,bj)
121 heimbach 1.4 num_sfluxmm(bi,bj) = num_sfluxmm(bi,bj) + 1
122 heimbach 1.1 endif
123     enddo
124     enddo
125 heimbach 1.5 enddo
126     enddo
127 heimbach 1.1
128 jmc 1.12 _GLOBAL_SUM_RL( sumtot , myThid )
129     _GLOBAL_SUM_RL( fctiletot , myThid )
130 jmc 1.9
131 heimbach 1.5 if (sumtot.eq.0.) sumtot = 1.
132 heimbach 1.1
133 heimbach 1.6 if ( wmean_sflux .NE. 0. ) then
134 heimbach 1.7 objf_sfluxmm = objf_sfluxmm
135 heimbach 1.10 & + ( (fctiletot/sumtot)/wmean_sflux )**2
136 heimbach 1.7 else
137     objf_sfluxmm = 0. _d 0
138 heimbach 1.6 endif
139 heimbach 1.5
140     c-- diagnostic: imbalance per year:
141 heimbach 1.7 write(standardmessageunit,'(A,I5,2(X,D22.14))')
142     & ' --> bal_sfluxmm =', irec,
143     & fctiletot/sumtot,
144 mlosch 1.13 & objf_sfluxmm
145 heimbach 1.1
146 heimbach 1.5 enddo
147 heimbach 1.1
148     #endif
149    
150     return
151     end
152    

  ViewVC Help
Powered by ViewVC 1.1.22