--- MITgcm/optim/optim_readdata.F 2003/03/07 05:21:33 1.1.2.4 +++ MITgcm/optim/optim_readdata.F 2011/07/25 08:58:47 1.10 @@ -37,7 +37,6 @@ cgg have headers with options for OBCS masks. #include "ECCO_CPPOPTIONS.h" -#include "ecco.h" #include "ctrl.h" #include "optim.h" #include "minimization.h" @@ -75,18 +74,18 @@ integer funit integer cbuffindex - _RL cbuff( sNx*nSx*nPx*sNy*nSy*nPy ) + real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy ) character*(128) fname - integer filei - integer filej - integer filek +c integer filei +c integer filej +c integer filek +c integer fileiG +c integer filejG +c integer filensx +c integer filensy integer filenopt - integer fileig - integer filejg - integer filensx - integer filensy _RL fileff cgg( @@ -97,6 +96,8 @@ c == end of interface == + print *, 'pathei-lsopt in optim_readdata' + c-- The reference i/o unit. funit = 20 @@ -129,7 +130,7 @@ c-- Generate file name and open the file. write(fname(1:128),'(4a,i4.4)') - & dfile,'_',expId(1:10),'.opt', nopt + & dfile,'_',yctrlid(1:10),'.opt', nopt open( funit, file = fname, & status = 'old', & form = 'unformatted', @@ -139,7 +140,7 @@ c-- Read the header. read( funit ) nvartype read( funit ) nvarlength - read( funit ) expId + read( funit ) yctrlid read( funit ) filenopt read( funit ) fileff read( funit ) fileiG @@ -147,16 +148,16 @@ read( funit ) filensx read( funit ) filensy -cph( - print *,'ph-opt 1 ', nvartype, nvarlength, filensx, filensy -cph) - read( funit ) (nWetcGlobal(k), k=1,nr) read( funit ) (nWetsGlobal(k), k=1,nr) read( funit ) (nWetwGlobal(k), k=1,nr) #ifdef ALLOW_CTRL_WETV read( funit ) (nWetvGlobal(k), k=1,nr) #endif +#ifdef ALLOW_SHIFWFLX_CONTROL + read(funit) (nWetiGlobal(k), k=1,nr) +c read(funit) nWetiGlobal(1) +#endif cgg( Add OBCS Mask information into the header section for optimization. #ifdef ALLOW_OBCSN_CONTROL @@ -184,7 +185,7 @@ cph if (lheaderonly) then print *, 'pathei: nvartype ', nvartype print *, 'pathei: nvarlength ', nvarlength - print *, 'pathei: expId ', expId + print *, 'pathei: yctrlid ', yctrlid print *, 'pathei: filenopt ', filenopt print *, 'pathei: fileff ', fileff print *, 'pathei: fileiG ', fileiG @@ -200,6 +201,34 @@ & (nWetwGlobal(k), k=1,nr) print *, 'pathei: nWetvGlobal ', & (nWetvGlobal(k), k=1,nr) +#ifdef ALLOW_SHIFWFLX_CONTROL + print *, 'pathei: nWetiGlobal ', + & (nWetiGlobal(k), k=1,nr) +#endif +#ifdef ALLOW_OBCSN_CONTROL + do iobcs=1,nobcs + print *, 'pathei: nWetobcsnGlo (iobcs=', iobcs,')', + & (nWetobcsnGlo(k,iobcs), k=1,nr) + enddo +#endif +#ifdef ALLOW_OBCSS_CONTROL + do iobcs=1,nobcs + print *, 'pathei: nWetobcssGlo (iobcs=', iobcs,')', + & (nWetobcssGlo(k,iobcs), k=1,nr) + enddo +#endif +#ifdef ALLOW_OBCSW_CONTROL + do iobcs=1,nobcs + print *, 'pathei: nWetobcswGlo (iobcs=', iobcs,')', + & (nWetobcswGlo(k,iobcs), k=1,nr) + enddo +#endif +#ifdef ALLOW_OBCSE_CONTROL + do iobcs=1,nobcs + print *, 'pathei: nWetobcseGlo (iobcs=', iobcs,')', + & (nWetobcseGlo(k,iobcs), k=1,nr) + enddo +#endif print *, 'pathei: ncvarindex ', & (ncvarindex(i), i=1,maxcvars) print *, 'pathei: ncvarrecs ', @@ -253,79 +282,95 @@ if (.NOT. lheaderonly) then c-- Read the data. - icvoffset = 0 - do icvar = 1,maxcvars - if ( ncvarindex(icvar) .ne. -1 ) then - do icvrec = 1,ncvarrecs(icvar) - do bj = 1,nsy - do bi = 1,nsx - read( funit ) ncvarindex(icvar) - read( funit ) filej - read( funit ) filei - do k = 1,ncvarnrmax(icvar) - cbuffindex = 0 - if (ncvargrd(icvar) .eq. 'c') then - cbuffindex = nWetcGlobal(k) - else if (ncvargrd(icvar) .eq. 's') then - cbuffindex = nWetsGlobal(k) - else if (ncvargrd(icvar) .eq. 'w') then - cbuffindex = nWetwGlobal(k) - else if (ncvargrd(icvar) .eq. 'v') then - cbuffindex = nWetvGlobal(k) + icvoffset = 0 + do icvar = 1,maxcvars + if ( ncvarindex(icvar) .ne. -1 ) then + do icvrec = 1,ncvarrecs(icvar) + do bj = 1,nsy + do bi = 1,nsx + read( funit ) ncvarindex(icvar) + read( funit ) filej + read( funit ) filei + do k = 1,ncvarnrmax(icvar) + cbuffindex = 0 + if (ncvargrd(icvar) .eq. 'c') then + cbuffindex = nWetcGlobal(k) + else if (ncvargrd(icvar) .eq. 's') then + cbuffindex = nWetsGlobal(k) + else if (ncvargrd(icvar) .eq. 'w') then + cbuffindex = nWetwGlobal(k) + else if (ncvargrd(icvar) .eq. 'v') then + cbuffindex = nWetvGlobal(k) +#ifdef ALLOW_SHIFWFLX_CONTROL + else if (ncvargrd(icvar) .eq. 'i') then + cbuffindex = nWetiGlobal(k) +#endif cgg( O.B. points have the grid mask "m". - else if (ncvargrd(icvar) .eq. 'm') then + else if (ncvargrd(icvar) .eq. 'm') then cgg From "icvrec", calculate what iobcs must be. - gg = (icvrec-1)/nobcs - igg = int(gg) - iobcs= icvrec - igg*nobcs + gg = (icvrec-1)/nobcs + igg = int(gg) + iobcs= icvrec - igg*nobcs #ifdef ALLOW_OBCSN_CONTROL - if (icvar .eq. 11) then - cbuffindex = nWetobcsnGlo(k,iobcs) - endif + if (icvar .eq. 11) then + cbuffindex = nWetobcsnGlo(k,iobcs) + endif #endif #ifdef ALLOW_OBCSS_CONTROL - if (icvar .eq. 12) then - cbuffindex = nWetobcssGlo(k,iobcs) - endif + if (icvar .eq. 12) then + cbuffindex = nWetobcssGlo(k,iobcs) + endif #endif #ifdef ALLOW_OBCSW_CONTROL - if (icvar .eq. 13) then - cbuffindex = nWetobcswGlo(k,iobcs) - endif + if (icvar .eq. 13) then + cbuffindex = nWetobcswGlo(k,iobcs) + endif #endif #ifdef ALLOW_OBCSE_CONTROL - if (icvar .eq. 14) then - cbuffindex = nWetobcseGlo(k,iobcs) - endif + if (icvar .eq. 14) then + cbuffindex = nWetobcseGlo(k,iobcs) + endif #endif cgg) - endif - if (cbuffindex .gt. 0) then - read( funit ) cbuffindex - read( funit ) filek - read( funit ) (cbuff(ii), ii=1,cbuffindex) - do icvcomp = 1,cbuffindex - vv(icvoffset+icvcomp) = cbuff(icvcomp) -cgg( Right now, the changes to the open boundary velocities are not balanced. -cgg( The model will crash due to physical reasons. -cgg( However, we can optimize with respect to just O.B. T and S if the -cgg( next two lines are uncommented. -cgg if (iobcs .eq. 3) vv(icvoffset+icvcomp)=0. -cgg if (iobcs .eq. 4) vv(icvoffset+icvcomp)=0. - enddo - icvoffset = icvoffset + cbuffindex - endif - enddo - enddo - enddo - enddo - endif + endif + if ( icvoffset + cbuffindex .gt. nvarlength ) then + print* + print *, ' ERROR:' + print *, ' There are at least ', icvoffset+cbuffindex, + & ' records in '//fname(1:28)//'.' + print *, ' This is more than expected from nvarlength =', + & nvarlength, '.' + print *, ' Something is wrong in the computation of '// + & 'the wet points or' + print *, ' in computing the number of records in '// + & 'some variable(s).' + print *, ' ... stopped in OPTIM_READDATA.' + stop ' ... stopped in OPTIM_READDATA.' + endif + if (cbuffindex .gt. 0) then + read( funit ) cbuffindex + read( funit ) filek + read( funit ) (cbuff(ii), ii=1,cbuffindex) + do icvcomp = 1,cbuffindex + vv(icvoffset+icvcomp) = cbuff(icvcomp) +c If you want to optimize with respect to just O.B. T and S +c uncomment the next two lines. +c if (iobcs .eq. 3) vv(icvoffset+icvcomp)=0. +c if (iobcs .eq. 4) vv(icvoffset+icvcomp)=0. + enddo + icvoffset = icvoffset + cbuffindex + endif + enddo + enddo + enddo enddo - + endif + enddo + else c-- Assign the number of control variables. - nn = nvarlength + nn = nvarlength endif @@ -334,9 +379,9 @@ c-- Assign the cost function value in case we read the cost file. if ( dfile .eq. ctrlname ) then - ff = 0. d 0 + ff = 0. d 0 else if ( dfile .eq. costname ) then - ff = fileff + ff = fileff endif return