Back to home page

MITgcm
 
 

    

File indexing completed on 2022-08-15 05:09:20 UTC

view on githubraw file Latest commit cf705a6c on 2022-08-14 22:40:32 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
6805a315c1 Gael*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
c9dc83bee0 Patr*0005 
f8e779c983 antn*0006       subroutine ecco_cost_weights( myThid )
5001c65f45 Patr*0007 
                0008 c     ==================================================================
                0009 c     SUBROUTINE ecco_cost_weights
                0010 c     ==================================================================
                0011 c
                0012 c     o Read the weights used for the cost function evaluation.
                0013 c
                0014 c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
                0015 c
                0016 c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
                0017 c
                0018 c              - Restructured the code in order to create a package
                0019 c                for the MITgcmUV.
                0020 c
                0021 c              Christian Eckert eckert@mit.edu 02-May-2000
                0022 c
                0023 c              - corrected typo in mdsreadfield( sflux_errfile );
                0024 c                wp --> wsflux. Spotted by Patrick Heimbach.
                0025 c
                0026 c     ==================================================================
                0027 c     SUBROUTINE ecco_cost_weights
                0028 c     ==================================================================
                0029 
                0030       implicit none
                0031 
                0032 c     == global variables ==
                0033 
                0034 #include "EEPARAMS.h"
                0035 #include "SIZE.h"
                0036 #include "PARAMS.h"
                0037 #include "GRID.h"
cf705a6c8e Mart*0038 #include "ECCO_SIZE.h"
                0039 #include "ECCO.h"
c509d7e04a Gael*0040 #ifdef ALLOW_CTRL
                0041 # include "CTRL_OBCS.h"
                0042 #endif
5001c65f45 Patr*0043 
                0044 c     == routine arguments ==
                0045 
f8e779c983 antn*0046       integer  myThid
5001c65f45 Patr*0047 
                0048 c     == local variables ==
                0049 
cf705a6c8e Mart*0050 #ifdef ALLOW_OBCS
11c3150c71 Mart*0051       integer k
                0052       integer gwUnit
                0053       integer ilo,ihi
                0054       integer iobcs
                0055       _RL ratio
5001c65f45 Patr*0056       _RL wti(nr)
                0057       _RL wsi(nr)
c9dc83bee0 Patr*0058       _RL wui(nr)
5001c65f45 Patr*0059       _RL wvi(nr)
11c3150c71 Mart*0060       _RL dummy
984d1519c6 Gael*0061       logical  exst
11c3150c71 Mart*0062 #endif
984d1519c6 Gael*0063 
5001c65f45 Patr*0064 c     == external ==
                0065 
                0066       integer  ifnblnk
                0067       external ifnblnk
                0068       integer  ilnblnk
                0069       external ilnblnk
                0070 
                0071 c     == end of interface ==
                0072 
                0073 c--   Initialize variance (weight) fields.
cf705a6c8e Mart*0074 #ifdef ALLOW_OBCS
5001c65f45 Patr*0075       do k = 1,nr
                0076          wti(k) = 0. _d 0
                0077          wsi(k) = 0. _d 0
c9dc83bee0 Patr*0078          wui(k) = 0. _d 0
5001c65f45 Patr*0079          wvi(k) = 0. _d 0
                0080       enddo
c509d7e04a Gael*0081 
5001c65f45 Patr*0082 #if (defined (ALLOW_OBCS_COST_CONTRIBUTION) || \
                0083      defined (ALLOW_OBCS_CONTROL))
                0084       do iobcs = 1,nobcs
                0085         do k = 1,Nr
                0086 #if (defined (ALLOW_OBCSN_CONTROL) || \
                0087      defined (ALLOW_OBCSN_COST_CONTRIBUTION))
                0088           wobcsn(k,iobcs) = 0. _d 0
                0089 #endif
                0090 #if (defined (ALLOW_OBCSS_CONTROL) || \
                0091      defined (ALLOW_OBCSS_COST_CONTRIBUTION))
                0092           wobcss(k,iobcs) = 0. _d 0
                0093 #endif
                0094 #if (defined (ALLOW_OBCSW_CONTROL) || \
                0095      defined (ALLOW_OBCSW_COST_CONTRIBUTION))
                0096           wobcsw(k,iobcs) = 0. _d 0
                0097 #endif
                0098 #if (defined (ALLOW_OBCSE_CONTROL) || \
                0099      defined (ALLOW_OBCSE_COST_CONTRIBUTION))
                0100           wobcse(k,iobcs) = 0. _d 0
                0101 #endif
                0102         enddo
                0103       enddo
                0104 #endif
                0105 
                0106 c--   Read error information and set up weight matrices.
                0107       _BEGIN_MASTER(myThid)
a4b400075a Jean*0108       ilo = ifnblnk(data_errfile)
                0109       ihi = ilnblnk(data_errfile)
984d1519c6 Gael*0110 
a4b400075a Jean*0111       inquire( file=data_errfile, exist=exst )
                0112       if (exst) then
d7ee8fe52e Patr*0113         CALL OPEN_COPY_DATA_FILE(
951926fb9b Jean*0114      I                          data_errfile(ilo:ihi),
d7ee8fe52e Patr*0115      I                          'ECCO_COST_WEIGHTS',
a4b400075a Jean*0116      O                          gwUnit,
d7ee8fe52e Patr*0117      I                          myThid )
                0118 
a4b400075a Jean*0119         read(gwUnit,*) ratio
5d140c9cdd Patr*0120 #if (defined (ALLOW_OBCS_COST_CONTRIBUTION) || defined (ALLOW_OBCS_CONTROL))
6b47d550f4 Mart*0121      &       , dummy
5001c65f45 Patr*0122 #endif
                0123         do k = 1,nr
a4b400075a Jean*0124           read(gwUnit,*) wti(k), wsi(k)
5d140c9cdd Patr*0125 #if (defined (ALLOW_OBCS_COST_CONTRIBUTION) || defined (ALLOW_OBCS_CONTROL))
5001c65f45 Patr*0126      &               , wvi(k)
                0127 #endif
                0128         end do
a4b400075a Jean*0129 #ifdef SINGLE_DISK_IO
                0130         CLOSE(gwUnit)
                0131 #else
                0132         CLOSE(gwUnit,STATUS='DELETE')
                0133 #endif /* SINGLE_DISK_IO */
                0134       endif
5001c65f45 Patr*0135 
                0136       _END_MASTER(myThid)
                0137 
                0138       _BARRIER
                0139 
11c3150c71 Mart*0140       do k = 1,nr
                0141 # ifdef ALLOW_OBCSN_COST_CONTRIBUTION
                0142        wobcsn(k,1) = wti(k)
                0143        wobcsn(k,2) = wsi(k)
                0144        wobcsn(k,3) = wvi(k)
                0145        wobcsn(k,4) = wvi(k)
                0146 # endif
                0147 # ifdef ALLOW_OBCSS_COST_CONTRIBUTION
                0148        wobcss(k,1) = wti(k)
                0149        wobcss(k,2) = wsi(k)
                0150        wobcss(k,3) = wvi(k)
                0151        wobcss(k,4) = wvi(k)
                0152 # endif
                0153 # ifdef ALLOW_OBCSW_COST_CONTRIBUTION
                0154        wobcsw(k,1) = wti(k)
                0155        wobcsw(k,2) = wsi(k)
                0156        wobcsw(k,3) = wvi(k)
                0157        wobcsw(k,4) = wvi(k)
                0158 # endif
                0159 # ifdef ALLOW_OBCSE_COST_CONTRIBUTION
                0160        wobcse(k,1) = wti(k)
                0161        wobcse(k,2) = wsi(k)
                0162        wobcse(k,3) = wvi(k)
                0163        wobcse(k,4) = wvi(k)
                0164 # endif
                0165       enddo
cf705a6c8e Mart*0166 
11c3150c71 Mart*0167 # ifdef ALLOW_OBCS_COST_CONTRIBUTION
                0168       do iobcs = 1,nobcs
                0169        do k = 1,nr
                0170 #  ifdef ALLOW_OBCSN_COST_CONTRIBUTION
                0171         if (wobcsn(k,iobcs) .ne. 0.) then
                0172          wobcsn(k,iobcs) =
                0173      &        ratio/wobcsn(k,iobcs)/wobcsn(k,iobcs)
                0174         else
                0175          wobcsn(k,iobcs) = 0.0 _d 0
                0176         endif
                0177 #  endif
                0178 #  ifdef ALLOW_OBCSS_COST_CONTRIBUTION
                0179         if (wobcss(k,iobcs) .ne. 0.) then
                0180          wobcss(k,iobcs) =
                0181      &        ratio/wobcss(k,iobcs)/wobcss(k,iobcs)
                0182         else
                0183          wobcss(k,iobcs) = 0.0 _d 0
                0184         endif
                0185 #  endif
                0186 #  ifdef ALLOW_OBCSW_COST_CONTRIBUTION
                0187         if (wobcsw(k,iobcs) .ne. 0.) then
                0188          wobcsw(k,iobcs) =
                0189      &        ratio/wobcsw(k,iobcs)/wobcsw(k,iobcs)
                0190         else
                0191          wobcsw(k,iobcs) = 0.0 _d 0
                0192         endif
                0193 #  endif
                0194 #  ifdef ALLOW_OBCSE_COST_CONTRIBUTION
                0195         if (wobcse(k,iobcs) .ne. 0.) then
                0196          wobcse(k,iobcs) =
                0197      &        ratio/wobcse(k,iobcs)/wobcse(k,iobcs)
                0198         else
                0199          wobcse(k,iobcs) = 0.0 _d 0
                0200         endif
                0201 #  endif
                0202        enddo
5001c65f45 Patr*0203       enddo
11c3150c71 Mart*0204 # endif /* ALLOW_OBCS_COST_CONTRIBUTION */
cf705a6c8e Mart*0205 #endif /* ALLOW_OBCS */
b0f9ab3790 Gael*0206 
335c43b7c9 Jean*0207       RETURN
                0208       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!