Back to home page

MITgcm
 
 

    

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 C     ECCO_CPPOPTIONS used to affect maxcvars and defined ALLOW_OBCS?_CONTROL
                0002 C#include "ECCO_CPPOPTIONS.h"
                0003 C     now:
                0004 C     CTRL_OPTIONS affects maxcvars and may define ALLOW_OBCS?_CONTROL
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 c     ==================================================================
                0016 c     SUBROUTINE optim_writedata
                0017 c     ==================================================================
                0018 c
                0019 c     o Writes the latest update of the control vector to file(s). These
                0020 c       files can then be used by the MITgcmUV state estimation setup
                0021 c       for the next forward/adjoint simluation.
                0022 c
                0023 c     started: Christian Eckert eckert@mit.edu 12-Apr-2000
                0024 c
                0025 c     changed:  Patrick Heimbach heimbach@mit.edu 19-Jun-2000
                0026 c               - finished, revised and debugged
                0027 c
                0028 c     ==================================================================
                0029 c     SUBROUTINE optim_writedata
                0030 c     ==================================================================
                0031 
5cf4364659 Mart*0032       IMPLICIT NONE
4cee17c1be Patr*0033 
                0034 c     == global variables ==
                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 c     == routine arguments ==
                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 c     == local variables ==
                0055 
                0056       integer i,j,k
                0057       integer ii
65754df434 Mart*0058 CML      integer bi,bj
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 cgg(
                0074       _RL     gg
                0075       integer igg
                0076       integer iobcs
                0077 cgg)
                0078 
                0079 c     == end of interface ==
                0080 
                0081 c--   I/O unit to use.
                0082       funit = 20
                0083 
                0084 c--   Next optimization cycle.
                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 c--         Generate file name and open the file.
                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 c      print *, prefix, 'nWetvGlobal ', (nWetvGlobal(k), k=1,Nr)
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 c--   Write the header.
                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 c#ifdef ALLOW_CTRL_WETV
                0148 c     write( funit ) (nWetvGlobal(k), k=1,Nr)
                0149 c#endif
e189f4121c Mart*0150 #ifdef ALLOW_SHIFWFLX_CONTROL
5cf4364659 Mart*0151       write(funit) (nWetiGlobal(k),   k=1,Nr)
e189f4121c Mart*0152 c     write(funit) nWetiGlobal(1)
                0153 #endif
4cee17c1be Patr*0154 
65754df434 Mart*0155 c     Add OBCS Mask information into the header section for optimization.
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 c--         Write the data.
                0178       icvoffset = 0
5cf4364659 Mart*0179 c     do ivar = 1,maxcvars
                0180       do ivar = 1,nvartype
                0181        if ( ncvarindex(ivar) .ne. -1 ) then
                0182         do icvrec = 1,ncvarrecs(ivar)
65754df434 Mart*0183 cph         do bj = 1,nsy
                0184 cph          do bi = 1,nsx
5cf4364659 Mart*0185          write( funit ) ncvarindex(ivar)
65754df434 Mart*0186 CML         write( funit ) bi
                0187 CML         write( funit ) bj
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 c         else if (ncvargrd(ivar) .eq. 'v') then
                0199 c          cbuffindex = nWetvGlobal(k)
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 c     O.B. points have the grid mask "m".
5cf4364659 Mart*0206           else if (ncvargrd(ivar) .eq. 'm') then
65754df434 Mart*0207 c     From "icvrec", calculate what iobcs must be.
                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 c     If you want to optimize with respect to just O.B. T and S
                0229 c     uncomment the next two lines.
65754df434 Mart*0230 c           if (iobcs .eq. 3) cbuff(icvcomp)=0.
                0231 c           if (iobcs .eq. 4) cbuff(icvcomp)=0.
                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 cph                  enddo
                0240 cph               enddo
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
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!