/[MITgcm]/MITgcm/pkg/seaice/seaice_cost_weights.F
ViewVC logotype

Annotation of /MITgcm/pkg/seaice/seaice_cost_weights.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (hide annotations) (download)
Thu Sep 1 14:35:22 2005 UTC (18 years, 8 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint58e_post, checkpoint57v_post, checkpoint58u_post, checkpoint58w_post, checkpoint57s_post, checkpoint58r_post, checkpoint57y_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58q_post, checkpoint58j_post, checkpoint59d, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint57x_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post
Changes since 1.2: +3 -3 lines
Adding some nice ifdef's

1 heimbach 1.3 C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_cost_weights.F,v 1.2 2005/09/01 14:23:45 heimbach Exp $
2 heimbach 1.1
3     #include "SEAICE_OPTIONS.h"
4    
5     subroutine seaice_cost_weights( mythid )
6    
7     c ==================================================================
8     c SUBROUTINE seaice_cost_weights
9     c ==================================================================
10     c
11     c ==================================================================
12     c SUBROUTINE seaice_cost_weights
13     c ==================================================================
14    
15     implicit none
16    
17     c == global variables ==
18    
19     #include "EEPARAMS.h"
20     #include "SIZE.h"
21     #include "PARAMS.h"
22     #include "GRID.h"
23    
24     #ifdef ALLOW_COST
25 heimbach 1.3 # include "ctrl.h"
26     # include "ecco_cost.h"
27 heimbach 1.1 # include "SEAICE_COST.h"
28     #endif
29    
30     c == routine arguments ==
31    
32     integer mythid
33    
34 heimbach 1.2 #ifdef ALLOW_COST
35 heimbach 1.1 c == local variables ==
36    
37     integer bi,bj
38     integer i,j,k
39     integer itlo,ithi
40     integer jtlo,jthi
41     integer jmin,jmax
42     integer imin,imax
43     integer gwunit
44     integer irec,nnz
45     integer ilo,ihi
46    
47     _RL dummy
48    
49     c == external ==
50    
51     integer ifnblnk
52     external ifnblnk
53     integer ilnblnk
54     external ilnblnk
55    
56     c == end of interface ==
57    
58     jtlo = mybylo(mythid)
59     jthi = mybyhi(mythid)
60     itlo = mybxlo(mythid)
61     ithi = mybxhi(mythid)
62     jmin = 1-oly
63     jmax = sny+oly
64     imin = 1-olx
65     imax = snx+olx
66    
67     c-- Define frame.
68     do j = jmin,jmax
69     do i = imin,imax
70     c-- North/South and West/East edges set to zero.
71     if ( (j .lt. 1) .or. (j .gt. sny) .or.
72     & (i .lt. 1) .or. (i .gt. snx) ) then
73     frame(i,j) = 0. _d 0
74     else
75     frame(i,j) = 1. _d 0
76     endif
77     enddo
78     enddo
79    
80     #ifdef ALLOW_SEAICE_COST_SMR_AREA
81 heimbach 1.2
82     do bj = jtlo,jthi
83     do bi = itlo,ithi
84     do j = jmin,jmax
85     do i = imin,imax
86     wsmrarea (i,j,bi,bj) = 0. _d 0
87     enddo
88     enddo
89     enddo
90     enddo
91 heimbach 1.1 c--
92     nnz = 1
93     irec = 1
94     k = 1
95     if ( smrarea_errfile .NE. ' ' ) then
96     call mdsreadfield( smrarea_errfile, cost_iprec, cost_yftype,
97     & nnz, wsmrarea, irec, mythid )
98     do bj = jtlo,jthi
99     do bi = itlo,ithi
100     do j = jmin,jmax
101     do i = imin,imax
102     wsmrarea(i,j,bi,bj) = wsmrarea(i,j,bi,bj)
103     & *frame(i,j)*_hFacC(i,j,k,bi,bj)
104     enddo
105     enddo
106     enddo
107     enddo
108     else
109     do bj = jtlo,jthi
110     do bi = itlo,ithi
111     do j = jmin,jmax
112     do i = imin,imax
113     wsmrarea(i,j,bi,bj) = wsmrarea0
114     & *frame(i,j)*_hFacC(i,j,k,bi,bj)
115     enddo
116     enddo
117     enddo
118     enddo
119     endif
120     c--
121     do bj = jtlo,jthi
122     do bi = itlo,ithi
123     do j = jmin,jmax
124     do i = imin,imax
125     if (wsmrarea(i,j,bi,bj) .ne. 0.)
126     & wsmrarea(i,j,bi,bj) =
127     & 1./wsmrarea(i,j,bi,bj)/wsmrarea(i,j,bi,bj)
128     enddo
129     enddo
130     enddo
131     enddo
132     #endif /* ALLOW_SEAICE_COST_SMR_AREA */
133    
134 heimbach 1.2 #endif
135    
136 heimbach 1.1 end

  ViewVC Help
Powered by ViewVC 1.1.22