File indexing completed on 2024-03-02 06:10:02 UTC
view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
65754df434 Mart*0001
0002
0003
0004
eab6982bba Gael*0005 #include "CTRL_OPTIONS.h"
1b116cf4a9 Gael*0006
4cee17c1be Patr*0007 subroutine optim_writedata(
0008 I nn,
0009 I dfile,
65754df434 Mart*0010 I printlists,
4cee17c1be Patr*0011 I ff,
0012 I vv
65754df434 Mart*0013 & )
4cee17c1be Patr*0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
5cf4364659 Mart*0032 IMPLICIT NONE
4cee17c1be Patr*0033
0034
0035
0036 #include "EEPARAMS.h"
0037 #include "SIZE.h"
5cf4364659 Mart*0038 #include "CTRL_SIZE.h"
65754df434 Mart*0039 #ifdef ALLOW_OBCS_CONTROL
0040 # include "CTRL_OBCS.h"
0041 #endif
0042 #include "CTRL.h"
4cee17c1be Patr*0043 #include "optim.h"
0044
0045
0046
0047 integer nn
0048 _RL ff
0049 _RL vv(nn)
0050
0051 character*(9) dfile
65754df434 Mart*0052 logical printlists
4cee17c1be Patr*0053
0054
0055
0056 integer i,j,k
0057 integer ii
65754df434 Mart*0058
4cee17c1be Patr*0059 integer biG,bjG
0060 integer nopt
0061 integer icvcomp
0062 integer icvoffset
0063 integer icvrec
5cf4364659 Mart*0064 integer ivar
4cee17c1be Patr*0065 integer funit
0066 integer cbuffindex
0067
f50e6c1777 Patr*0068 real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
4cee17c1be Patr*0069
0070 character*(128) fname
65754df434 Mart*0071 character*(18) prefix
0072 parameter ( prefix = " OPTIM_WRITEDATA: " )
4cee17c1be Patr*0073
0074 _RL gg
0075 integer igg
0076 integer iobcs
0077
0078
0079
0080
0081
0082 funit = 20
0083
0084
0085 nopt = optimcycle + 1
0086
0087 if ( dfile .eq. ctrlname ) then
65754df434 Mart*0088 print*
0089 print*,' OPTIM_WRITEDATA: Writing new control vector to file(s)'
0090 print*,' for optimization cycle: ',nopt
0091 print*
4cee17c1be Patr*0092 else
65754df434 Mart*0093 print*
0094 print*,' OPTIM_WRITEDATA: subroutine called by a false *dfile*'
0095 print*,' argument. *dfile* = ',dfile
0096 print*
0097 stop ' ... stopped in OPTIM_WRITEDATA.'
4cee17c1be Patr*0098 endif
0099
5cf4364659 Mart*0100 bjG = 1 + (myYGlobalLo - 1)/sNy
0101 biG = 1 + (myXGlobalLo - 1)/sNx
4cee17c1be Patr*0102
0103
0104 write(fname(1:128),'(4a,i4.4)')
91d99130a0 Davi*0105 & dfile,'_',yctrlid(1:10),'.opt', nopt
4cee17c1be Patr*0106 open( funit, file = fname,
0107 & status = 'new',
0108 & form = 'unformatted',
0109 & access = 'sequential' )
0110
65754df434 Mart*0111 print *, prefix, 'nvartype ', nvartype
0112 print *, prefix, 'nvarlength ', nvarlength
0113 print *, prefix, 'yctrlid ', yctrlid
0114 print *, prefix, 'nopt ', nopt
0115 print *, prefix, 'ff ', ff
0116 print *, prefix, 'iG ', biG
0117 print *, prefix, 'jG ', bjG
5cf4364659 Mart*0118 print *, prefix, 'nSx ', nSx
0119 print *, prefix, 'nSy ', nSy
65754df434 Mart*0120
0121 if ( printlists ) then
5cf4364659 Mart*0122 print *, prefix, 'nWetcGlobal ', (nWetcGlobal(k), k=1,Nr)
0123 print *, prefix, 'nWetsGlobal ', (nWetsGlobal(k), k=1,Nr)
0124 print *, prefix, 'nWetwGlobal ', (nWetwGlobal(k), k=1,Nr)
0125
65754df434 Mart*0126 print *, prefix, 'ncvarindex ', (ncvarindex(i), i=1,maxcvars)
0127 print *, prefix, 'ncvarrecs ', (ncvarrecs(i), i=1,maxcvars)
0128 print *, prefix, 'ncvarxmax ', (ncvarxmax(i), i=1,maxcvars)
0129 print *, prefix, 'ncvarymax ', (ncvarymax(i), i=1,maxcvars)
0130 print *, prefix, 'ncvarnrmax ', (ncvarnrmax(i), i=1,maxcvars)
0131 print *, prefix, 'ncvargrd ', (ncvargrd(i), i=1,maxcvars)
0132 endif
4cee17c1be Patr*0133
0134
0135 write( funit ) nvartype
0136 write( funit ) nvarlength
91d99130a0 Davi*0137 write( funit ) yctrlid
4cee17c1be Patr*0138 write( funit ) optimcycle
0139 write( funit ) ff
0140 write( funit ) big
0141 write( funit ) bjg
5cf4364659 Mart*0142 write( funit ) nSx
0143 write( funit ) nSy
0144 write( funit ) (nWetcGlobal(k), k=1,Nr)
0145 write( funit ) (nWetsGlobal(k), k=1,Nr)
0146 write( funit ) (nWetwGlobal(k), k=1,Nr)
0147
0148
0149
e189f4121c Mart*0150 #ifdef ALLOW_SHIFWFLX_CONTROL
5cf4364659 Mart*0151 write(funit) (nWetiGlobal(k), k=1,Nr)
e189f4121c Mart*0152
0153 #endif
4cee17c1be Patr*0154
65754df434 Mart*0155
4cee17c1be Patr*0156 #ifdef ALLOW_OBCSN_CONTROL
5cf4364659 Mart*0157 write(funit) ((nWetobcsnGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
4cee17c1be Patr*0158 #endif
0159 #ifdef ALLOW_OBCSS_CONTROL
5cf4364659 Mart*0160 write(funit) ((nWetobcssGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
4cee17c1be Patr*0161 #endif
0162 #ifdef ALLOW_OBCSW_CONTROL
5cf4364659 Mart*0163 write(funit) ((nWetobcswGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
4cee17c1be Patr*0164 #endif
0165 #ifdef ALLOW_OBCSE_CONTROL
5cf4364659 Mart*0166 write(funit) ((nWetobcseGlo(k,iobcs), k=1,Nr),iobcs= 1,nobcs)
4cee17c1be Patr*0167 #endif
0168
5cf4364659 Mart*0169 write( funit ) (ncvarindex(ivar), ivar=1,nvartype)
0170 write( funit ) (ncvarrecs(ivar), ivar=1,nvartype)
0171 write( funit ) (ncvarxmax(ivar), ivar=1,nvartype)
0172 write( funit ) (ncvarymax(ivar), ivar=1,nvartype)
0173 write( funit ) (ncvarnrmax(ivar), ivar=1,nvartype)
0174 write( funit ) (ncvargrd(ivar), ivar=1,nvartype)
0175 write( funit ) (ncvartype(ivar), ivar=1,nvartype)
4cee17c1be Patr*0176
0177
0178 icvoffset = 0
5cf4364659 Mart*0179
0180 do ivar = 1,nvartype
0181 if ( ncvarindex(ivar) .ne. -1 ) then
0182 do icvrec = 1,ncvarrecs(ivar)
65754df434 Mart*0183
0184
5cf4364659 Mart*0185 write( funit ) ncvarindex(ivar)
65754df434 Mart*0186
0187
5cf4364659 Mart*0188 write( funit ) nSx
0189 write( funit ) nSy
0190 do k = 1,ncvarnrmax(ivar)
65754df434 Mart*0191 cbuffindex = 0
5cf4364659 Mart*0192 if (ncvargrd(ivar) .eq. 'c') then
65754df434 Mart*0193 cbuffindex = nWetcGlobal(k)
5cf4364659 Mart*0194 else if (ncvargrd(ivar) .eq. 's') then
65754df434 Mart*0195 cbuffindex = nWetsGlobal(k)
5cf4364659 Mart*0196 else if (ncvargrd(ivar) .eq. 'w') then
65754df434 Mart*0197 cbuffindex = nWetwGlobal(k)
5cf4364659 Mart*0198
0199
e189f4121c Mart*0200 #ifdef ALLOW_SHIFWFLX_CONTROL
5cf4364659 Mart*0201 else if (ncvargrd(ivar) .eq. 'i') then
65754df434 Mart*0202 cbuffindex = nWetiGlobal(k)
4cee17c1be Patr*0203 #endif
65754df434 Mart*0204 #ifdef ALLOW_OBCS_CONTROL
0205
5cf4364659 Mart*0206 else if (ncvargrd(ivar) .eq. 'm') then
65754df434 Mart*0207
0208 gg = (icvrec-1)/nobcs
0209 igg = int(gg)
0210 iobcs= icvrec - igg*nobcs
0211 # ifdef ALLOW_OBCSN_CONTROL
5cf4364659 Mart*0212 if (ncvarindex(ivar).eq.1) cbuffindex=nWetobcsnGlo(k,iobcs)
65754df434 Mart*0213 # endif
0214 # ifdef ALLOW_OBCSS_CONTROL
5cf4364659 Mart*0215 if (ncvarindex(ivar).eq.2) cbuffindex=nWetobcssGlo(k,iobcs)
65754df434 Mart*0216 # endif
0217 # ifdef ALLOW_OBCSE_CONTROL
5cf4364659 Mart*0218 if (ncvarindex(ivar).eq.3) cbuffindex=nWetobcseGlo(k,iobcs)
0219 # endif
0220 # ifdef ALLOW_OBCSW_CONTROL
0221 if (ncvarindex(ivar).eq.4) cbuffindex=nWetobcswGlo(k,iobcs)
65754df434 Mart*0222 # endif
0223 #endif /* ALLOW_OBCS_CONTROL */
0224 endif
0225 if (cbuffindex .gt. 0) then
0226 do icvcomp = 1,cbuffindex
0227 cbuff(icvcomp) = vv(icvoffset + icvcomp)
55a9c4c009 Mart*0228
0229
65754df434 Mart*0230
0231
0232 enddo
0233 write( funit ) cbuffindex
0234 write( funit ) k
0235 write( funit ) (cbuff(ii), ii=1,cbuffindex)
0236 icvoffset = icvoffset + cbuffindex
0237 endif
0238 enddo
4e5349720c Patr*0239
0240
65754df434 Mart*0241 enddo
0242 endif
4cee17c1be Patr*0243 enddo
0244
0245 close( funit )
65754df434 Mart*0246
0247 print *, prefix, 'end of optim_writedata, icvoffset ', icvoffset
0248 print *, ' '
4cee17c1be Patr*0249
0250 return
0251 end