1 | MODULE traadv |
---|
2 | !!============================================================================== |
---|
3 | !! *** MODULE traadv *** |
---|
4 | !! Ocean active tracers: advection trend |
---|
5 | !!============================================================================== |
---|
6 | !! History : |
---|
7 | !! 9.0 ! 05-11 (G. Madec) Original code |
---|
8 | !!---------------------------------------------------------------------- |
---|
9 | !! tra_adv : compute ocean tracer advection trend |
---|
10 | !! tra_adv_ctl : control the different options of advection scheme |
---|
11 | !!---------------------------------------------------------------------- |
---|
12 | !! * Modules used |
---|
13 | USE oce ! ocean dynamics and active tracers |
---|
14 | USE dom_oce ! ocean space and time domain |
---|
15 | USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine) |
---|
16 | USE traadv_cen2_jki ! 2nd order centered scheme (tra_adv_cen2 routine) |
---|
17 | USE traadv_tvd ! TVD scheme (tra_adv_tvd routine) |
---|
18 | USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine) |
---|
19 | USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine) |
---|
20 | USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) |
---|
21 | USE trabbl ! ??? |
---|
22 | USE ldftra_oce ! ??? |
---|
23 | USE in_out_manager ! I/O manager |
---|
24 | USE prtctl ! Print control |
---|
25 | |
---|
26 | IMPLICIT NONE |
---|
27 | PRIVATE |
---|
28 | |
---|
29 | !! * Accessibility |
---|
30 | PUBLIC tra_adv ! routine called by step module |
---|
31 | |
---|
32 | !! * Share module variables |
---|
33 | LOGICAL, PUBLIC :: & |
---|
34 | ln_traadv_cen2 = .TRUE. , & ! 2nd order centered scheme flag |
---|
35 | ln_traadv_tvd = .FALSE. , & ! TVD scheme flag |
---|
36 | ln_traadv_muscl = .FALSE. , & ! MUSCL scheme flag |
---|
37 | ln_traadv_muscl2 = .FALSE. ! MUSCL2 scheme flag |
---|
38 | |
---|
39 | !! * Module variables |
---|
40 | INTEGER :: & |
---|
41 | nadv ! choice of the type of advection scheme |
---|
42 | |
---|
43 | !! * Substitutions |
---|
44 | # include "domzgr_substitute.h90" |
---|
45 | # include "vectopt_loop_substitute.h90" |
---|
46 | !!---------------------------------------------------------------------- |
---|
47 | !! OPA 9.0 , LOCEAN-IPSL (2005) |
---|
48 | !!---------------------------------------------------------------------- |
---|
49 | |
---|
50 | CONTAINS |
---|
51 | |
---|
52 | SUBROUTINE tra_adv( kt ) |
---|
53 | !!---------------------------------------------------------------------- |
---|
54 | !! *** ROUTINE tra_adv *** |
---|
55 | !! |
---|
56 | !! ** Purpose : compute the ocean tracer advection trend. |
---|
57 | !! |
---|
58 | !!---------------------------------------------------------------------- |
---|
59 | #if ( defined key_trabbl_adv || defined key_traldf_eiv ) |
---|
60 | REAL(wp), DIMENSION(jpi,jpj,jpk) :: & ! temporary arrays |
---|
61 | & zun, zvn, zwn |
---|
62 | #else |
---|
63 | USE oce , zun => un, & ! When no advective bbl, zun == un |
---|
64 | & zvn => vn, & ! " " , zvn == vn |
---|
65 | & zwn => wn ! " " , zwn == wn |
---|
66 | #endif |
---|
67 | |
---|
68 | !! * Arguments |
---|
69 | INTEGER, INTENT( in ) :: kt ! ocean time-step index |
---|
70 | !!---------------------------------------------------------------------- |
---|
71 | |
---|
72 | IF( kt == nit000 ) CALL tra_adv_ctl ! initialisation & control of options |
---|
73 | |
---|
74 | #if defined key_trabbl_adv |
---|
75 | ! Advective bottom boundary layer ! add the bbl velocity |
---|
76 | ! ------------------------------- |
---|
77 | zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:) |
---|
78 | zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) |
---|
79 | zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:) |
---|
80 | #endif |
---|
81 | IF( lk_traldf_eiv ) THEN ! add the eiv velocity |
---|
82 | IF( .NOT. lk_trabbl_adv ) THEN |
---|
83 | zun(:,:,:) = un(:,:,:) |
---|
84 | zvn(:,:,:) = vn(:,:,:) |
---|
85 | zwn(:,:,:) = wn(:,:,:) |
---|
86 | ENDIF |
---|
87 | CALL tra_adv_eiv( kt, zun, zvn, zwn ) ! compute and add the eiv velocity |
---|
88 | ENDIF |
---|
89 | |
---|
90 | SELECT CASE ( nadv ) ! compute advection trend and add it to general trend |
---|
91 | CASE ( -1 ) ! esopa: test all possibility with control print |
---|
92 | CALL tra_adv_cen2 ( kt, zun, zvn, zwn ) |
---|
93 | CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask, & |
---|
94 | & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) |
---|
95 | CALL tra_adv_cen2_jki( kt, zun, zvn, zwn ) |
---|
96 | CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf1 - Ta: ', mask1=tmask, & |
---|
97 | & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) |
---|
98 | CALL tra_adv_tvd ( kt, zun, zvn, zwn ) |
---|
99 | CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf2 - Ta: ', mask1=tmask, & |
---|
100 | & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) |
---|
101 | CALL tra_adv_muscl ( kt, zun, zvn, zwn ) |
---|
102 | CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask, & |
---|
103 | & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) |
---|
104 | CALL tra_adv_muscl2 ( kt, zun, zvn, zwn ) |
---|
105 | CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf4 - Ta: ', mask1=tmask, & |
---|
106 | & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) |
---|
107 | |
---|
108 | CASE ( 0 ) ! 2nd order centered scheme k-j-i loops |
---|
109 | CALL tra_adv_cen2 ( kt, zun, zvn, zwn ) |
---|
110 | CASE ( 1 ) ! 2nd order centered scheme |
---|
111 | CALL tra_adv_cen2_jki( kt, zun, zvn, zwn ) |
---|
112 | CASE ( 2 ) ! TVD scheme |
---|
113 | CALL tra_adv_tvd ( kt, zun, zvn, zwn ) |
---|
114 | CASE ( 3 ) ! MUSCL scheme |
---|
115 | CALL tra_adv_muscl ( kt, zun, zvn, zwn ) |
---|
116 | CASE ( 4 ) ! MUSCL2 scheme |
---|
117 | CALL tra_adv_muscl2 ( kt, zun, zvn, zwn ) |
---|
118 | END SELECT |
---|
119 | |
---|
120 | ! ! print mean trends (used for debugging) |
---|
121 | ! IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' adv - Ta: ', mask1=tmask, & |
---|
122 | ! & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) |
---|
123 | |
---|
124 | END SUBROUTINE tra_adv |
---|
125 | |
---|
126 | |
---|
127 | SUBROUTINE tra_adv_ctl |
---|
128 | !!--------------------------------------------------------------------- |
---|
129 | !! *** ROUTINE tra_adv_ctl *** |
---|
130 | !! |
---|
131 | !! ** Purpose : Control the consistency between cpp options for |
---|
132 | !! tracer advection schemes |
---|
133 | !! |
---|
134 | !!---------------------------------------------------------------------- |
---|
135 | INTEGER :: ioptio |
---|
136 | NAMELIST/nam_traadv/ ln_traadv_cen2 , ln_traadv_tvd, & |
---|
137 | & ln_traadv_muscl, ln_traadv_muscl2 |
---|
138 | !!---------------------------------------------------------------------- |
---|
139 | |
---|
140 | ! Read Namelist nam_traadv : tracer advection scheme |
---|
141 | ! ------------------------- |
---|
142 | REWIND ( numnam ) |
---|
143 | READ ( numnam, nam_traadv ) |
---|
144 | |
---|
145 | ! Parameter control and print |
---|
146 | ! --------------------------- |
---|
147 | ! Control print |
---|
148 | IF(lwp) THEN |
---|
149 | WRITE(numout,*) |
---|
150 | WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme' |
---|
151 | WRITE(numout,*) '~~~~~~~~~~~' |
---|
152 | WRITE(numout,*) ' Namelist nam_tra_adv : chose a advection scheme for tracers' |
---|
153 | WRITE(numout,*) |
---|
154 | WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2 |
---|
155 | WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd |
---|
156 | WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl |
---|
157 | WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2 |
---|
158 | ENDIF |
---|
159 | |
---|
160 | ! Control of Advection scheme options |
---|
161 | ! ----------------------------------- |
---|
162 | ioptio = 0 |
---|
163 | IF( ln_traadv_cen2 ) ioptio = ioptio + 1 |
---|
164 | IF( ln_traadv_tvd ) ioptio = ioptio + 1 |
---|
165 | IF( ln_traadv_muscl ) ioptio = ioptio + 1 |
---|
166 | IF( ln_traadv_muscl2 ) ioptio = ioptio + 1 |
---|
167 | |
---|
168 | IF( .NOT.lk_esopa .AND. ( ioptio > 1 .OR. ioptio == 0 ) ) & |
---|
169 | & CALL ctl_stop( ' Choose ONE advection scheme in namelist nam_traadv' ) |
---|
170 | |
---|
171 | IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) & |
---|
172 | & CALL ctl_stop( ' cross-land advection only with 2nd order advection scheme' ) |
---|
173 | |
---|
174 | ! Set nadv |
---|
175 | ! -------- |
---|
176 | IF( ln_traadv_cen2 ) nadv = 0 |
---|
177 | #if defined key_mpp_omp |
---|
178 | IF( ln_traadv_cen2 ) nadv = 1 |
---|
179 | #endif |
---|
180 | IF( ln_traadv_tvd ) nadv = 2 |
---|
181 | IF( ln_traadv_muscl ) nadv = 3 |
---|
182 | IF( ln_traadv_muscl2 ) nadv = 4 |
---|
183 | |
---|
184 | IF( lk_esopa ) THEN |
---|
185 | IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options' |
---|
186 | nadv = -1 |
---|
187 | ENDIF |
---|
188 | IF(lwp) WRITE(numout,*) ' choice of tra_adv_... nadv = ', nadv |
---|
189 | |
---|
190 | END SUBROUTINE tra_adv_ctl |
---|
191 | |
---|
192 | !!====================================================================== |
---|
193 | END MODULE traadv |
---|