pkg/ecco/ecco_cost_init_barfiles.F

8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
93bee5c6a2 Jean*0002 #include "AD_CONFIG.h"
6805a315c1 Gael*0003 #ifdef ALLOW_CTRL
                0004 # include "CTRL_OPTIONS.h"
                0005 #endif
c9dc83bee0 Patr*0006
65754df434 Mart*0007       subroutine ecco_cost_init_barfiles( myThid )
5001c65f45 Patr*0008
                0009 c     ==================================================================
                0010 c     SUBROUTINE ecco_cost_init_barfiles
                0011 c     ==================================================================
                0012 c
                0013 c--   Initialise adjoint of monthly mean files calculated
                0014 c--   in cost_averagesfields (and their ad...).
                0015 c
                0016 c     started: heimbach@mit.edu 20-Mar-2002
                0017 c
                0018 c     ==================================================================
                0019 c     SUBROUTINE ecco_cost_cost_init_barfiles
                0020 c     ==================================================================
                0021
65754df434 Mart*0022       IMPLICIT NONE
5001c65f45 Patr*0023
                0024 c     == global variables ==
                0025
                0026 #include "EEPARAMS.h"
                0027 #include "SIZE.h"
8d3c878255 Patr*0028 #include "PARAMS.h"
5001c65f45 Patr*0029
b0f9ab3790 Gael*0030 #ifdef ALLOW_ECCO
cf705a6c8e Mart*0031 # include "ECCO_SIZE.h"
                0032 # include "ECCO.h"
b0f9ab3790 Gael*0033 #endif
960ed3a8f0 Gael*0034 #ifdef ALLOW_CTRL
                0035 # include "CTRL_SIZE.h"
4d72283393 Mart*0036 # include "CTRL.h"
edcd27be69 Mart*0037 # include "CTRL_DUMMY.h"
960ed3a8f0 Gael*0038 #endif
5001c65f45 Patr*0039
                0040 c     == routine arguments ==
                0041
65754df434 Mart*0042       integer myThid
5001c65f45 Patr*0043
                0044 c     == local variables ==
                0045
                0046       integer bi,bj
                0047       integer i,j,k
                0048       integer itlo,ithi
                0049       integer jtlo,jthi
                0050       integer jmin,jmax
                0051       integer imin,imax
                0052
9f5240b52a Jean*0053       integer ilt, irec
5001c65f45 Patr*0054
b0f9ab3790 Gael*0055 #ifdef ALLOW_GENCOST_CONTRIBUTION
65754df434 Mart*0056       CHARACTER*(128) fname_gencostbar
                0057       CHARACTER*(128) adfname_gencostbar
b0f9ab3790 Gael*0058 #endif /* ALLOW_GENCOST_CONTRIBUTION */
                0059
65754df434 Mart*0060       _RL tmpfld2d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,   nSx,nSy)
                0061       _RL tmpfld3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
b8f3755655 Gael*0062
5001c65f45 Patr*0063 c     == external functions ==
                0064
                0065       integer  ilnblnk
                0066       external ilnblnk
                0067
                0068 c     == end of interface ==
                0069
65754df434 Mart*0070       jtlo = myByLo(myThid)
                0071       jthi = myByHi(myThid)
                0072       itlo = myBxLo(myThid)
                0073       ithi = myBxHi(myThid)
5001c65f45 Patr*0074       jmin = 1
65754df434 Mart*0075       jmax = sNy
5001c65f45 Patr*0076       imin = 1
65754df434 Mart*0077       imax = sNx
5001c65f45 Patr*0078
                0079       do bj = jtlo,jthi
                0080         do bi = itlo,ithi
                0081           do j = jmin,jmax
                0082             do i =  imin,imax
                0083               tmpfld2d(i,j,bi,bj) = 0. _d 0
                0084             enddo
                0085           enddo
                0086         enddo
                0087       enddo
                0088       do bj = jtlo,jthi
                0089         do bi = itlo,ithi
65754df434 Mart*0090           do k = 1,Nr
5001c65f45 Patr*0091             do j = jmin,jmax
                0092               do i =  imin,imax
                0093                 tmpfld3d(i,j,k,bi,bj) = 0. _d 0
                0094               enddo
                0095             enddo
                0096           enddo
                0097         enddo
                0098       enddo
b0f9ab3790 Gael*0099
69f8f4c84c Patr*0100 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0101 c--   Save gencost_barfile on file.
                0102       do k=1,NGENCOST
2e6c12027d Gael*0103       if ( .NOT.gencost_barskip(k) ) then
69f8f4c84c Patr*0104       ilt=ilnblnk( gencost_barfile(k) )
                0105       write(fname_gencostbar,'(2a,i10.10)')
101f75e5cd Gael*0106      &     gencost_barfile(k)(1:ilt), '.', eccoiter
                0107
                0108 #ifdef ALLOW_AUTODIFF
                0109       if ( useAUTODIFF ) then
69f8f4c84c Patr*0110       write(adfname_gencostbar,'(3a,i10.10)')
101f75e5cd Gael*0111      &     yadprefix, gencost_barfile(k)(1:ilt), '.', eccoiter
0b74dee5b8 Gael*0112       do irec = 1,gencost_nrec(k)
2a0641f1b7 Gael*0113 #ifdef ALLOW_ADJOINT_RUN
2e6c12027d Gael*0114         if (.NOT.gencost_is3d(k))
                0115      &  call active_write_xy( adfname_gencostbar, tmpfld2d, irec,
65754df434 Mart*0116      &       eccoiter, myThid, gencost_dummy(k) )
2e6c12027d Gael*0117         if (gencost_is3d(k))
b0f9ab3790 Gael*0118      &  call active_write_xyz( adfname_gencostbar, tmpfld3d, irec,
65754df434 Mart*0119      &       eccoiter, myThid, gencost_dummy(k) )
69f8f4c84c Patr*0120 #endif
                0121       enddo
d181f9168b Gael*0122       endif
101f75e5cd Gael*0123 #endif
                0124
                0125       endif
8f7d13d0c9 Jean*0126       enddo
69f8f4c84c Patr*0127 #endif /* ALLOW_GENCOST_CONTRIBUTION */
                0128
5001c65f45 Patr*0129       return
                0130       end