--- MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F 2016/05/09 09:37:17 1.4 +++ MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F 2018/05/03 11:26:05 1.5 @@ -1,4 +1,4 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F,v 1.4 2016/05/09 09:37:17 mlosch Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F,v 1.5 2018/05/03 11:26:05 mlosch Exp $ C $Name: $ C ECCO_CPPOPTIONS used to affect maxcvars and defined ALLOW_OBCS?_CONTROL @@ -10,7 +10,7 @@ subroutine optim_writedata( I nn, I dfile, - I lheaderonly, + I printlists, I ff, I vv & ) @@ -51,7 +51,7 @@ _RL vv(nn) character*(9) dfile - logical lheaderonly + logical printlists c == local variables == @@ -70,6 +70,8 @@ real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy ) character*(128) fname + character*(18) prefix + parameter ( prefix = " OPTIM_WRITEDATA: " ) cgg( _RL gg integer igg @@ -85,16 +87,16 @@ 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* + 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.' + 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 @@ -108,38 +110,29 @@ & 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 *, prefix, 'nvartype ', nvartype + print *, prefix, 'nvarlength ', nvarlength + print *, prefix, 'yctrlid ', yctrlid + print *, prefix, 'nopt ', nopt + print *, prefix, 'ff ', ff + print *, prefix, 'iG ', biG + print *, prefix, 'jG ', bjG + print *, prefix, 'nsx ', nsx + print *, prefix, '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) + if ( printlists ) then + print *, prefix, 'nWetcGlobal ', (nWetcGlobal(k), k=1,nr) + print *, prefix, 'nWetsGlobal ', (nWetsGlobal(k), k=1,nr) + print *, prefix, 'nWetwGlobal ', (nWetwGlobal(k), k=1,nr) + print *, prefix, 'nWetvGlobal ', (nWetvGlobal(k), k=1,nr) + print *, prefix, 'ncvarindex ', (ncvarindex(i), i=1,maxcvars) + print *, prefix, 'ncvarrecs ', (ncvarrecs(i), i=1,maxcvars) + print *, prefix, 'ncvarxmax ', (ncvarxmax(i), i=1,maxcvars) + print *, prefix, 'ncvarymax ', (ncvarymax(i), i=1,maxcvars) + print *, prefix, 'ncvarnrmax ', (ncvarnrmax(i), i=1,maxcvars) + print *, prefix, 'ncvargrd ', (ncvargrd(i), i=1,maxcvars) + endif + c-- Write the header. write( funit ) nvartype @@ -162,21 +155,20 @@ c write(funit) nWetiGlobal(1) #endif -cgg( Add OBCS Mask information into the header section for optimization. +c 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) + 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) + 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) + 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) + 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) @@ -188,79 +180,70 @@ 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) + 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) + 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 +c O.B. points have the grid mask "m". + else if (ncvargrd(icvar) .eq. 'm') then +c 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 + if (icvar .eq. 11) cbuffindex = nWetobcsnGlo(k,iobcs) #endif #ifdef ALLOW_OBCSS_CONTROL - if (icvar .eq. 12) then - cbuffindex = nWetobcssGlo(k,iobcs) - endif + if (icvar .eq. 12) cbuffindex = nWetobcssGlo(k,iobcs) #endif #ifdef ALLOW_OBCSW_CONTROL - if (icvar .eq. 13) then - cbuffindex = nWetobcswGlo(k,iobcs) - endif + if (icvar .eq. 13) cbuffindex = nWetobcswGlo(k,iobcs) #endif #ifdef ALLOW_OBCSE_CONTROL - if (icvar .eq. 14) then - cbuffindex = nWetobcseGlo(k,iobcs) - endif + if (icvar .eq. 14) cbuffindex = nWetobcseGlo(k,iobcs) #endif - endif -cgg) - if (cbuffindex .gt. 0) then - do icvcomp = 1,cbuffindex - cbuff(icvcomp) = vv(icvoffset + icvcomp) + endif + 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 +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 + endif enddo close( funit ) -cph( - print *,'end of optim_writedata: icvoffset ', icvoffset -cph) + + print *, prefix, 'end of optim_writedata, icvoffset ', icvoffset + print *, ' ' return end