File indexing completed on 2024-03-19 05:10:16 UTC
view on githubraw file Latest commit 720a211d on 2024-03-18 17:10:23 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
6805a315c1 Gael*0002 #ifdef ALLOW_CTRL
0003 # include "CTRL_OPTIONS.h"
0004 #endif
5001c65f45 Patr*0005
15f6a15ab5 Mart*0006
0007
0008
5001c65f45 Patr*0009 subroutine cost_obcsw(
720a211d38 Ou W*0010 I startrec, endrec,
0011 I myTime, myIter, myThid )
5001c65f45 Patr*0012
15f6a15ab5 Mart*0013
5001c65f45 Patr*0014
0015
0016
0017
0018
0019
0020
0021
0022
15f6a15ab5 Mart*0023
0024
0025
5001c65f45 Patr*0026
0027 implicit none
0028
0029
0030 #include "EEPARAMS.h"
0031 #include "SIZE.h"
0032 #include "PARAMS.h"
0033 #include "GRID.h"
f75c953e99 Jean*0034
0035
0036
5001c65f45 Patr*0037
c509d7e04a Gael*0038 #ifdef ALLOW_CAL
0039 # include "cal.h"
0040 #endif
0041 #ifdef ALLOW_CTRL
0042 # include "CTRL_SIZE.h"
4d72283393 Mart*0043 # include "CTRL.h"
edcd27be69 Mart*0044 # include "CTRL_DUMMY.h"
65754df434 Mart*0045 # include "OPTIMCYCLE.h"
c509d7e04a Gael*0046 # include "CTRL_OBCS.h"
0047 #endif
5001c65f45 Patr*0048
15f6a15ab5 Mart*0049
720a211d38 Ou W*0050 integer startrec, endrec
0051 _RL myTime
0052 integer myIter
0053 integer myThid
5001c65f45 Patr*0054
c509d7e04a Gael*0055 #if (defined (ALLOW_CTRL) && defined (ALLOW_OBCS))
0056
f75c953e99 Jean*0057 #ifdef ALLOW_OBCSW_COST_CONTRIBUTION
720a211d38 Ou W*0058
f75c953e99 Jean*0059 integer ilnblnk
0060 external ilnblnk
0061
15f6a15ab5 Mart*0062
5001c65f45 Patr*0063 integer bi,bj
f75c953e99 Jean*0064 integer j,k
5001c65f45 Patr*0065 integer jmin,jmax
0066 integer irec
0067 integer iobcs
15f6a15ab5 Mart*0068 integer nrec
0069 integer ilfld
0070 integer igg
5001c65f45 Patr*0071 _RL fctile
0072 _RL fcthread
0073 _RL dummy
15f6a15ab5 Mart*0074 _RL gg
0075 _RL tmpx
9f5240b52a Jean*0076 _RL tmpfield (1-OLy:sNy+OLy,Nr,nSx,nSy)
0077 _RL maskyz (1-OLy:sNy+OLy,Nr,nSx,nSy)
de57a2ec4b Mart*0078 character*(MAX_LEN_FNAM) fnamefld
5001c65f45 Patr*0079 logical doglobalread
0080 logical ladinit
0081 #ifdef ECCO_VERBOSE
0082 character*(MAX_LEN_MBUF) msgbuf
0083 #endif
15f6a15ab5 Mart*0084
5001c65f45 Patr*0085
0086 jmin = 1
9f5240b52a Jean*0087 jmax = sNy
5001c65f45 Patr*0088
0089
0090 doglobalread = .false.
0091 ladinit = .false.
0092
15f6a15ab5 Mart*0093
0094 nrec = endrec-startrec+1
0095
f75c953e99 Jean*0096
5001c65f45 Patr*0097 fcthread = 0. _d 0
0098
15f6a15ab5 Mart*0099 #ifdef ECCO_VERBOSE
720a211d38 Ou W*0100 _BEGIN_MASTER( myThid )
15f6a15ab5 Mart*0101 write(msgbuf,'(a)') ' '
720a211d38 Ou W*0102 call print_message( msgbuf, standardMessageUnit,
0103 & SQUEEZE_RIGHT, myThid )
15f6a15ab5 Mart*0104 write(msgbuf,'(a)') ' '
720a211d38 Ou W*0105 call print_message( msgbuf, standardMessageUnit,
0106 & SQUEEZE_RIGHT, myThid )
15f6a15ab5 Mart*0107 write(msgbuf,'(a,i9.8)')
0108 & ' cost_obcsw: number of records to process: ',nrec
720a211d38 Ou W*0109 call print_message( msgbuf, standardMessageUnit,
0110 & SQUEEZE_RIGHT, myThid )
15f6a15ab5 Mart*0111 write(msgbuf,'(a)') ' '
720a211d38 Ou W*0112 call print_message( msgbuf, standardMessageUnit,
0113 & SQUEEZE_RIGHT, myThid )
0114 _END_MASTER( myThid )
15f6a15ab5 Mart*0115 #endif
0116
0117 if (optimcycle .ge. 0) then
0118 ilfld=ilnblnk( xx_obcsw_file )
de57a2ec4b Mart*0119 write(fnamefld,'(2a,i10.10)')
15f6a15ab5 Mart*0120 & xx_obcsw_file(1:ilfld), '.', optimcycle
0121 endif
0122
c9dc83bee0 Patr*0123
15f6a15ab5 Mart*0124 do irec = 1,nrec
5001c65f45 Patr*0125
720a211d38 Ou W*0126 #ifdef ALLOW_AUTODIFF
0127 call active_read_yz( fnamefld, tmpfield, irec,
0128 & doglobalread, ladinit, optimcycle,
0129 & myThid, xx_obcsw_dummy )
0130 #else
0131 CALL READ_REC_YZ_RL( fnamefld, ctrlprec, Nr,
0132 & tmpfield, irec, 1, myThid )
0133 #endif
c9dc83bee0 Patr*0134
720a211d38 Ou W*0135
0136 gg = (irec-1)/nobcs
0137 igg = int(gg)
0138 iobcs = irec - igg*nobcs
0139
0140 #ifdef ALLOW_AUTODIFF
0141 call active_read_yz( 'maskobcsw', maskyz, iobcs,
0142 & doglobalread, ladinit, 0,
0143 & myThid, dummy )
0144 #else
0145 CALL READ_REC_YZ_RL( 'maskobcsw', ctrlprec, Nr,
0146 & maskyz, iobcs, 1, myThid )
0147 #endif
5001c65f45 Patr*0148
80451941d6 Jean*0149
9f5240b52a Jean*0150 do bj = myByLo(myThid), myByHi(myThid)
0151 do bi = myBxLo(myThid), myBxHi(myThid)
5001c65f45 Patr*0152
15f6a15ab5 Mart*0153
c9dc83bee0 Patr*0154 fctile = 0. _d 0
5001c65f45 Patr*0155
15f6a15ab5 Mart*0156 do k = 1, Nr
0157 do j = jmin,jmax
f75c953e99 Jean*0158
15f6a15ab5 Mart*0159
0160 tmpx = tmpfield(j,k,bi,bj)
0161
0162 fctile = fctile + wobcsw(k,iobcs)
0163 & *tmpx*tmpx*maskyz(j,k,bi,bj)
0164
0165
0166 if (wobcsw(k,iobcs)*maskyz(j,k,bi,bj).ne.0.)
0167 & num_obcsw(bi,bj) = num_obcsw(bi,bj) + 1. _d 0
0168 enddo
5001c65f45 Patr*0169 enddo
15f6a15ab5 Mart*0170
5001c65f45 Patr*0171 objf_obcsw(bi,bj) = objf_obcsw(bi,bj) + fctile
15f6a15ab5 Mart*0172 fcthread = fcthread + fctile
5001c65f45 Patr*0173 enddo
0174 enddo
0175
0176 #ifdef ECCO_VERBOSE
0177
6637358eea Jean*0178 _GLOBAL_SUM_RL( fcthread , myThid )
5001c65f45 Patr*0179 write(msgbuf,'(a)') ' '
720a211d38 Ou W*0180 call print_message( msgbuf, standardMessageUnit,
0181 & SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0182 write(msgbuf,'(a,i8.8)')
0183 & ' cost_obcsw: irec = ',irec
720a211d38 Ou W*0184 call print_message( msgbuf, standardMessageUnit,
0185 & SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0186 write(msgbuf,'(a,a,d22.15)')
0187 & ' global cost function value',
0188 & ' (obcsw) = ',fcthread
720a211d38 Ou W*0189 call print_message( msgbuf, standardMessageUnit,
0190 & SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0191 write(msgbuf,'(a)') ' '
720a211d38 Ou W*0192 call print_message( msgbuf, standardMessageUnit,
0193 & SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0194 #endif
0195
0196 enddo
0197
0198
f75c953e99 Jean*0199 #endif /* ALLOW_OBCSW_COST_CONTRIBUTION */
5001c65f45 Patr*0200
c509d7e04a Gael*0201 #endif /* ALLOW_CTRL and ALLOW_OBCS */
0202
5001c65f45 Patr*0203 return
0204 end