New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

sbc_oce_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC – NEMO

Context Navigation

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/SBC/sbc_oce_tam.F90 @ 3611

Last change on this file since 3611 was 3611, checked in by pabouttier, 11 years ago
Add TAM code and ORCA2_TAM configuration - see Ticket #1007
Property svn:executable set to ``*
File size: 16.3 KB

Line
1	MODULE sbc_oce_tam
2	!!----------------------------------------------------------------------
3	!! This software is governed by the CeCILL licence (Version 2)
4	!!----------------------------------------------------------------------
5	#if defined key_tam
6	!!======================================================================
7	!! * MODULE sbc_oce_tam *
8	!! Surface module : variables defined in core memory
9	!! Tangent and Adjoint Module
10	!!======================================================================
11	!! History of the direct module:
12	!! 3.0 ! 2006-06 (G. Madec) Original code
13	!! - ! 2008-08 (G. Madec) namsbc moved from sbcmod
14	!! History of the TAM module:
15	!! 3.0 ! 2008-11 (A. Vidard) Original code
16	!! 3.0 ! 2009-03 (A. Weaver) Allocate/initialization routine
17	!! 3.2 ! 2010-04 (A. Vidard) 3.2 update
18	!! 3.4 ! 2012-07 (P.-A. Bouttier) 3.4 update
19	!! 3.4 ! 2012-09 (A. Vidard) Deallocating and initialising options
20	!!----------------------------------------------------------------------
21	USE par_oce
22	USE sbc_oce
23	USE in_out_manager
24	USE lib_mpp
25
26	IMPLICIT NONE
27
28	!! * Routine accessibility
29	PRIVATE
30
31	PUBLIC &
32	& sbc_oce_alloc_tam, & !: Allocate teh TAM fields
33	& sbc_oce_dealloc_tam, & !: Deallocate the TAM fields
34	& sbc_oce_tam_init !: Initialize the TAM fields
35
36	!!----------------------------------------------------------------------
37	!! Ocean Surface Boundary Condition fields
38	!!----------------------------------------------------------------------
39	REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: &
40	& qsr_hc_tl, &
41	& sbc_tsc_b_tl, &
42	& sbc_tsc_tl, &
43	& qsr_hc_b_tl
44	REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
45	& utau_tl, & !: Tangent linear of sea surface i-stress (ocean referential) [N/m2]
46	& vtau_tl, & !: Tangent linear of sea surface j-stress (ocean referential) [N/m2]
47	& utau_b_tl, & !: Tangent linear of sea surface i-stress (ocean referential) [N/m2]
48	& vtau_b_tl, & !: Tangent linear of sea surface j-stress (ocean referential) [N/m2]
49	& taum_tl, & !: Tangent linear of module of sea surface stress (at T-point) [N/m2]
50	& wndm_tl, & !: Tangent linear of wind speed module at T-point (=\|U10m-Uoce\|) [m/s
51	& qns_tl, & !: Tangent linear of sea heat flux: non solar [W/m2]
52	& qns_b_tl, & !: Tangent linear of sea heat flux: non solar [W/m2]
53	& rnf_tl, & !: Tangent linear of sea heat flux: non solar [W/m2]
54	& rnf_b_tl, & !: Tangent linear of sea heat flux: non solar [W/m2]
55	& qsr_tl, & !: Tangent linear of sea heat flux: solar [W/m2]
56	& qns_tot_tl, & !: Tangent linear of total sea heat flux: non solar [W/m2]
57	& qsr_tot_tl, & !: Tangent linear of total sea heat flux: solar [W/m2]
58	& emp_tl, & !: Tangent linear of freshwater budget: volume flux [Kg/m2/s]
59	& emp_tot_tl, & !: Tangent linear of freshwater budget: volume flux [Kg/m2/s]
60	& emps_tl, & !: Tangent linear of freshwater budget: concentration/dillution [Kg/m2/s]
61	& emp_b_tl, & !: Tangent linear of freshwater budget: volume flux [Kg/m2/s]
62	& emps_b_tl, & !: Tangent linear of freshwater budget: concentration/dillution [Kg/m2/s]
63	& fr_i_tl !: Tangent linear of ice fraction (between 0 to 1) -
64	#if defined key_cpl_carbon_cycle
65	REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: atm_co2_tl !: tangent of atmospheric pCO2 [ppm]
66	#endif
67	LOGICAL, SAVE, PRIVATE :: ll_alloctl = .FALSE.
68
69	REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: &
70	& qsr_hc_ad, &
71	& sbc_tsc_b_ad, &
72	& sbc_tsc_ad, &
73	& qsr_hc_b_ad
74
75	REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
76	& utau_ad, & !: Adjoint of sea surface i-stress (ocean referential) [N/m2]
77	& vtau_ad, & !: Adjoint of sea surface j-stress (ocean referential) [N/m2]
78	& utau_b_ad, & !: Adjoint of sea surface i-stress (ocean referential) [N/m2]
79	& vtau_b_ad, & !: Adjoint of sea surface j-stress (ocean referential) [N/m2]
80	& taum_ad, & !: Adjoint of module of sea surface stress (at T-point) [N/m2]
81	& wndm_ad, & !: Adjoint of wind speed module at T-point (=\|U10m-Uoce\|) [m/s]
82	& qns_ad, & !: Adjoint of sea heat flux: non solar [W/m2
83	& qns_b_ad, & !: Adjoint of sea heat flux: non solar [W/m2
84	& rnf_ad, & !: Adjoint of sea heat flux: non solar [W/m2
85	& rnf_b_ad, & !: Adjoint of sea heat flux: non solar [W/m2
86	& qsr_ad, & !: Adjoint of sea heat flux: solar [W/m2]
87	& qns_tot_ad, & !: Adjoint of total sea heat flux: non solar [W/m2
88	& qsr_tot_ad, & !: Adjoint of total sea heat flux: solar [W/m2]
89	& emp_ad, & !: Adjoint of freshwater budget: volume flux [Kg/m2/s]
90	& emp_tot_ad, & !: Adjoint of freshwater budget: volume flux [Kg/m2/s]
91	& emps_ad, & !: Adjoint of freshwater budget: concentration/dillution [Kg/m2/s]
92	& emp_b_ad, & !: Adjoint of freshwater budget: volume flux [Kg/m2/s]
93	& emps_b_ad, & !: Adjoint of freshwater budget: concentration/dillution [Kg/m2/s]
94	& fr_i_ad !: Adjoint of ice fraction (between 0 to 1) -
95	#if defined key_cpl_carbon_cycle
96	REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: atm_co2_ad !: adjoint of atmospheric pCO2 [ppm]
97	#endif
98
99	!!----------------------------------------------------------------------
100	!! Sea Surface Mean fields
101	!!----------------------------------------------------------------------
102	REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
103	& ssu_m_tl, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
104	& ssv_m_tl, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
105	& sst_m_tl, & !: mean (nn_fsbc time-step) surface sea temperature [Celsius]
106	& sss_m_tl, & !: mean (nn_fsbc time-step) surface sea salinity [psu]
107	& ssh_m_tl !: mean (nn_fsbc time-step) surface sea height [m]
108
109	REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: &
110	& ssu_m_ad, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
111	& ssv_m_ad, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
112	& sst_m_ad, & !: mean (nn_fsbc time-step) surface sea temperature [Celsius]
113	& sss_m_ad, & !: mean (nn_fsbc time-step) surface sea salinity [psu]
114	& ssh_m_ad !: mean (nn_fsbc time-step) surface sea height [m]
115
116	LOGICAL, SAVE, PRIVATE :: ll_allocad = .FALSE.
117	!! * Substitutions
118	# include "vectopt_loop_substitute.h90"
119
120	CONTAINS
121
122	INTEGER FUNCTION sbc_oce_alloc_tam( kmode )
123	!! * Arguments
124	INTEGER, OPTIONAL :: kmode
125	INTEGER :: imode
126	INTEGER :: ierr(4)
127	IF ( PRESENT(kmode) ) THEN
128	imode = kmode
129	ELSE
130	imode = 0
131	END IF
132	!------------------------------------------------------------------------
133	ierr(:) = 0
134	!
135	IF ( ( imode == 0 ) .OR. ( imode == 1 ) .AND. ( .NOT. ll_alloctl ) ) THEN
136	ALLOCATE( utau_tl(jpi,jpj) , utau_b_tl(jpi,jpj) , taum_tl(jpi,jpj) , &
137	& vtau_tl(jpi,jpj) , vtau_b_tl(jpi,jpj) , wndm_tl(jpi,jpj) , STAT=ierr(1) )
138	!
139	ALLOCATE( qns_tot_tl(jpi,jpj) , qns_tl (jpi,jpj) , qns_b_tl(jpi,jpj), &
140	& qsr_tot_tl(jpi,jpj) , qsr_tl (jpi,jpj) , &
141	& emp_tl (jpi,jpj) , emp_b_tl (jpi,jpj) , &
142	& rnf_tl (jpi,jpj) , rnf_b_tl (jpi,jpj) , &
143	& emps_tl (jpi,jpj) , emps_b_tl(jpi,jpj) , emp_tot_tl(jpi,jpj) , STAT=ierr(2) )
144	!
145	ALLOCATE( &
146	#if defined key_cpl_carbon_cycle
147	& atm_co2_tl(jpi,jpj) , &
148	#endif
149	& ssu_m_tl (jpi,jpj) , sst_m_tl(jpi,jpj) , &
150	& ssv_m_tl (jpi,jpj) , sss_m_tl (jpi,jpj), ssh_m_tl(jpi,jpj) , STAT=ierr(3) )
151	!
152	ALLOCATE( qsr_hc_tl(jpi,jpj,jpk), qsr_hc_b_tl(jpi,jpj,jpk), sbc_tsc_b_tl(jpi,jpj,jpts) , sbc_tsc_tl(jpi,jpj,jpts), STAT=ierr(4) )
153
154	sbc_oce_alloc_tam = MAXVAL( ierr )
155	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_alloc_tam )
156	IF( sbc_oce_alloc_tam > 0 ) CALL ctl_warn('sbc_oce_alloci_tam: allocation of tangent linear arrays failed')
157
158	ll_alloctl = .TRUE.
159	!
160	END IF
161
162	IF ( ( imode == 0 ) .OR. ( imode == 2 ) .AND. ( .NOT. ll_allocad ) ) THEN
163	ierr(:) = 0
164	!
165	ALLOCATE( utau_ad(jpi,jpj) , utau_b_ad(jpi,jpj) , taum_ad(jpi,jpj) , &
166	& vtau_ad(jpi,jpj) , vtau_b_ad(jpi,jpj) , wndm_ad(jpi,jpj) , STAT=ierr(1) )
167	!
168	ALLOCATE( qns_tot_ad(jpi,jpj) , qns_ad (jpi,jpj) , qns_b_ad(jpi,jpj), &
169	& qsr_tot_ad(jpi,jpj) , qsr_ad (jpi,jpj) , &
170	& emp_ad (jpi,jpj) , emp_b_ad (jpi,jpj) , &
171	& rnf_ad (jpi,jpj) , rnf_b_ad (jpi,jpj) , &
172	& emps_ad (jpi,jpj) , emps_b_ad(jpi,jpj) , emp_tot_ad(jpi,jpj) , STAT=ierr(2) )
173	!
174	ALLOCATE( &
175	#if defined key_cpl_carbon_cycle
176	& atm_co2_ad(jpi,jpj) , &
177	#endif
178	& ssu_m_ad (jpi,jpj) , sst_m_ad(jpi,jpj) , &
179	& ssv_m_ad (jpi,jpj) , sss_m_ad (jpi,jpj), ssh_m_ad(jpi,jpj) , STAT=ierr(3) )
180	!
181	ALLOCATE( qsr_hc_ad(jpi,jpj,jpk), qsr_hc_b_ad(jpi,jpj,jpk), sbc_tsc_b_ad(jpi,jpj,jpts), sbc_tsc_ad(jpi,jpj,jpts), STAT=ierr(4) )
182
183	sbc_oce_alloc_tam = MAXVAL( ierr )
184	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_alloc_tam )
185	IF( sbc_oce_alloc_tam > 0 ) CALL ctl_warn('sbc_oce_alloc_tam: allocation of adjoint arrays failed')
186	!
187	ll_allocad = .TRUE.
188	END IF
189	END FUNCTION sbc_oce_alloc_tam
190	!
191	INTEGER FUNCTION sbc_oce_dealloc_tam( kmode )
192	!! * Arguments
193	INTEGER, OPTIONAL :: kmode
194	INTEGER :: ierr(4)
195	INTEGER :: imode
196	IF ( PRESENT(kmode) ) THEN
197	imode = kmode
198	ELSE
199	imode = 0
200	END IF
201	!------------------------------------------------------------------------
202	ierr(:) = 0
203	!
204	IF ( ( imode == 0 ) .OR. ( imode == 1 ) .AND. ( ll_alloctl ) ) THEN
205	DEALLOCATE( utau_tl , utau_b_tl , taum_tl , &
206	& vtau_tl , vtau_b_tl , wndm_tl , STAT=ierr(1) )
207	!
208	DEALLOCATE( qns_tot_tl , qns_tl , qns_b_tl, &
209	& qsr_tot_tl , qsr_tl , &
210	& emp_tl , emp_b_tl , &
211	& rnf_tl , rnf_b_tl , &
212	& emps_tl , emps_b_tl , emp_tot_tl , STAT=ierr(2) )
213	!
214	DEALLOCATE( &
215	#if defined key_cpl_carbon_cycle
216	& atm_co2_tl , &
217	#endif
218	& ssu_m_tl , sst_m_tl , &
219	& ssv_m_tl , sss_m_tl , ssh_m_tl , STAT=ierr(3) )
220	!
221	DEALLOCATE( qsr_hc_tl, qsr_hc_b_tl, sbc_tsc_b_tl , sbc_tsc_tl, STAT=ierr(4) )
222
223	sbc_oce_dealloc_tam = MAXVAL( ierr )
224	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_dealloc_tam )
225	IF( sbc_oce_dealloc_tam > 0 ) CALL ctl_warn('sbc_oce_dealloci_tam: allocation of tangent linear arrays failed')
226
227	ll_alloctl = .FALSE.
228	!
229	END IF
230
231	IF ( ( imode == 0 ) .OR. ( imode == 2 ) .and. ( ll_allocad ) ) THEN
232	ierr(:) = 0
233	!
234	DEALLOCATE( utau_ad , utau_b_ad , taum_ad , &
235	& vtau_ad , vtau_b_ad , wndm_ad , STAT=ierr(1) )
236	!
237	DEALLOCATE( qns_tot_ad , qns_ad , qns_b_ad, &
238	& qsr_tot_ad , qsr_ad , &
239	& emp_ad , emp_b_ad , &
240	& rnf_ad , rnf_b_ad , &
241	& emps_ad , emps_b_ad , emp_tot_ad , STAT=ierr(2) )
242	!
243	DEALLOCATE( &
244	#if defined key_cpl_carbon_cycle
245	& atm_co2_ad , &
246	#endif
247	& ssu_m_ad , sst_m_ad , &
248	& ssv_m_ad , sss_m_ad , ssh_m_ad , STAT=ierr(3) )
249	!
250	DEALLOCATE( qsr_hc_ad, qsr_hc_b_ad, sbc_tsc_b_ad, sbc_tsc_ad, STAT=ierr(4) )
251
252	sbc_oce_dealloc_tam = MAXVAL( ierr )
253	IF( lk_mpp ) CALL mpp_sum ( sbc_oce_dealloc_tam )
254	IF( sbc_oce_dealloc_tam > 0 ) CALL ctl_warn('sbc_oce_dealloc_tam: allocation of adjoint arrays failed')
255	!
256	ll_allocad = .FALSE.
257	END IF
258	END FUNCTION sbc_oce_dealloc_tam
259	!
260	SUBROUTINE sbc_oce_tam_init( kmode )
261	!!-----------------------------------------------------------------------
262	!!
263	!! * ROUTINE sbc_oce_tam_init *
264	!!
265	!! ** Purpose : Allocate and initialize the tangent linear and
266	!! adjoint arrays
267	!!
268	!! ** Method : kindic = 0 allocate/initialize both tl and ad variables
269	!! kindic = 1 allocate/initialize only tl variables
270	!! kindic = 2 allocate/initialize only ad variables
271	!!
272	!! ** Action :
273	!!
274	!! References :
275	!!
276	!! History :
277	!! ! 2009-03 (A. Weaver) Initial version (based on oce_tam_init)
278	!! ! 2010-04 (A. Vidard) Nemo3.2 update
279	!! ! 2012-09 (P.-A. Bouttier) Nemo3.4 update
280	!!-----------------------------------------------------------------------
281	INTEGER, INTENT(in) :: kmode
282	INTEGER :: ierr
283	IF ( ( kmode == 0 ) .OR. ( kmode == 1 ) ) THEN
284	IF ( .NOT. ll_alloctl ) ierr = sbc_oce_alloc_tam ( 1 )
285	qsr_hc_tl(:,:,:) = 0.0_wp
286	qsr_hc_b_tl(:,:,:) = 0.0_wp
287	sbc_tsc_tl(:,:,:) = 0.0_wp
288	sbc_tsc_b_tl(:,:,:) = 0.0_wp
289	utau_tl (:,:) = 0.0_wp
290	vtau_tl (:,:) = 0.0_wp
291	utau_b_tl (:,:) = 0.0_wp
292	vtau_b_tl (:,:) = 0.0_wp
293	taum_tl (:,:) = 0.0_wp
294	wndm_tl (:,:) = 0.0_wp
295	qns_tl (:,:) = 0.0_wp
296	qns_b_tl (:,:) = 0.0_wp
297	rnf_tl (:,:) = 0.0_wp
298	rnf_b_tl (:,:) = 0.0_wp
299	qsr_tl (:,:) = 0.0_wp
300	qns_tot_tl (:,:) = 0.0_wp
301	qsr_tot_tl (:,:) = 0.0_wp
302	emp_tl (:,:) = 0.0_wp
303	emps_tl (:,:) = 0.0_wp
304	emp_b_tl (:,:) = 0.0_wp
305	emps_b_tl (:,:) = 0.0_wp
306	fr_i_tl (:,:) = 0.0_wp
307	ssu_m_tl(:,:) = 0.0_wp
308	ssv_m_tl(:,:) = 0.0_wp
309	sst_m_tl(:,:) = 0.0_wp
310	sss_m_tl(:,:) = 0.0_wp
311	ssh_m_tl(:,:) = 0.0_wp
312	END IF
313	IF ( ( kmode == 0 ) .OR. ( kmode == 2 ) ) THEN
314	IF ( .NOT. ll_allocad ) ierr = sbc_oce_alloc_tam ( 2 )
315	qsr_hc_ad(:,:,:) = 0.0_wp
316	qsr_hc_b_ad(:,:,:) = 0.0_wp
317	sbc_tsc_ad(:,:,:) = 0.0_wp
318	sbc_tsc_b_ad(:,:,:) = 0.0_wp
319	utau_ad (:,:) = 0.0_wp
320	vtau_ad (:,:) = 0.0_wp
321	utau_b_ad (:,:) = 0.0_wp
322	vtau_b_ad (:,:) = 0.0_wp
323	taum_ad (:,:) = 0.0_wp
324	wndm_ad (:,:) = 0.0_wp
325	qns_ad (:,:) = 0.0_wp
326	qns_b_ad (:,:) = 0.0_wp
327	rnf_ad (:,:) = 0.0_wp
328	rnf_b_ad (:,:) = 0.0_wp
329	qsr_ad (:,:) = 0.0_wp
330	qns_tot_ad (:,:) = 0.0_wp
331	qsr_tot_ad (:,:) = 0.0_wp
332	emp_ad (:,:) = 0.0_wp
333	emps_ad (:,:) = 0.0_wp
334	emp_b_ad (:,:) = 0.0_wp
335	emps_b_ad (:,:) = 0.0_wp
336	fr_i_ad (:,:) = 0.0_wp
337	ssu_m_ad(:,:) = 0.0_wp
338	ssv_m_ad(:,:) = 0.0_wp
339	sst_m_ad(:,:) = 0.0_wp
340	sss_m_ad(:,:) = 0.0_wp
341	ssh_m_ad(:,:) = 0.0_wp
342	END IF
343	END SUBROUTINE sbc_oce_tam_init
344	#endif
345
346	END MODULE sbc_oce_tam

Note: See TracBrowser for help on using the repository browser.

Download in other formats: