Back to home page

MITgcm
 
 

    

File indexing completed on 2023-09-21 05:10:17 UTC

view on githubraw file Latest commit 85c224e8 on 2023-09-20 17:25:22 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
cf4693a22f Patr*0002 
11c3150c71 Mart*0003 C--  File cost_generic.F: Generic cost function routines
                0004 C--   Contents
                0005 C--   o cost_generic
                0006 C--   o cost_genloop
                0007 
f586fdfa8f Gael*0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 CBOP
                0010 C     !ROUTINE: cost_generic
                0011 C     !INTERFACE:
951926fb9b Jean*0012       subroutine cost_generic(
4d032ba730 Gael*0013      &     nnzbar, localbarfile, dummy,
dfd90b6b5c Gael*0014      &     nnzobs, localobsfile, localerrfile,
                0015      &     mult_local, nrecloc, nrecobs,
92d10a5666 Gael*0016      &     localstartdate, localperiod,
4d032ba730 Gael*0017      &     ylocmask, spminloc, spmaxloc, spzeroloc,
3bd7a4549f Gael*0018      &     preproc, preproc_c, preproc_i, preproc_r,
                0019      &     posproc, posproc_c, posproc_i, posproc_r,
9eaee0f935 Gael*0020      &     outlev, outname,
cf4693a22f Patr*0021      &     objf_local, num_local,
f8e779c983 antn*0022      &     myIter, myTime, myThid )
cf4693a22f Patr*0023 
f586fdfa8f Gael*0024 C     !DESCRIPTION: \bv
                0025 C     Generic routine for evaluating time-dependent
cf4693a22f Patr*0026 c       cost function contribution
f586fdfa8f Gael*0027 C     \ev
cf4693a22f Patr*0028 
f586fdfa8f Gael*0029 C     !USES:
2b959ba38e Mart*0030       IMPLICIT NONE
cf4693a22f Patr*0031 
2b959ba38e Mart*0032 C     == global variables ==
cf4693a22f Patr*0033 #include "EEPARAMS.h"
                0034 #include "SIZE.h"
                0035 #include "PARAMS.h"
d3a3bee25e Patr*0036 #include "GRID.h"
cf4693a22f Patr*0037 #ifdef ALLOW_CAL
                0038 # include "cal.h"
                0039 #endif
49484c0542 Gael*0040 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0041 # include "ECCO_SIZE.h"
                0042 # include "ECCO.h"
960ed3a8f0 Gael*0043 #endif
cf4693a22f Patr*0044 
2b959ba38e Mart*0045 C     !INPUT/OUTPUT PARAMETERS:
f8e779c983 antn*0046       integer myIter
                0047       integer myThid
3bd7a4549f Gael*0048       integer nnzbar, nnzobs
                0049       integer nrecloc, nrecobs
cf4693a22f Patr*0050       integer localstartdate(4)
92d10a5666 Gael*0051       integer outlev
3bd7a4549f Gael*0052       integer preproc_i(NGENPPROC)
                0053       integer posproc_i(NGENPPROC)
cf4693a22f Patr*0054 
f8e779c983 antn*0055       _RL objf_local(nSx,nSy)
                0056       _RL num_local(nSx,nSy)
679b3bfece Gael*0057       _RL dummy
3ad0d94cb0 Patr*0058       _RL mult_local
f8e779c983 antn*0059       _RL myTime
cf4693a22f Patr*0060       _RL localperiod
                0061       _RL spminloc
                0062       _RL spmaxloc
                0063       _RL spzeroloc
3bd7a4549f Gael*0064       _RL preproc_r(NGENPPROC)
                0065       _RL posproc_r(NGENPPROC)
cf4693a22f Patr*0066 
d3a3bee25e Patr*0067       character*(1) ylocmask
cf4693a22f Patr*0068       character*(MAX_LEN_FNAM) localbarfile
                0069       character*(MAX_LEN_FNAM) localobsfile
dfd90b6b5c Gael*0070       character*(MAX_LEN_FNAM) localerrfile
3bd7a4549f Gael*0071       character*(MAX_LEN_FNAM) preproc(NGENPPROC)
                0072       character*(MAX_LEN_FNAM) preproc_c(NGENPPROC)
                0073       character*(MAX_LEN_FNAM) posproc(NGENPPROC)
                0074       character*(MAX_LEN_FNAM) posproc_c(NGENPPROC)
9eaee0f935 Gael*0075       character*(MAX_LEN_FNAM) outname
92d10a5666 Gael*0076 
                0077 #ifdef ALLOW_ECCO
2b959ba38e Mart*0078 C     !LOCAL VARIABLES:
0bcf80b5e9 Gael*0079       integer bi,bj,k2
                0080       logical domean, doanom
f8e779c983 antn*0081       _RL localdifmean1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0082       _RL localdifmean2  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
f586fdfa8f Gael*0083 CEOP
cf4693a22f Patr*0084 
                0085 c--   Initialise local variables.
                0086 
2b959ba38e Mart*0087       DO bj = myByLo(myThid), myByHi(myThid)
                0088         DO bi = myBxLo(myThid), myBxHi(myThid)
3ad0d94cb0 Patr*0089           objf_local(bi,bj) = 0. _d 0
                0090           num_local(bi,bj) = 0. _d 0
2b959ba38e Mart*0091         ENDDO
                0092       ENDDO
dfd90b6b5c Gael*0093 
1b2ca1f822 Gael*0094       call ecco_zero(localdifmean1,Nr,zeroRL,myThid)
                0095       call ecco_zero(localdifmean2,Nr,zeroRL,myThid)
474bc369aa Gael*0096 
0bcf80b5e9 Gael*0097       domean=.FALSE.
                0098       doanom=.FALSE.
                0099       do k2 = 1, NGENPPROC
                0100           if (preproc(k2).EQ.'mean') domean=.TRUE.
                0101           if (preproc(k2).EQ.'anom') doanom=.TRUE.
                0102       enddo
                0103 
474bc369aa Gael*0104 C Extra time loop to compute time-mean fields and costs
f8e779c983 antn*0105       if ( (.NOT. ( localobsfile.EQ.' ' ) )
0bcf80b5e9 Gael*0106      &   .AND. ( domean .OR. doanom ) ) then
474bc369aa Gael*0107         call cost_genloop(
1b2ca1f822 Gael*0108      &     localdifmean1,localdifmean2,.FALSE.,
474bc369aa Gael*0109      &     nnzbar, localbarfile, dummy,
                0110      &     nnzobs, localobsfile, localerrfile,
                0111      &     mult_local, nrecloc, nrecobs,
                0112      &     localstartdate, localperiod,
                0113      &     ylocmask, spminloc, spmaxloc, spzeroloc,
                0114      &     preproc, preproc_c, preproc_i, preproc_r,
                0115      &     posproc, posproc_c, posproc_i, posproc_r,
                0116      &     outlev, outname,
                0117      &     objf_local, num_local,
f8e779c983 antn*0118      &     myIter, myTime, myThid )
474bc369aa Gael*0119       endif
                0120 
1b2ca1f822 Gael*0121       call ecco_zero(localdifmean1,Nr,zeroRL,myThid)
                0122 
0bcf80b5e9 Gael*0123       if ((.NOT.(localobsfile.EQ.' ')).AND.(.NOT.domean)) then
474bc369aa Gael*0124         call cost_genloop(
1b2ca1f822 Gael*0125      &     localdifmean2,localdifmean1,.TRUE.,
474bc369aa Gael*0126      &     nnzbar, localbarfile, dummy,
                0127      &     nnzobs, localobsfile, localerrfile,
                0128      &     mult_local, nrecloc, nrecobs,
                0129      &     localstartdate, localperiod,
                0130      &     ylocmask, spminloc, spmaxloc, spzeroloc,
                0131      &     preproc, preproc_c, preproc_i, preproc_r,
                0132      &     posproc, posproc_c, posproc_i, posproc_r,
                0133      &     outlev, outname,
                0134      &     objf_local, num_local,
f8e779c983 antn*0135      &     myIter, myTime, myThid )
474bc369aa Gael*0136       endif
                0137 
                0138 #endif /* ALLOW_ECCO */
                0139 
2b959ba38e Mart*0140       RETURN
                0141       END
474bc369aa Gael*0142 
2b959ba38e Mart*0143 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0144 CBOP
                0145 C     !ROUTINE: cost_genloop
                0146 C     !INTERFACE:
474bc369aa Gael*0147       subroutine cost_genloop(
1b2ca1f822 Gael*0148      &     localdifmeanIn,localdifmeanOut, addVariaCost,
474bc369aa Gael*0149      &     nnzbar, localbarfile, dummy,
                0150      &     nnzobs, localobsfile, localerrfile,
                0151      &     mult_local, nrecloc, nrecobs,
                0152      &     localstartdate, localperiod,
                0153      &     ylocmask, spminloc, spmaxloc, spzeroloc,
                0154      &     preproc, preproc_c, preproc_i, preproc_r,
                0155      &     posproc, posproc_c, posproc_i, posproc_r,
                0156      &     outlev, outname,
                0157      &     objf_local, num_local,
f8e779c983 antn*0158      &     myIter, myTime, myThid )
474bc369aa Gael*0159 
                0160 C     !DESCRIPTION: \bv
                0161 C     Generic routine for evaluating time-dependent
                0162 c       cost function contribution
                0163 C     \ev
                0164 
                0165 C     !USES:
2b959ba38e Mart*0166       IMPLICIT NONE
474bc369aa Gael*0167 
2b959ba38e Mart*0168 C     == global variables ==
474bc369aa Gael*0169 #include "EEPARAMS.h"
                0170 #include "SIZE.h"
                0171 #include "PARAMS.h"
                0172 #include "GRID.h"
                0173 #ifdef ALLOW_CAL
                0174 # include "cal.h"
                0175 #endif
                0176 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0177 # include "ECCO_SIZE.h"
                0178 # include "ECCO.h"
474bc369aa Gael*0179 #endif
                0180 
2b959ba38e Mart*0181 C     !INPUT/OUTPUT PARAMETERS:
f8e779c983 antn*0182       integer myIter
                0183       integer myThid
474bc369aa Gael*0184       integer nnzbar, nnzobs
                0185       integer nrecloc, nrecobs
                0186       integer localstartdate(4)
                0187       integer outlev
                0188       integer preproc_i(NGENPPROC)
                0189       integer posproc_i(NGENPPROC)
                0190 
f8e779c983 antn*0191       _RL objf_local(nSx,nSy)
                0192       _RL num_local(nSx,nSy)
474bc369aa Gael*0193       _RL dummy
                0194       _RL mult_local
f8e779c983 antn*0195       _RL myTime
474bc369aa Gael*0196       _RL localperiod
                0197       _RL spminloc
                0198       _RL spmaxloc
                0199       _RL spzeroloc
                0200       _RL preproc_r(NGENPPROC)
                0201       _RL posproc_r(NGENPPROC)
                0202 
                0203       character*(1) ylocmask
                0204       character*(MAX_LEN_FNAM) localbarfile
                0205       character*(MAX_LEN_FNAM) localobsfile
                0206       character*(MAX_LEN_FNAM) localerrfile
                0207       character*(MAX_LEN_FNAM) preproc(NGENPPROC)
                0208       character*(MAX_LEN_FNAM) preproc_c(NGENPPROC)
                0209       character*(MAX_LEN_FNAM) posproc(NGENPPROC)
                0210       character*(MAX_LEN_FNAM) posproc_c(NGENPPROC)
                0211       character*(MAX_LEN_FNAM) outname
                0212 
                0213       logical addVariaCost
11c3150c71 Mart*0214       _RL localdifmeanIn (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0215       _RL localdifmeanOut(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
474bc369aa Gael*0216 
                0217 #ifdef ALLOW_ECCO
2b959ba38e Mart*0218 C     !FUNCTIONS:
                0219       integer  ilnblnk
                0220       external ilnblnk
474bc369aa Gael*0221 
2b959ba38e Mart*0222 C     !LOCAL VARIABLES:
474bc369aa Gael*0223       integer bi,bj
7b8b86ab99 Timo*0224       integer i,j,k
474bc369aa Gael*0225       integer irec, jrec
0bcf80b5e9 Gael*0226       integer il, k2
474bc369aa Gael*0227       integer localrec, obsrec
0bcf80b5e9 Gael*0228       integer nrecloop, nrecclim, k2smooth
13e29837cc An T*0229       logical domean, doanom, dovarwei, doclim, dosmooth, dosumsq
11c3150c71 Mart*0230       logical dooffset, domaskmindepth
474bc369aa Gael*0231 
f8e779c983 antn*0232       _RL localmask  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
474bc369aa Gael*0233 
f8e779c983 antn*0234       _RL localbar   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0235       _RL localweight(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0236       _RL localtmp   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0237       _RL localobs   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0238       _RL localdif   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0239       _RL difmask    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
474bc369aa Gael*0240 
11c3150c71 Mart*0241       _RL localdifmsk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0242       _RL localdifsum(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0243       _RL localdifnum(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
474bc369aa Gael*0244 
11c3150c71 Mart*0245 #ifdef ALLOW_SMOOTH
                0246       _RL tmpfld2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
7b8b86ab99 Timo*0247       _RS mask2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
11c3150c71 Mart*0248 #endif
7b8b86ab99 Timo*0249 
7da6a01a0d Gael*0250       _RL fac
11c3150c71 Mart*0251       _RL topomin
7da6a01a0d Gael*0252 
474bc369aa Gael*0253       character*(128) fname1, fname2, fname3
                0254 
                0255       logical exst
                0256 CEOP
                0257 
                0258       call ecco_zero(localbar,Nr,zeroRL,myThid)
                0259       call ecco_zero(localweight,Nr,zeroRL,myThid)
ee3c6cce5d Gael*0260       call ecco_zero(localtmp,Nr,zeroRL,myThid)
474bc369aa Gael*0261       call ecco_zero(localmask,Nr,zeroRL,myThid)
                0262 
ee3c6cce5d Gael*0263       call ecco_zero(localobs,Nr,zeroRL,myThid)
                0264       call ecco_zero(localdif,Nr,zeroRL,myThid)
                0265       call ecco_zero(difmask,Nr,zeroRL,myThid)
3ad0d94cb0 Patr*0266 
474bc369aa Gael*0267       call ecco_zero(localdifmsk,Nr,zeroRL,myThid)
                0268       call ecco_zero(localdifsum,Nr,zeroRL,myThid)
                0269       call ecco_zero(localdifnum,Nr,zeroRL,myThid)
e073e2c5c9 Gael*0270 
13e29837cc An T*0271       dosumsq=.TRUE.
0bcf80b5e9 Gael*0272       domean=.FALSE.
                0273       doanom=.FALSE.
                0274       dovarwei=.FALSE.
                0275       dosmooth=.FALSE.
11c3150c71 Mart*0276       dooffset=.FALSE.
                0277       domaskmindepth=.FALSE.
0bcf80b5e9 Gael*0278       k2smooth=1
                0279       doclim=.FALSE.
                0280       nrecclim=nrecloc
7da6a01a0d Gael*0281       fac=oneRL
                0282 
0bcf80b5e9 Gael*0283       do k2 = 1, NGENPPROC
                0284           if (preproc(k2).EQ.'mean') domean=.TRUE.
                0285           if (preproc(k2).EQ.'anom') doanom=.TRUE.
                0286           if (preproc(k2).EQ.'variaweight') dovarwei=.TRUE.
13e29837cc An T*0287           if (preproc(k2).EQ.'nosumsq') dosumsq=.FALSE.
11c3150c71 Mart*0288           if (preproc(k2).EQ.'offset') dooffset=.TRUE.
                0289           if (preproc(k2).EQ.'mindepth') then
                0290            domaskmindepth=.TRUE.
                0291            topomin = preproc_r(k2)
                0292           endif
0bcf80b5e9 Gael*0293           if (posproc(k2).EQ.'smooth') then
                0294             dosmooth=.TRUE.
                0295             k2smooth=k2
                0296           endif
                0297           if (preproc(k2).EQ.'clim') then
                0298             doclim=.TRUE.
                0299             nrecclim=preproc_i(k2)
                0300           endif
7da6a01a0d Gael*0301           if (preproc(k2).EQ.'factor') then
                0302             fac=preproc_r(k2)
                0303           endif
0bcf80b5e9 Gael*0304       enddo
                0305 
7b8b86ab99 Timo*0306 C--   Assign mask, write explicitly to include overlaps and
                0307 C     avoid exchange later (e.g. in smooth routine), note that
                0308 C     the routine ecco_cprsrl does not copy overlaps
                0309       DO bj = myByLo(myThid), myByHi(myThid)
                0310        DO bi = myBxLo(myThid), myBxHi(myThid)
                0311 
                0312         IF ( ylocmask .EQ. 'C' .OR. ylocmask .EQ. 'c' ) THEN
                0313          DO k = 1, Nr
                0314           DO j = 1-OLy,sNy+OLy
                0315            DO i = 1-OLx,sNx+OLx
                0316             localmask(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)
                0317            ENDDO
                0318           ENDDO
                0319          ENDDO
                0320 
                0321         ELSEIF ( ylocmask .EQ. 'S' .OR. ylocmask .EQ. 's' ) THEN
                0322 
                0323          DO k = 1, Nr
                0324           DO j = 1-OLy,sNy+OLy
                0325            DO i = 1-OLx,sNx+OLx
                0326             localmask(i,j,k,bi,bj) = maskS(i,j,k,bi,bj)
                0327            ENDDO
                0328           ENDDO
                0329          ENDDO
                0330 
                0331         ELSEIF ( ylocmask .EQ. 'W' .OR. ylocmask .EQ. 'w' ) THEN
                0332 
                0333          DO k = 1, Nr
                0334           DO j = 1-OLy,sNy+OLy
                0335            DO i = 1-OLx,sNx+OLx
                0336             localmask(i,j,k,bi,bj) = maskW(i,j,k,bi,bj)
                0337            ENDDO
                0338           ENDDO
                0339          ENDDO
                0340 
                0341         ELSE
11c3150c71 Mart*0342          CALL ECCO_ERROR('COST_GENLOOP', 'wrong ylocmask', myThid)
7b8b86ab99 Timo*0343         ENDIF
                0344 
                0345 #ifdef ALLOW_SMOOTH
                0346 C       Set 2D Mask for 2D smooth routine
                0347         DO j = 1-OLy,sNy+OLy
                0348          DO i = 1-OLx,sNx+OLx
                0349           mask2D(i,j,bi,bj) = localmask(i,j,1,bi,bj)
11c3150c71 Mart*0350           tmpFld2D(i,j,bi,bj) = 0. _d 0
7b8b86ab99 Timo*0351          ENDDO
                0352         ENDDO
                0353 #endif
                0354 C-- end bi/bj loop for setting masks
                0355        ENDDO
                0356       ENDDO
d3a3bee25e Patr*0357 
40db27aeaa Gael*0358 c-- set nrecloop to nrecloc
                0359       nrecloop=nrecloc
                0360 
474bc369aa Gael*0361 c-- reset nrecloop, if needed, according to preproc
0bcf80b5e9 Gael*0362       if ( doclim ) nrecloop=MIN(nrecloop,nrecclim)
474bc369aa Gael*0363 
e073e2c5c9 Gael*0364 c--   loop over obsfile records
                0365       do irec = 1, nrecloop
                0366 
dfd90b6b5c Gael*0367 c--     load weights
                0368         exst=.FALSE.
                0369         jrec=1
0bcf80b5e9 Gael*0370         if( dovarwei ) jrec = irec
dfd90b6b5c Gael*0371         call cost_gencal(localbarfile, localerrfile,
                0372      &     jrec, localstartdate, localperiod, fname1,
f8e779c983 antn*0373      &     fname3, localrec, obsrec, exst, myThid )
11c3150c71 Mart*0374         call ecco_zero(localweight,Nr,zeroRL,myThid)
dfd90b6b5c Gael*0375         if ( (localrec .GT. 0).AND.(obsrec .GT. 0).AND.(exst) )
b9b1c4d04c Timo*0376      &  call ecco_readwei(fname3,localweight,
11c3150c71 Mart*0377      &                    localrec,Nr,nnzobs,dosumsq,myThid)
dfd90b6b5c Gael*0378 
e073e2c5c9 Gael*0379 c--     determine records and file names
                0380         exst=.FALSE.
                0381         call cost_gencal(localbarfile, localobsfile,
                0382      &     irec, localstartdate, localperiod, fname1,
f8e779c983 antn*0383      &     fname2, localrec, obsrec, exst, myThid )
e073e2c5c9 Gael*0384 
                0385 c--     load model average and observed average
11c3150c71 Mart*0386         call ecco_zero(localbar,Nr,zeroRL,myThid)
                0387         call cost_genread( fname1, localbar, localtmp, irec, Nr, nnzbar,
f8e779c983 antn*0388      &       nrecloc, preproc, preproc_c, preproc_i, preproc_r,
                0389      &       dummy, myThid )
11c3150c71 Mart*0390         call ecco_mult(localbar,fac,Nr,nnzbar,myThid)
e073e2c5c9 Gael*0391 
11c3150c71 Mart*0392         call ecco_zero(localobs,Nr,spzeroloc,myThid)
                0393         if ( (localrec .GT. 0).AND.(obsrec .GT. 0).AND.(exst) ) then
                0394          CALL READ_REC_LEV_RL( fname2, cost_iprec, Nr, 1, nnzobs,
f8e779c983 antn*0395      &                         localobs, localrec, 1, myThid )
11c3150c71 Mart*0396         endif
e073e2c5c9 Gael*0397 
474bc369aa Gael*0398 c--     Compute masked model-data difference
11c3150c71 Mart*0399         call ecco_diffmsk( localbar, localobs, localmask,
                0400      &     Nr, nnzobs, spminloc, spmaxloc, spzeroloc,
e073e2c5c9 Gael*0401      &     localdif, difmask, myThid )
                0402 
11c3150c71 Mart*0403         if ( domaskmindepth ) call ecco_maskmindepth(
2b959ba38e Mart*0404      &       difmask, Nr, nnzobs, topomin, myThid )
11c3150c71 Mart*0405 
                0406         if ( doanom ) call ecco_subtract( localdif,
                0407      &       localdifmeanIn, Nr, nnzobs, myThid )
e073e2c5c9 Gael*0408 
11c3150c71 Mart*0409         if ( domean.OR.doanom ) call ecco_addmask(
                0410      &       localdif, difmask, localdifsum,
                0411      &       localdifnum, Nr, nnzobs, myThid )
e073e2c5c9 Gael*0412 
474bc369aa Gael*0413         if (addVariaCost) then
e073e2c5c9 Gael*0414 
                0415 #ifdef ALLOW_SMOOTH
11c3150c71 Mart*0416          IF ( useSMOOTH.AND.dosmooth.AND.
                0417      &     (nnzbar.EQ.1).AND.(nnzobs.EQ.1) ) THEN
                0418           DO bj = myByLo(myThid), myByHi(myThid)
                0419            DO bi = myBxLo(myThid), myBxHi(myThid)
                0420             DO j = 1-OLy,sNy+OLy
                0421              DO i = 1-OLx,sNx+OLx
                0422               tmpFld2D(i,j,bi,bj) = localdif(i,j,1,bi,bj)
                0423              ENDDO
                0424             ENDDO
                0425            ENDDO
                0426           ENDDO
                0427           CALL SMOOTH_HETERO2D(tmpFld2D,mask2D,
                0428      &         posproc_c(k2smooth),posproc_i(k2smooth),myThid)
                0429           DO bj = myByLo(myThid), myByHi(myThid)
                0430            DO bi = myBxLo(myThid), myBxHi(myThid)
                0431             DO j = 1-OLy,sNy+OLy
                0432              DO i = 1-OLx,sNx+OLx
                0433               localdif(i,j,1,bi,bj) = tmpFld2D(i,j,bi,bj)
                0434              ENDDO
                0435             ENDDO
                0436            ENDDO
                0437           ENDDO
                0438          ENDIF
e073e2c5c9 Gael*0439 #endif
                0440 
                0441 c--     Compute normalized model-obs cost function
11c3150c71 Mart*0442          call ecco_addcost(
                0443      I             localdif, localweight, difmask, Nr, nnzobs, dosumsq,
13e29837cc An T*0444      U             objf_local, num_local,
                0445      I             myThid
                0446      &             )
e073e2c5c9 Gael*0447 c--     output model-data difference to disk
11c3150c71 Mart*0448          if ( outlev.GT.0 ) then
e073e2c5c9 Gael*0449           il=ilnblnk(outname)
                0450           write(fname3(1:128),'(2a)') 'misfit_', outname(1:il)
                0451           if ( nnzobs.EQ.1 ) CALL
f8e779c983 antn*0452      &    WRITE_REC_XY_RL( fname3, localdif,irec, eccoiter, myThid )
2b959ba38e Mart*0453           if ( nnzobs.EQ.Nr ) CALL
f8e779c983 antn*0454      &    WRITE_REC_XYZ_RL( fname3, localdif,irec, eccoiter, myThid )
11c3150c71 Mart*0455          endif
dfd90b6b5c Gael*0456 
85c224e862 Ou W*0457          if ( outlev.GT.1 ) then
                0458           if ( dovarwei ) then
                0459            il=ilnblnk(outname)
                0460            write(fname3(1:128),'(2a)') 'weight_', outname(1:il)
                0461            if ( nnzobs.EQ.1 ) CALL WRITE_REC_XY_RL( fname3,
                0462      &                           localweight, irec, eccoiter, myThid )
                0463            if ( nnzobs.EQ.Nr ) CALL WRITE_REC_XYZ_RL( fname3,
                0464      &                           localweight, irec, eccoiter, myThid )
                0465           endif
                0466          endif
0bcf80b5e9 Gael*0467         endif
ac486aa51f Gael*0468 
474bc369aa Gael*0469       enddo
                0470 c--   End of loop over obsfile records.
cf4693a22f Patr*0471 
1b2ca1f822 Gael*0472       call ecco_zero(localdifmeanOut,Nr,zeroRL,myThid)
11c3150c71 Mart*0473       call ecco_cp      (localdifsum,localdifmeanOut,Nr,nnzobs,myThid)
                0474       call ecco_divfield(localdifmeanOut,localdifnum,Nr,nnzobs,myThid)
                0475       call ecco_cp      (localdifnum,localdifmsk,Nr,nnzobs,myThid)
                0476       call ecco_divfield(localdifmsk,localdifnum,Nr,nnzobs,myThid)
                0477 
                0478       if (dooffset) then
                0479        il=ilnblnk(localbarfile)
                0480        call ecco_offset(
                0481      I      localbarfile(1:il),
                0482      U      localdifmeanOut,
                0483      I      localdifmsk,Nr,nnzobs,myThid)
                0484       endif
e7d9258ace Gael*0485 
0bcf80b5e9 Gael*0486       if ( domean ) then
9eaee0f935 Gael*0487 c--     Compute normalized model-obs cost function
f586fdfa8f Gael*0488         call ecco_addcost(
11c3150c71 Mart*0489      I                    localdifmeanOut, localweight, localdifmsk,
                0490      I                    Nr, nnzobs, dosumsq,
                0491      U                    objf_local, num_local,
                0492      I                    myThid )
9eaee0f935 Gael*0493 
ac486aa51f Gael*0494 c--     output model-data difference to disk
                0495         if ( outlev.GT.0 ) then
                0496           il=ilnblnk(outname)
                0497           write(fname3(1:128),'(2a)') 'misfit_', outname(1:il)
                0498           if ( nnzobs.EQ.1 ) CALL
f8e779c983 antn*0499      &    WRITE_REC_XY_RL(fname3,localdifmeanOut,1,eccoiter,myThid)
2b959ba38e Mart*0500           if ( nnzobs.EQ.Nr ) CALL
f8e779c983 antn*0501      &    WRITE_REC_XYZ_RL(fname3,localdifmeanOut,1,eccoiter,myThid)
ac486aa51f Gael*0502         endif
474bc369aa Gael*0503       endif
aa7751ee3b Gael*0504       if ( outlev.GT.1 ) then
85c224e862 Ou W*0505        if ( .NOT.dovarwei ) then
aa7751ee3b Gael*0506           il=ilnblnk(outname)
                0507           write(fname3(1:128),'(2a)') 'weight_', outname(1:il)
                0508           if ( nnzobs.EQ.1 ) CALL
85c224e862 Ou W*0509      &    WRITE_REC_XY_RL( fname3, localweight, 1, eccoiter, myThid )
2b959ba38e Mart*0510           if ( nnzobs.EQ.Nr ) CALL
85c224e862 Ou W*0511      &    WRITE_REC_XYZ_RL( fname3, localweight, 1, eccoiter, myThid )
                0512        endif
aa7751ee3b Gael*0513       endif
cf4693a22f Patr*0514 
92d10a5666 Gael*0515 #endif /* ALLOW_ECCO */
                0516 
f8e779c983 antn*0517       RETURN
                0518       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!