/[MITgcm]/MITgcm/pkg/smooth/smooth_correl2dw.F
ViewVC logotype

Contents of /MITgcm/pkg/smooth/smooth_correl2dw.F

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


Revision 1.8 - (show annotations) (download)
Wed Mar 27 15:40:35 2013 UTC (11 years, 1 month ago) by gforget
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64g, checkpoint64f, checkpoint65, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65d, checkpoint65e
Changes since 1.7: +17 -18 lines
- avoid recomputation.

1 C $Header: /u/gcmpack/MITgcm/pkg/smooth/smooth_correl2dw.F,v 1.7 2013/02/05 21:45:32 gforget Exp $
2 C $Name: $
3
4 #include "SMOOTH_OPTIONS.h"
5 #ifdef ALLOW_CTRL
6 # include "CTRL_OPTIONS.h"
7 #endif
8
9 subroutine smooth_correl2Dw (
10 U fld_in,mask_in,xx_gen_file,mythid)
11
12 C *==========================================================*
13 C | SUBROUTINE smooth_correl2Dw
14 C | o Routine that maps a 2D control field to physical units
15 C | by mutliplying it with 1/sqrt(weight)
16 C | after smooth_correl2D has been applied
17 C *==========================================================*
18
19 IMPLICIT NONE
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "GRID.h"
23 #include "PARAMS.h"
24 #include "SMOOTH.h"
25 #ifdef ALLOW_CTRL
26 # include "ctrl.h"
27 # include "CTRL_SIZE.h"
28 # include "CTRL_GENARR.h"
29 #endif
30 #ifdef ALLOW_ECCO
31 # include "ecco_cost.h"
32 #endif
33
34 _RL mask_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR,nSx,nSy)
35 _RL fld_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
36 character*(MAX_LEN_FNAM) xx_gen_file
37 integer myThid
38
39 # if (defined ALLOW_CTRL) || (defined ALLOW_ECCO)
40
41 integer i,j,bi,bj
42 integer itlo,ithi
43 integer jtlo,jthi
44 _RL tmpW
45 LOGICAL weightWasFound
46 #if (defined (ALLOW_GENARR2D_CONTROL) || defined (ALLOW_GENARR3D_CONTROL) || defined (ALLOW_GENTIM2D_CONTROL))
47 INTEGER iarr
48 #endif
49
50 jtlo = mybylo(mythid)
51 jthi = mybyhi(mythid)
52 itlo = mybxlo(mythid)
53 ithi = mybxhi(mythid)
54
55
56 DO bj = jtlo,jthi
57 DO bi = itlo,ithi
58 DO j = 1,sNy
59 DO i = 1,sNx
60
61 weightWasFound=.TRUE.
62
63 if ( xx_gen_file .EQ. xx_hflux_file ) then
64 tmpW=whflux(i,j,bi,bj)
65 elseif ( xx_gen_file .EQ. xx_sflux_file ) then
66 tmpW=wsflux(i,j,bi,bj)
67 elseif ( xx_gen_file .EQ. xx_tauu_file ) then
68 tmpW=wtauu(i,j,bi,bj)
69 elseif ( xx_gen_file .EQ. xx_tauv_file ) then
70 tmpW=wtauv(i,j,bi,bj)
71
72 elseif ( xx_gen_file .EQ. xx_atemp_file ) then
73 tmpW=watemp(i,j,bi,bj)
74 elseif ( xx_gen_file .EQ. xx_aqh_file ) then
75 tmpW=waqh(i,j,bi,bj)
76 elseif ( xx_gen_file .EQ. xx_precip_file ) then
77 tmpW=wprecip(i,j,bi,bj)
78 elseif ( xx_gen_file .EQ. xx_snowprecip_file ) then
79 tmpW=wsnowprecip(i,j,bi,bj)
80
81 elseif ( xx_gen_file .EQ. xx_swflux_file ) then
82 tmpW=wswflux(i,j,bi,bj)
83 elseif ( xx_gen_file .EQ. xx_swdown_file ) then
84 tmpW=wswdown(i,j,bi,bj)
85 elseif ( xx_gen_file .EQ. xx_lwflux_file ) then
86 tmpW=wlwflux(i,j,bi,bj)
87 elseif ( xx_gen_file .EQ. xx_lwdown_file ) then
88 tmpW=wlwdown(i,j,bi,bj)
89
90 elseif ( xx_gen_file .EQ. xx_evap_file ) then
91 tmpW=wevap(i,j,bi,bj)
92 elseif ( xx_gen_file .EQ. xx_apressure_file ) then
93 tmpW=wapressure(i,j,bi,bj)
94 elseif ( xx_gen_file .EQ. xx_uwind_file ) then
95 tmpW=wuwind(i,j,bi,bj)
96 elseif ( xx_gen_file .EQ. xx_vwind_file ) then
97 tmpW=wvwind(i,j,bi,bj)
98
99 else
100 tmpW=0.
101 weightWasFound=.FALSE.
102 endif
103
104 #ifdef ALLOW_CTRL
105 #ifdef ALLOW_GENTIM2D_CONTROL
106 do iarr = 1, maxCtrlTim2D
107 if ( xx_gen_file .EQ. xx_gentim2d_file(iarr) ) then
108 tmpW=wgentim2d(i,j,bi,bj,iarr)
109 weightWasFound=.TRUE.
110 endif
111 enddo
112 #endif
113 #endif
114
115 if ((mask_in(i,j,1,bi,bj).NE.0.).AND.(tmpW.NE.0.)) then
116 fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)/sqrt(tmpW)
117 else
118 fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)*0.
119 endif
120
121 ENDDO
122 ENDDO
123 ENDDO
124 ENDDO
125
126 _EXCH_XY_RL ( fld_in , myThid )
127
128 if (.NOT.weightWasFound) WRITE(errorMessageUnit,'(2A)' )
129 & 'WARNING: no weights found for ',xx_gen_file
130
131 #endif /* ALLOW_ECCO or ALLOW_CTRL */
132
133 end

  ViewVC Help
Powered by ViewVC 1.1.22