File indexing completed on 2024-03-19 05:10:15 UTC
view on githubraw file Latest commit 720a211d on 2024-03-18 17:10:23 UTC
b2f1998bbd Ou W*0001 #include "ECCO_OPTIONS.h"
0002
0003 subroutine cost_gencost_glbmean(
de57a2ec4b Mart*0004 I myThid
b2f1998bbd Ou W*0005 & )
0006
0007
0008
0009
0010
13d362b8c1 Ou W*0011
b2f1998bbd Ou W*0012
0013
0014
0015
0016
0017
0018
0019
0020 implicit none
0021
0022
0023
0024 #include "EEPARAMS.h"
0025 #include "SIZE.h"
0026 #include "PARAMS.h"
0027 #include "GRID.h"
0028 #include "DYNVARS.h"
0029
0030 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0031 # include "ECCO_SIZE.h"
0032 # include "ECCO.h"
b2f1998bbd Ou W*0033 #endif
0034
0035
0036
de57a2ec4b Mart*0037 integer myThid
b2f1998bbd Ou W*0038
0039 #ifdef ALLOW_ECCO
720a211d38 Ou W*0040 # ifdef ALLOW_GENCOST_CONTRIBUTION
0041 # ifdef ALLOW_GENCOST_1D
b2f1998bbd Ou W*0042
0043
0044
0045 integer bi,bj
0046 integer i,j
0047 integer itlo,ithi
0048 integer jtlo,jthi
0049 integer irec
0050 integer il
0051
0052 logical doglobalread
0053 logical ladinit
0054
de57a2ec4b Mart*0055 _RL locbar(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
b2f1998bbd Ou W*0056 _RL locw
0057
de57a2ec4b Mart*0058 _RL locbarmean ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy )
0059 _RL locbaranom ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy )
0060 _RL loccount ( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy, nSx, nSy )
b2f1998bbd Ou W*0061 _RL junk, junkweight
0062
de57a2ec4b Mart*0063 character*(MAX_LEN_FNAM) fname
b2f1998bbd Ou W*0064
0065 _RL fac
0066 _RL locbarglbmean
0067 _RL locbarglbmean_sum
0068
0069 integer k, kgen
0070 integer locnrec
0071 integer ilo, ihi
0072 integer locunit
0073 _RL dataglbmean ( N1DDATA )
0074 _RL meandataglbmean, meandataglbmeannu
0075 _RL locmask ( N1DDATA )
0076
0077 character*(max_len_mbuf) msgbuf
0078
0079
0080
0081 integer ilnblnk, ifnblnk
0082 external ilnblnk, ifnblnk
0083
0084 LOGICAL MASTER_CPU_THREAD
0085 EXTERNAL MASTER_CPU_THREAD
0086
0087
0088
de57a2ec4b Mart*0089 jtlo = myByLo(myThid)
0090 jthi = myByHi(myThid)
0091 itlo = myBxLo(myThid)
0092 ithi = myBxHi(myThid)
b2f1998bbd Ou W*0093
0094 do k=1,NGENCOST
720a211d38 Ou W*0095 kgen=0
0096 if (((gencost_name(k).EQ.'gmbp') .OR.
0097 & (gencost_name(k).EQ.'gmsl'))
0098 & .AND.( gencost_is1d(k) )
0099 & .AND.(using_gencost(k)) ) kgen=k
b2f1998bbd Ou W*0100
720a211d38 Ou W*0101 if (kgen.GT.0) then
0102 locw = gencost_wei1d(kgen)
b2f1998bbd Ou W*0103
720a211d38 Ou W*0104 if(locw .NE. 0. _d 0) then
b2f1998bbd Ou W*0105
0106
720a211d38 Ou W*0107 fac = 1. _d 0
b2f1998bbd Ou W*0108
720a211d38 Ou W*0109 if(gencost_name(k).EQ.'gmbp') fac = 1. _d 2 * recip_gravity
0110 do bj = jtlo,jthi
0111 do bi = itlo,ithi
0112 do j = 1,sNy
0113 do i = 1,sNx
0114 locbarmean(i,j,bi,bj) = 0. _d 0
0115 locbaranom(i,j,bi,bj) = 0. _d 0
0116 loccount(i,j,bi,bj) = 0. _d 0
0117 locbar(i,j,bi,bj) = 0. _d 0
0118 enddo
0119 enddo
0120 enddo
b2f1998bbd Ou W*0121 enddo
0122
720a211d38 Ou W*0123 doglobalread = .false.
0124 ladinit = .false.
b2f1998bbd Ou W*0125
0126
0127
720a211d38 Ou W*0128 locnrec = gencost_nrec(kgen)
0129
0130 meandataglbmean = 0. _d 0
0131 meandataglbmeannu = 0. _d 0
0132 do irec = 1, N1DDATA
0133 dataglbmean(irec) = 0. _d 0
0134 locmask(irec) = 0. _d 0
0135 enddo
0136
0137 do irec = 1, locnrec
0138 dataglbmean(irec) = gencost_1DDATA(irec,kgen)
0139 if ( gencost_1DDATA(irec,kgen).gt.gencost_spmin(kgen)
0140 & .and. gencost_1DDATA(irec,kgen).lt.gencost_spmax(kgen)
0141 & .and. gencost_1DDATA(irec,kgen).ne.gencost_spzero(kgen)
0142 & ) then
0143 locmask(irec) = 1. _d 0
0144 meandataglbmean = meandataglbmean + dataglbmean(irec)
0145 meandataglbmeannu = meandataglbmeannu + 1. _d 0
0146 endif
0147 enddo
0148 if(meandataglbmeannu.NE.0. _d 0)
0149 & meandataglbmean = meandataglbmean / meandataglbmeannu
b2f1998bbd Ou W*0150
0151
720a211d38 Ou W*0152 do irec = 1, locnrec
0153 if(locmask(irec).EQ.1. _d 0) then
0154 dataglbmean(irec) = dataglbmean(irec)
0155 & - meandataglbmean
0156 endif
0157 enddo
b2f1998bbd Ou W*0158
0159
0160 #ifdef ALLOW_CTRL
720a211d38 Ou W*0161 il=ilnblnk( gencost_barfile(kgen) )
0162 write(fname,'(2a,i10.10)')
0163 & gencost_barfile(kgen)(1:il),'.',eccoiter
b2f1998bbd Ou W*0164 #endif
0165
0166
0167
0168
0169
720a211d38 Ou W*0170 do irec = 1, locnrec
b2f1998bbd Ou W*0171
720a211d38 Ou W*0172 if(locmask(irec) .NE. 0. _d 0) then
b2f1998bbd Ou W*0173
720a211d38 Ou W*0174 #ifdef ALLOW_AUTODIFF
0175 call active_read_xy( fname, locbar, irec, doglobalread,
0176 & ladinit, eccoiter, myThid,
0177 & gencost_dummy(kgen) )
0178 #else
0179 call read_rec_xy_rl( fname, locbar, irec, 1, myThid )
0180 #endif
0181
0182 do bj = jtlo,jthi
0183 do bi = itlo,ithi
0184 do j = 1,sNy
0185 do i = 1,sNx
0186 if ( maskc(i,j,1,bi,bj).NE. 0. _d 0 ) then
0187 locbarmean(i,j,bi,bj) =
0188 & locbarmean(i,j,bi,bj) +
0189 & fac*locbar(i,j,bi,bj)
0190 loccount(i,j,bi,bj) = loccount(i,j,bi,bj) +
0191 & 1. _d 0
0192 endif
0193 enddo
0194 enddo
0195 enddo
0196 enddo
0197 endif
0198
b2f1998bbd Ou W*0199 enddo
720a211d38 Ou W*0200
0201 do bj = jtlo,jthi
0202 do bi = itlo,ithi
0203 do j = 1,sNy
0204 do i = 1,sNx
0205 if (loccount(i,j,bi,bj).GT. 0. _d 0) then
0206 locbarmean(i,j,bi,bj) =
0207 & locbarmean(i,j,bi,bj)/loccount(i,j,bi,bj)
0208 endif
0209 enddo
0210 enddo
b2f1998bbd Ou W*0211 enddo
0212 enddo
0213
0214
0215
0216
0217
0218
720a211d38 Ou W*0219 do irec = 1, locnrec
0220
0221 if(locmask(irec) .NE. 0. _d 0) then
0222 #ifdef ALLOW_AUTODIFF
0223 call active_read_xy( fname, locbar, irec, doglobalread,
0224 & ladinit, eccoiter, myThid,
0225 & gencost_dummy(kgen) )
0226 #else
0227 call read_rec_xy_rl( fname, locbar, irec, 1, myThid )
0228 #endif
b2f1998bbd Ou W*0229
0230
720a211d38 Ou W*0231 do bj = jtlo,jthi
0232 do bi = itlo,ithi
0233 do j = 1,sNy
0234 do i = 1,sNx
0235 if ( maskc(i,j,1,bi,bj).NE. 0. _d 0) then
0236 locbaranom(i,j,bi,bj) =
0237 & fac*locbar(i,j,bi,bj) -
0238 & locbarmean(i,j,bi,bj)
0239 else
0240 locbaranom(i,j,bi,bj) = 0. _d 0
0241 endif
0242 enddo
0243 enddo
0244 enddo
0245 enddo
b2f1998bbd Ou W*0246
0247
720a211d38 Ou W*0248 locbarglbmean = 0. _d 0
0249 locbarglbmean_sum = 0. _d 0
0250
0251 do bj = jtlo,jthi
0252 do bi = itlo,ithi
0253 do j = 1,sNy
0254 do i = 1,sNx
0255 if ( maskc(i,j,1,bi,bj).NE. 0. _d 0) then
0256 locbarglbmean = locbarglbmean +
0257 & RA(i,j,bi,bj)*locbaranom(i,j,bi,bj)
0258 locbarglbmean_sum = locbarglbmean_sum +
0259 & RA(i,j,bi,bj)
0260 endif
0261 enddo
0262 enddo
0263 enddo
0264 enddo
0265
0266 _GLOBAL_SUM_RL( locbarglbmean , myThid )
0267 _GLOBAL_SUM_RL( locbarglbmean_sum , myThid )
0268
0269 IF ( MASTER_CPU_THREAD(myThid) .AND.
0270 & ( locmask(irec) .NE. 0. _d 0 ) .AND.
0271 & ( locbarglbmean_sum .NE. 0. _d 0 ) ) THEN
0272 junk=locbarglbmean/locbarglbmean_sum -
0273 & dataglbmean(irec)
0274 junkweight=locw
0275 objf_gencost(1,1,kgen) = objf_gencost(1,1,kgen)
0276 & + junk*junk*junkweight
0277 num_gencost(1,1,kgen) = num_gencost(1,1,kgen)
0278 & + 1. _d 0
0279
0280 WRITE(msgBuf,'(A,i6,2e16.5)')
0281 & gencost_name(kgen)(1:10),irec,
0282 & locbarglbmean/locbarglbmean_sum, dataglbmean(irec)
0283 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
0284 & SQUEEZE_RIGHT , 1)
0285
0286 ENDIF
0287
0288 endif
b2f1998bbd Ou W*0289 enddo
0290
720a211d38 Ou W*0291 endif
0292 endif
b2f1998bbd Ou W*0293
0294 enddo
0295
720a211d38 Ou W*0296 # endif /* ifdef ALLOW_GENCOST_1D */
0297 # endif /* ifdef ALLOW_GENCOST_CONTRIBUTION */
b2f1998bbd Ou W*0298 #endif /* ifdef ALLOW_ECCO */
0299
0300 end
