/[MITgcm]/MITgcm_contrib/gael/pkg/smooth2/smooth_correl2Dw.F
ViewVC logotype

Annotation of /MITgcm_contrib/gael/pkg/smooth2/smooth_correl2Dw.F

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


Revision 1.1 - (hide annotations) (download)
Sun Oct 25 21:24:03 2009 UTC (15 years, 8 months ago) by gforget
Branch: MAIN
CVS Tags: HEAD
Renovated pkg/smooth. Ready for MITgcm/pkg check in?

1 gforget 1.1 C $Header: /u/gcmpack/MITgcm_contrib/gael/pkg/smooth2/smooth_correl2Dw.F,v 1.1 2009/10/24 23:27:24 gforget Exp $
2     C $Name: $
3    
4     #include "CPP_OPTIONS.h"
5    
6     subroutine smooth_correl2Dw (
7     U fld_in,mask_in,xx_gen_file,mythid)
8    
9     C *==========================================================*
10     C | SUBROUTINE smooth_correl2Dw
11     C | o Routine that maps a 2D control field to physical units
12     C | by mutliplying it with 1/sqrt(weight)
13     C | after smooth_correl2D has been applied
14     C *==========================================================*
15    
16     IMPLICIT NONE
17     #include "SIZE.h"
18     #include "EEPARAMS.h"
19     #include "GRID.h"
20     #include "PARAMS.h"
21     c#include "tamc.h"
22     #include "smooth.h"
23     #include "ctrl.h"
24     #include "ecco_cost.h"
25    
26     _RL mask_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR,nSx,nSy)
27     _RL fld_in(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
28     _RL tmpW
29     character*(MAX_LEN_FNAM) xx_gen_file
30    
31     integer i,j,bi,bj
32     integer itlo,ithi
33     integer jtlo,jthi
34     integer myThid
35    
36    
37     jtlo = mybylo(mythid)
38     jthi = mybyhi(mythid)
39     itlo = mybxlo(mythid)
40     ithi = mybxhi(mythid)
41    
42    
43     DO bj = jtlo,jthi
44     DO bi = itlo,ithi
45     DO j = 1,sNy
46     DO i = 1,sNx
47     if ( xx_gen_file .EQ. xx_hflux_file ) then
48     tmpW=whflux(i,j,bi,bj)
49     elseif ( xx_gen_file .EQ. xx_sflux_file ) then
50     tmpW=wsflux(i,j,bi,bj)
51     elseif ( xx_gen_file .EQ. xx_tauu_file ) then
52     tmpW=wtauu(i,j,bi,bj)
53     elseif ( xx_gen_file .EQ. xx_tauv_file ) then
54     tmpW=wtauv(i,j,bi,bj)
55    
56     elseif ( xx_gen_file .EQ. xx_atemp_file ) then
57     tmpW=watemp(i,j,bi,bj)
58     elseif ( xx_gen_file .EQ. xx_aqh_file ) then
59     tmpW=waqh(i,j,bi,bj)
60     elseif ( xx_gen_file .EQ. xx_precip_file ) then
61     tmpW=wprecip(i,j,bi,bj)
62     elseif ( xx_gen_file .EQ. xx_snowprecip_file ) then
63     tmpW=wsnowprecip(i,j,bi,bj)
64    
65     elseif ( xx_gen_file .EQ. xx_swflux_file ) then
66     tmpW=wswflux(i,j,bi,bj)
67     elseif ( xx_gen_file .EQ. xx_swdown_file ) then
68     tmpW=wswdown(i,j,bi,bj)
69     elseif ( xx_gen_file .EQ. xx_lwflux_file ) then
70     tmpW=wlwflux(i,j,bi,bj)
71     elseif ( xx_gen_file .EQ. xx_lwdown_file ) then
72     tmpW=wlwdown(i,j,bi,bj)
73    
74     elseif ( xx_gen_file .EQ. xx_evap_file ) then
75     tmpW=wevap(i,j,bi,bj)
76     elseif ( xx_gen_file .EQ. xx_apressure_file ) then
77     tmpW=wapressure(i,j,bi,bj)
78     elseif ( xx_gen_file .EQ. xx_uwind_file ) then
79     tmpW=wuwind(i,j,bi,bj)
80     elseif ( xx_gen_file .EQ. xx_vwind_file ) then
81     tmpW=wvwind(i,j,bi,bj)
82    
83     else
84     tmpW=0.
85     WRITE(errorMessageUnit,'(2A)' )
86     & 'no weights implemented here for ',xx_gen_file
87     STOP 'ABNORMAL END: S/R smooth_correl2Dw'
88     endif
89    
90     if ((mask_in(i,j,1,bi,bj).NE.0.).AND.(tmpW.NE.0.)) then
91     fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)/sqrt(tmpW)
92     else
93     fld_in(i,j,bi,bj)=fld_in(i,j,bi,bj)*0.
94     endif
95    
96     ENDDO
97     ENDDO
98     ENDDO
99     ENDDO
100    
101     _EXCH_XY_RL ( fld_in , myThid )
102    
103     end

  ViewVC Help
Powered by ViewVC 1.1.22