/[MITgcm]/MITgcm_contrib/plumes/CtoA.F
ViewVC logotype

Annotation of /MITgcm_contrib/plumes/CtoA.F

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


Revision 1.1 - (hide annotations) (download)
Thu May 13 22:21:45 2004 UTC (19 years, 11 months ago) by molod
Branch: MAIN
CVS Tags: HEAD
More developing....

1 molod 1.1 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/CtoA.F,v 1.3 2004/05/05 00:39:21 edhill Exp $
2     C $Name: $
3    
4     subroutine CtoA(myThid,fieldin1,fieldin2,mask1,mask2,im1,im2,jm1,
5     . jm2,numlevs,Nsx,Nsy,idim1,idim2,jdim1,jdim2,fieldout1,fieldout2)
6     c----------------------------------------------------------------------
7     c Subroutine CtoA - Routine to map a velocity component quantity
8     c from the C-Grid to the A-Grid.
9     c This includes doing an exchange to fill the halo region, and
10     c then a linear average with the appropriate topography mask.
11     c Also: Set up "bi, bj loop" here.
12     c
13     c Input: myThid
14     c fieldin1 Field on c-grid to move to a-grid (1st component)
15     c fieldin2 Field on c-grid to move to a-grid (2nd component)
16     c mask1 Topography [0,1] mask - 1 to indicate above ground
17     c mask2 Topography [0,1] mask - 1 to indicate above ground
18     c im1,im2,jm1,jm2 Indeces in x and y for computations
19     c numlevs Number of vertical levels
20     c Nsx, Nsy
21     c idim1,idim2,jdim1,jdim2 Span of fields in x and y
22     c
23     c Output: fieldout1 Field mapped to A-Grid (1st component)
24     c fieldout2 Field mapped to A-Grid (2nd component)
25     c
26     c Call: exchange on c-grid
27     c-----------------------------------------------------------------------
28     implicit none
29     #include "CPP_OPTIONS.h"
30     #include "EEPARAMS.h"
31    
32     integer myThid, numlevs
33     integer im1, im2, jm1, jm2, idim1, idim2, jdim1, jdim2
34     integer Nsx, Nsy
35     _RS mask1(im1:im2,jm1:jm2,numlevs,Nsx,Nsy)
36     _RS mask2(im1:im2,jm1:jm2,numlevs,Nsx,Nsy)
37     _RL fieldin1(im1:im2,jm1:jm2,numlevs,Nsx,Nsy)
38     _RL fieldin2(im1:im2,jm1:jm2,numlevs,Nsx,Nsy)
39     _RL fieldout1(im1:im2,jm1:jm2,numlevs,Nsx,Nsy)
40     _RL fieldout2(im1:im2,jm1:jm2,numlevs,Nsx,Nsy)
41    
42     integer i, j, L, bi, bj
43     logical withSigns
44     data withSigns/.TRUE./
45    
46     c Call the c-grid exchange routine to fill in the halo regions
47     call exch_uv_xyz_RL(fieldin1,fieldin2,withSigns,myThid)
48    
49     c Now take average
50     do bj = myByLo(myThid), myByHi(myThid)
51     do bi = myBxLo(myThid), myBxHi(myThid)
52    
53     do L = 1,numlevs
54     do j = jdim1,jdim2
55     do i = idim1,idim2
56     if( (mask1(i,j,L,bi,bj).ne.0.) .or.
57     . (mask1(i+1,j,L,bi,bj).ne.0.) ) then
58     fieldout1(i,j,L,bi,bj) =
59     . ( fieldin1(i,j,L,bi,bj)*mask1(i,j,L,bi,bj) +
60     . fieldin1(i+1,j,L,bi,bj)*mask1(i+1,j,L,bi,bj) ) /
61     . ( mask1(i,j,L,bi,bj) + mask1(i+1,j,L,bi,bj) )
62     else
63     fieldout1(i,j,L,bi,bj) = 0.
64     endif
65     if( (mask2(i,j,L,bi,bj).ne.0.) .or.
66     . (mask2(i,j+1,L,bi,bj).ne.0.) ) then
67     fieldout2(i,j,L,bi,bj) =
68     . ( fieldin2(i,j,L,bi,bj)*mask2(i,j,L,bi,bj) +
69     . fieldin2(i,j+1,L,bi,bj)*mask2(i,j+1,L,bi,bj) ) /
70     . ( mask2(i,j,L,bi,bj) + mask2(i,j+1,L,bi,bj) )
71     else
72     fieldout2(i,j,L,bi,bj) = 0.
73     endif
74     enddo
75     enddo
76     enddo
77    
78     enddo
79     enddo
80    
81     return
82     end

  ViewVC Help
Powered by ViewVC 1.1.22