pkg/obcs/obcs_cost_weights.F

69361556c2 Mart*0001 #include "OBCS_OPTIONS.h"
                0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
                0005
                0006       SUBROUTINE OBCS_COST_WEIGHTS( myThid )
                0007
                0008 c     ==================================================================
                0009 c     SUBROUTINE OBCS_COST_WEIGHTS
                0010 c     ==================================================================
                0011 c
                0012 c     o Read the weights used for the obcs cost function evaluation.
                0013 C       based on obsolete pkg/ecco/ecco_cost_weights.F
                0014 c
                0015 c     ==================================================================
                0016 c     SUBROUTINE OBCS_COST_WEIGHTS
                0017 c     ==================================================================
                0018
                0019       IMPLICIT NONE
                0020
                0021 c     == global variables ==
                0022 #include "EEPARAMS.h"
                0023 #include "SIZE.h"
                0024 #ifdef ALLOW_CTRL
                0025 # include "CTRL_OBCS.h"
                0026 #endif
                0027
                0028 c     == routine arguments ==
                0029       INTEGER  myThid
                0030
                0031 #ifdef ALLOW_OBCS_CONTROL
                0032 c     == external ==
                0033       INTEGER  IFNBLNK
                0034       EXTERNAL IFNBLNK
                0035       INTEGER  ILNBLNK
                0036       EXTERNAL ILNBLNK
                0037
                0038 c     == local variables ==
                0039       INTEGER k
                0040       INTEGER gwUnit
                0041       INTEGER ilo,ihi
                0042       INTEGER iobcs
                0043       _RL ratio
                0044       _RL weights(Nr,4)
                0045       _RL dummy
                0046       logical  exst
                0047
                0048 c     == end of interface ==
                0049
                0050 c--   Initialize variance (weight) fields.
                0051       DO iobcs = 1, nobcs
                0052        DO k = 1, Nr
                0053         weights(k,iobcs)= 0. _d 0
                0054 CML#ifdef ALLOW_OBCSN_CONTROL
                0055 CML        wobcsN(k,iobcs) = 0. _d 0
                0056 CML#endif
                0057 CML#ifdef ALLOW_OBCSS_CONTROL
                0058 CML        wobcsS(k,iobcs) = 0. _d 0
                0059 CML#endif
                0060 CML#ifdef ALLOW_OBCSE_CONTROL
                0061 CML        wobcsE(k,iobcs) = 0. _d 0
                0062 CML#endif
                0063 CML#ifdef ALLOW_OBCSW_CONTROL
                0064 CML        wobcsW(k,iobcs) = 0. _d 0
                0065 CML#endif
                0066        ENDDO
                0067       ENDDO
                0068
                0069 c--   Read error information and set up weight matrices.
                0070       _BEGIN_MASTER(myThid)
                0071       ilo = IFNBLNK(obcs_data_errfile)
                0072       ihi = ILNBLNK(obcs_data_errfile)
                0073
                0074       INQUIRE( file=obcs_data_errfile, exist=exst )
                0075       IF (exst) THEN
                0076         CALL OPEN_COPY_DATA_FILE(
                0077      I                          obcs_data_errfile(ilo:ihi),
                0078      I                          'OBCS_COST_WEIGHTS',
                0079      O                          gwUnit,
                0080      I                          myThid )
                0081
                0082         READ(gwUnit,*) ratio, dummy
                0083         DO k = 1, Nr
                0084          READ(gwUnit,*) weights(k,1), weights(k,2), weights(k,3)
                0085          weights(k,4) = weights(k,3)
                0086         ENDDO
                0087 #ifdef SINGLE_DISK_IO
                0088         CLOSE(gwUnit)
                0089 #else
                0090         CLOSE(gwUnit,STATUS='DELETE')
                0091 #endif /* SINGLE_DISK_IO */
                0092       ENDIF
                0093
                0094       _END_MASTER(myThid)
                0095
                0096       _BARRIER
                0097
                0098       DO iobcs = 1,nobcs
                0099        DO k = 1, Nr
                0100 # ifdef ALLOW_OBCSN_CONTROL
                0101         wobcsN(k,iobcs) = weights(k,iobcs)
                0102         IF (wobcsN(k,iobcs) .NE. 0.) THEN
                0103          wobcsN(k,iobcs) =
                0104      &        ratio/wobcsN(k,iobcs)/wobcsN(k,iobcs)
                0105         ELSE
                0106          wobcsN(k,iobcs) = 0.0 _d 0
                0107         ENDIF
                0108 # endif
                0109 # ifdef ALLOW_OBCSS_CONTROL
                0110         wobcsS(k,iobcs) = weights(k,iobcs)
                0111         IF (wobcsS(k,iobcs) .NE. 0.) THEN
                0112          wobcsS(k,iobcs) =
                0113      &        ratio/wobcsS(k,iobcs)/wobcsS(k,iobcs)
                0114         ELSE
                0115          wobcsS(k,iobcs) = 0.0 _d 0
                0116         ENDIF
                0117 # endif
                0118 # ifdef ALLOW_OBCSE_CONTROL
                0119         wobcsE(k,iobcs) = weights(k,iobcs)
                0120         IF (wobcsE(k,iobcs) .NE. 0.) THEN
                0121          wobcsE(k,iobcs) =
                0122      &        ratio/wobcsE(k,iobcs)/wobcsE(k,iobcs)
                0123         ELSE
                0124          wobcsE(k,iobcs) = 0.0 _d 0
                0125         ENDIF
                0126 # endif
                0127 # ifdef ALLOW_OBCSW_CONTROL
                0128         wobcsW(k,iobcs) = weights(k,iobcs)
                0129         IF (wobcsW(k,iobcs) .NE. 0.) THEN
                0130          wobcsW(k,iobcs) =
                0131      &        ratio/wobcsW(k,iobcs)/wobcsW(k,iobcs)
                0132         ELSE
                0133          wobcsW(k,iobcs) = 0.0 _d 0
                0134         ENDIF
                0135 # endif
                0136        ENDDO
                0137       ENDDO
                0138
                0139 #endif /* ALLOW_OBCS_CONTROL */
                0140
                0141       RETURN
                0142       END