Ticket #152: patch.wet

File patch.wet, 5.0 KB (added by kate, 17 years ago)

sample code

Line 
1Index: ROMS/Nonlinear/ini_fields.F
2===================================================================
3--- ROMS/Nonlinear/ini_fields.F (revision 611)
4+++ ROMS/Nonlinear/ini_fields.F (working copy)
5@@ -54,6 +54,11 @@
6 & GRID(ng) % umask, &
7 & GRID(ng) % vmask, &
8 # endif
9+# ifdef WET_DRY
10+ & GRID(ng) % rmask_wet, &
11+ & GRID(ng) % umask_wet, &
12+ & GRID(ng) % vmask_wet, &
13+# endif
14 # if defined PERFECT_RESTART && \
15 (defined EW_PERIODIC || defined NS_PERIODIC)
16 # ifdef SOLVE3D
17@@ -106,6 +111,9 @@
18 # ifdef MASKING
19 & rmask, umask, vmask, &
20 # endif
21+# ifdef WET_DRY
22+ & rmask_wet, umask_wet, vmask_wet, &
23+# endif
24 # if defined PERFECT_RESTART && \
25 (defined EW_PERIODIC || defined NS_PERIODIC)
26 # ifdef SOLVE3D
27@@ -139,6 +147,9 @@
28 # if defined SEDIMENT || defined BBL_MODEL
29 USE mod_sediment
30 # endif
31+# ifdef WET_DRY
32+ USE bc_2d_mod
33+# endif
34 !
35 # if defined EW_PERIODIC || defined NS_PERIODIC
36 USE exchange_2d_mod
37@@ -198,6 +209,11 @@
38 real(r8), intent(in) :: umask(LBi:,LBj:)
39 real(r8), intent(in) :: vmask(LBi:,LBj:)
40 # endif
41+# ifdef WET_DRY
42+ real(r8), intent(inout) :: rmask_wet(LBi:,LBj:)
43+ real(r8), intent(inout) :: umask_wet(LBi:,LBj:)
44+ real(r8), intent(inout) :: vmask_wet(LBi:,LBj:)
45+# endif
46 # ifdef SOLVE3D
47 # ifdef ICESHELF
48 real(r8), intent(in) :: zice(LBi:,LBj:)
49@@ -245,6 +261,11 @@
50 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
51 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
52 # endif
53+# ifdef WET_DRY
54+ real(r8), intent(inout) :: rmask_wet(LBi:UBi,LBj:UBj)
55+ real(r8), intent(inout) :: umask_wet(LBi:UBi,LBj:UBj)
56+ real(r8), intent(inout) :: vmask_wet(LBi:UBi,LBj:UBj)
57+# endif
58 # ifdef SOLVE3D
59 # ifdef ICESHELF
60 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
61@@ -300,10 +321,76 @@
62 real(r8), dimension(PRIVATE_1D_SCRATCH_ARRAY,0:N(ng)) :: CF
63 real(r8), dimension(PRIVATE_1D_SCRATCH_ARRAY,0:N(ng)) :: DC
64 # endif
65+# ifdef WET_DRY
66+ real(r8), dimension(PRIVATE_2D_SCRATCH_ARRAY) :: wetdry
67+# endif
68
69 # include "set_bounds.h"
70+# if defined WET_DRY
71 !
72 !-----------------------------------------------------------------------
73+! If wet/drying, compute new masks for cells with depth < Dcrit.
74+!-----------------------------------------------------------------------
75+!
76+ DO j=JstrV-1,Jend
77+ DO i=IstrU-1,Iend
78+ wetdry(i,j)=1.0_r8
79+ IF (zeta(i,j,kstp).le.(Dcrit(ng)-h(i,j))) THEN
80+ wetdry(i,j)=0.0_r8
81+ END IF
82+# ifdef MASKING
83+ wetdry(i,j)=wetdry(i,j)*rmask(i,j)
84+# endif
85+ END DO
86+ END DO
87+ DO j=Jstr,Jend
88+ DO i=Istr,Iend
89+ rmask_wet(i,j)=wetdry(i,j)
90+ END DO
91+ END DO
92+ DO j=Jstr,Jend
93+ DO i=IstrU,Iend
94+ umask_wet(i,j)=wetdry(i-1,j)+wetdry(i,j)
95+ END DO
96+ END DO
97+ DO j=JstrV,Jend
98+ DO i=Istr,Iend
99+ vmask_wet(i,j)=wetdry(i,j-1)+wetdry(i,j)
100+ END DO
101+ END DO
102+!
103+! Apply boundary conditions
104+!
105+ CALL bc_r2d_tile (ng, tile, &
106+ & LBi, UBi, LBj, UBj, &
107+ & rmask_wet)
108+ CALL bc_u2d_tile (ng, tile, &
109+ & LBi, UBi, LBj, UBj, &
110+ & umask_wet)
111+ CALL bc_v2d_tile (ng, tile, &
112+ & LBi, UBi, LBj, UBj, &
113+ & vmask_wet)
114+
115+# if defined EW_PERIODIC || defined NS_PERIODIC
116+ CALL exchange_r2d_tile (ng, tile, &
117+ & LBi, UBi, LBj, UBj, &
118+ & rmask_wet)
119+ CALL exchange_u2d_tile (ng, tile, &
120+ & LBi, UBi, LBj, UBj, &
121+ & umask_wet)
122+ CALL exchange_v2d_tile (ng, tile, &
123+ & LBi, UBi, LBj, UBj, &
124+ & vmask_wet)
125+# endif
126+# ifdef DISTRIBUTE
127+ CALL mp_exchange2d (ng, tile, iNLM, 3, &
128+ & LBi, UBi, LBj, UBj, &
129+ & NghostPoints, EWperiodic, NSperiodic, &
130+ & rmask_wet, umask_wet, vmask_wet)
131+# endif
132+# endif
133+!
134+!-----------------------------------------------------------------------
135 ! Initialize other free-surface time-levels.
136 !-----------------------------------------------------------------------
137 !