c ECCO_CPPOPTIONS used to affect maxcvars c and def ALLOW_OBCSN_CONTROL etc (OBCS masks etc) c#include ECCO_CPPOPTIONS.h c CTRL_OPTIONS affects maxcvars and may def c ALLOW_OBCSN_CONTROL etc (OBCS masks etc) #include "CTRL_OPTIONS.h" subroutine optim_writedata( I nn, I dfile, I lheaderonly, I ff, I vv & ) c ================================================================== c SUBROUTINE optim_writedata c ================================================================== c c o Writes the latest update of the control vector to file(s). These c files can then be used by the MITgcmUV state estimation setup c for the next forward/adjoint simluation. c c started: Christian Eckert eckert@mit.edu 12-Apr-2000 c c changed: Patrick Heimbach heimbach@mit.edu 19-Jun-2000 c - finished, revised and debugged c c ================================================================== c SUBROUTINE optim_writedata c ================================================================== implicit none c == global variables == #include "EEPARAMS.h" #include "SIZE.h" #include "ctrl.h" #include "optim.h" #include "minimization.h" c == routine arguments == integer nn _RL ff _RL vv(nn) character*(9) dfile logical lheaderonly c == local variables == integer i,j,k integer ii integer bi,bj integer biG,bjG integer nopt integer icvcomp integer icvoffset integer icvrec integer icvar integer funit integer cbuffindex real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy ) character*(128) fname cgg( _RL gg integer igg integer iobcs cgg) c == end of interface == c-- I/O unit to use. funit = 20 c-- Next optimization cycle. nopt = optimcycle + 1 if ( dfile .eq. ctrlname ) then print* print*,' OPTIM_WRITEDATA: Writing new control vector to file(s)' print*,' for optimization cycle: ',nopt print* else print* print*,' OPTIM_WRITEDATA: subroutine called by a false *dfile*' print*,' argument. *dfile* = ',dfile print* stop ' ... stopped in OPTIM_WRITEDATA.' endif bjG = 1 + (myygloballo - 1)/sny biG = 1 + (myxgloballo - 1)/snx c-- Generate file name and open the file. write(fname(1:128),'(4a,i4.4)') & dfile,'_',yctrlid(1:10),'.opt', nopt open( funit, file = fname, & status = 'new', & form = 'unformatted', & access = 'sequential' ) cph( print *, 'pathei: nvartype ', nvartype print *, 'pathei: nvarlength ', nvarlength print *, 'pathei: yctrlid ', yctrlid print *, 'pathei: nopt ', nopt print *, 'pathei: ff ', ff print *, 'pathei: iG ', biG print *, 'pathei: jG ', bjG print *, 'pathei: nsx ', nsx print *, 'pathei: nsy ', nsy print *, 'pathei: nWetcGlobal ', & (nWetcGlobal(k), k=1,nr) print *, 'pathei: nWetsGlobal ', & (nWetsGlobal(k), k=1,nr) print *, 'pathei: nWetwGlobal ', & (nWetwGlobal(k), k=1,nr) print *, 'pathei: nWetvGlobal ', & (nWetvGlobal(k), k=1,nr) print *, 'pathei: ncvarindex ', & (ncvarindex(i), i=1,maxcvars) print *, 'pathei: ncvarrecs ', & (ncvarrecs(i), i=1,maxcvars) print *, 'pathei: ncvarxmax ', & (ncvarxmax(i), i=1,maxcvars) print *, 'pathei: ncvarymax ', & (ncvarymax(i), i=1,maxcvars) print *, 'pathei: ncvarnrmax ', & (ncvarnrmax(i), i=1,maxcvars) print *, 'pathei: ncvargrd ', & (ncvargrd(i), i=1,maxcvars) cph) c-- Write the header. write( funit ) nvartype write( funit ) nvarlength write( funit ) yctrlid write( funit ) optimcycle write( funit ) ff write( funit ) big write( funit ) bjg write( funit ) nsx write( funit ) nsy write( funit ) (nWetcGlobal(k), k=1,nr) write( funit ) (nWetsGlobal(k), k=1,nr) write( funit ) (nWetwGlobal(k), k=1,nr) #ifdef ALLOW_CTRL_WETV write( funit ) (nWetvGlobal(k), k=1,nr) #endif #ifdef ALLOW_SHIFWFLX_CONTROL write(funit) (nWetiGlobal(k), k=1,nr) c write(funit) nWetiGlobal(1) #endif cgg( Add OBCS Mask information into the header section for optimization. #ifdef ALLOW_OBCSN_CONTROL write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs) #endif #ifdef ALLOW_OBCSS_CONTROL write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs) #endif #ifdef ALLOW_OBCSW_CONTROL write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs) #endif #ifdef ALLOW_OBCSE_CONTROL write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs) #endif cgg) write( funit ) (ncvarindex(i), i=1,maxcvars) write( funit ) (ncvarrecs(i), i=1,maxcvars) write( funit ) (ncvarxmax(i), i=1,maxcvars) write( funit ) (ncvarymax(i), i=1,maxcvars) write( funit ) (ncvarnrmax(i), i=1,maxcvars) write( funit ) (ncvargrd(i), i=1,maxcvars) write( funit ) c-- Write the data. icvoffset = 0 do icvar = 1,maxcvars if ( ncvarindex(icvar) .ne. -1 ) then do icvrec = 1,ncvarrecs(icvar) cph do bj = 1,nsy cph do bi = 1,nsx write( funit ) ncvarindex(icvar) write( funit ) bj write( funit ) bi 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 cgg From "icvrec", calculate what iobcs must be. 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 #endif #ifdef ALLOW_OBCSS_CONTROL 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 #endif #ifdef ALLOW_OBCSE_CONTROL if (icvar .eq. 14) then cbuffindex = nWetobcseGlo(k,iobcs) endif #endif endif cgg) if (cbuffindex .gt. 0) then do icvcomp = 1,cbuffindex cbuff(icvcomp) = vv(icvoffset + 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) cbuff(icvcomp)=0. c if (iobcs .eq. 4) cbuff(icvcomp)=0. enddo write( funit ) cbuffindex write( funit ) k write( funit ) (cbuff(ii), ii=1,cbuffindex) icvoffset = icvoffset + cbuffindex endif enddo cph enddo cph enddo enddo endif enddo close( funit ) cph( print *,'in owd: icvoffset', icvoffset cph) return end