/[MITgcm]/MITgcm_contrib/SOSE/code_ad/seaice_cost_final.F
ViewVC logotype

Contents of /MITgcm_contrib/SOSE/code_ad/seaice_cost_final.F

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


Revision 1.1 - (show annotations) (download)
Fri Apr 23 19:55:13 2010 UTC (15 years, 3 months ago) by mmazloff
Branch: MAIN
CVS Tags: HEAD
original files

1 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_cost_final.F,v 1.14 2009/11/20 22:33:21 heimbach Exp $
2 C $Name: $
3
4 #include "SEAICE_OPTIONS.h"
5
6
7 subroutine seaice_cost_final( mythid )
8
9 c ==================================================================
10 c SUBROUTINE seaice_cost_final
11 c ==================================================================
12
13 implicit none
14
15 c == global variables ==
16
17 #include "EEPARAMS.h"
18 #include "SIZE.h"
19 #include "PARAMS.h"
20 #include "DYNVARS.h"
21 #include "SEAICE_PARAMS.h"
22 #ifdef ALLOW_COST
23 #include "SEAICE_COST.h"
24 #include "cost.h"
25 #include "ctrl.h"
26 #include "optim.h"
27 CMM(
28 #include "EESUPPORT.h"
29 CMM)
30 #endif
31
32 c == routine arguments ==
33
34 integer mythid
35
36 #ifdef ALLOW_COST
37
38 C === Functions ====
39 LOGICAL MASTER_CPU_THREAD
40 EXTERNAL MASTER_CPU_THREAD
41
42 c == local variables ==
43
44 integer bi,bj
45 integer itlo,ithi
46 integer jtlo,jthi
47 integer ifc
48 integer totnum
49
50 _RL f_ice
51 _RL f_smrarea
52 _RL f_smrsst
53 _RL f_smrsss
54
55 _RL no_ice
56 _RL no_smrarea
57 _RL no_smrsst
58 _RL no_smrsss
59
60 character*23 cfname
61 #ifdef ECCO_VERBOSE
62 character*(MAX_LEN_MBUF) msgbuf
63 #endif
64
65 c == end of interface ==
66
67 jtlo = mybylo(mythid)
68 jthi = mybyhi(mythid)
69 itlo = mybxlo(mythid)
70 ithi = mybxhi(mythid)
71
72 ifc = 30
73
74 f_ice = 0. _d 0
75 f_smrarea = 0. _d 0
76 f_smrsst = 0. _d 0
77 f_smrsss = 0. _d 0
78 c
79 no_ice = 0. _d 0
80 no_smrarea = 0. _d 0
81 no_smrsst = 0. _d 0
82 no_smrsss = 0. _d 0
83
84 #ifdef ALLOW_SEAICE_COST_EXPORT
85 call seaice_cost_export( myThid )
86 #endif
87
88 c-- Sum up all contributions.
89 do bj = jtlo,jthi
90 do bi = itlo,ithi
91
92 fc = fc
93 & + mult_ice_export * objf_ice_export(bi,bj)
94 & + mult_ice * objf_ice(bi,bj)
95 & + mult_smrarea * objf_smrarea(bi,bj)
96 & + mult_smrsst * objf_smrsst(bi,bj)
97 & + mult_smrsss * objf_smrsss(bi,bj)
98
99 f_ice = f_ice + objf_ice(bi,bj)
100 f_smrarea = f_smrarea + objf_smrarea(bi,bj)
101 f_smrsst = f_smrsst + objf_smrsst(bi,bj)
102 f_smrsss = f_smrsss + objf_smrsss(bi,bj)
103
104 no_ice = no_ice + num_ice(bi,bj)
105 no_smrarea = no_smrarea + num_smrarea(bi,bj)
106 no_smrsst = no_smrsst + num_smrsst(bi,bj)
107 no_smrsss = no_smrsss + num_smrsss(bi,bj)
108
109 enddo
110 enddo
111
112 c-- Do global summation.
113 cph this is done only in ecco_cost_final!
114 cph _GLOBAL_SUM_RL( fc , myThid )
115
116 c-- Do global summation for each part of the cost function
117
118 _GLOBAL_SUM_RL( f_ice , myThid )
119 _GLOBAL_SUM_RL( f_smrarea , myThid )
120 _GLOBAL_SUM_RL( f_smrsst , myThid )
121 _GLOBAL_SUM_RL( f_smrsss , myThid )
122
123 _GLOBAL_SUM_RL( no_ice , myThid )
124 _GLOBAL_SUM_RL( no_smrarea , myThid )
125 _GLOBAL_SUM_RL( no_smrsst , myThid )
126 _GLOBAL_SUM_RL( no_smrsss , myThid )
127
128 write(standardmessageunit,'(A,D22.15)')
129 & ' --> f_ice =',f_ice
130 write(standardmessageunit,'(A,D22.15)')
131 & ' --> f_smrarea =',f_smrarea
132 write(standardmessageunit,'(A,D22.15)')
133 & ' --> f_smrarea =',f_smrsst
134 write(standardmessageunit,'(A,D22.15)')
135 & ' --> f_smrarea =',f_smrsss
136
137 c-- Each process has calculated the global part for itself.
138 IF ( MASTER_CPU_THREAD(myThid) ) THEN
139
140 CMM( proc 1 writes costfinal only!
141 IF( mpiMyId .EQ. 0 ) THEN
142 CMM)
143 write(cfname,'(A,i4.4)') 'costfunction_seaice',optimcycle
144 open(unit=ifc,file=cfname)
145
146 write(ifc,*) 'fc =', fc
147 write(ifc,*) 'f_ice =', f_ice, no_ice
148 write(ifc,*) 'f_smrarea =', f_smrarea, no_smrarea
149 write(ifc,*) 'f_smrsst =', f_smrsst, no_smrsst
150 write(ifc,*) 'f_smrsss =', f_smrsss, no_smrsss
151
152 close(ifc)
153 CMM(
154 ENDIF
155 CMM)
156 ENDIF
157
158 SEAICE_dumpFreq = 0.
159 SEAICE_taveFreq = 0.
160
161 #endif /* ALLOW_COST */
162
163 end

  ViewVC Help
Powered by ViewVC 1.1.22