MODULE sbc_oce_tam !!---------------------------------------------------------------------- !! This software is governed by the CeCILL licence (Version 2) !!---------------------------------------------------------------------- #if defined key_tam !!====================================================================== !! *** MODULE sbc_oce_tam *** !! Surface module : variables defined in core memory !! Tangent and Adjoint Module !!====================================================================== !! History of the direct module: !! 3.0 ! 2006-06 (G. Madec) Original code !! - ! 2008-08 (G. Madec) namsbc moved from sbcmod !! History of the TAM module: !! 3.0 ! 2008-11 (A. Vidard) Original code !! 3.0 ! 2009-03 (A. Weaver) Allocate/initialization routine !! 3.2 ! 2010-04 (A. Vidard) 3.2 update !!---------------------------------------------------------------------- USE par_kind, ONLY : & ! Precision variables & wp USE par_oce, ONLY : & ! Ocean space and time domain variables & jpi, & & jpj IMPLICIT NONE !! * Routine accessibility PRIVATE PUBLIC & & sbc_oce_tam_init, & !: Initialize the TAM fields & sbc_oce_tam_deallocate !: Initialize the TAM fields !!---------------------------------------------------------------------- !! Ocean Surface Boundary Condition fields !!---------------------------------------------------------------------- REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & & utau_tl, & !: Tangent linear of sea surface i-stress (ocean referential) [N/m2] & vtau_tl, & !: Tangent linear of sea surface j-stress (ocean referential) [N/m2] & taum_tl, & !: Tangent linear of module of sea surface stress (at T-point) [N/m2] & wndm_tl, & !: Tangent linear of wind speed module at T-point (=|U10m-Uoce|) [m/s & qns_tl, & !: Tangent linear of sea heat flux: non solar [W/m2] & qsr_tl, & !: Tangent linear of sea heat flux: solar [W/m2] & qns_tot_tl, & !: Tangent linear of total sea heat flux: non solar [W/m2] & qsr_tot_tl, & !: Tangent linear of total sea heat flux: solar [W/m2] & emp_tl, & !: Tangent linear of freshwater budget: volume flux [Kg/m2/s] & emps_tl, & !: Tangent linear of freshwater budget: concentration/dillution [Kg/m2/s] & fr_i_tl !: Tangent linear of ice fraction (between 0 to 1) - #if defined key_cpl_carbon_cycle REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: atm_co2_tl !: tangent of atmospheric pCO2 [ppm] #endif REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & & utau_ad, & !: Adjoint of sea surface i-stress (ocean referential) [N/m2] & vtau_ad, & !: Adjoint of sea surface j-stress (ocean referential) [N/m2] & taum_ad, & !: Adjoint of module of sea surface stress (at T-point) [N/m2] & wndm_ad, & !: Adjoint of wind speed module at T-point (=|U10m-Uoce|) [m/s] & qns_ad, & !: Adjoint of sea heat flux: non solar [W/m2 & qsr_ad, & !: Adjoint of sea heat flux: solar [W/m2] & qns_tot_ad, & !: Adjoint of total sea heat flux: non solar [W/m2 & qsr_tot_ad, & !: Adjoint of total sea heat flux: solar [W/m2] & emp_ad, & !: Adjoint of freshwater budget: volume flux [Kg/m2/s] & emps_ad, & !: Adjoint of freshwater budget: concentration/dillution [Kg/m2/s] & fr_i_ad !: Adjoint of ice fraction (between 0 to 1) - #if defined key_cpl_carbon_cycle REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: atm_co2_ad !: adjoint of atmospheric pCO2 [ppm] #endif !!---------------------------------------------------------------------- !! Sea Surface Mean fields !!---------------------------------------------------------------------- REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & & ssu_m_tl, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s] & ssv_m_tl, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s] & sst_m_tl, & !: mean (nn_fsbc time-step) surface sea temperature [Celsius] & sss_m_tl, & !: mean (nn_fsbc time-step) surface sea salinity [psu] & ssh_m_tl !: mean (nn_fsbc time-step) surface sea height [m] REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & & ssu_m_ad, & !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s] & ssv_m_ad, & !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s] & sst_m_ad, & !: mean (nn_fsbc time-step) surface sea temperature [Celsius] & sss_m_ad, & !: mean (nn_fsbc time-step) surface sea salinity [psu] & ssh_m_ad !: mean (nn_fsbc time-step) surface sea height [m] CONTAINS SUBROUTINE sbc_oce_tam_init( kindic ) !!----------------------------------------------------------------------- !! !! *** ROUTINE sbc_oce_tam_init *** !! !! ** Purpose : Allocate and initialize the tangent linear and !! adjoint arrays !! !! ** Method : kindic = 0 allocate/initialize both tl and ad variables !! kindic = 1 allocate/initialize only tl variables !! kindic = 2 allocate/initialize only ad variables !! !! ** Action : !! !! References : !! !! History : !! ! 2009-03 (A. Weaver) Initial version (based on oce_tam_init) !! ! 2010-04 (A. Vidard) Nemo3.2 update !!----------------------------------------------------------------------- !! * Arguments INTEGER, INTENT(IN) :: & & kindic ! indicate which variables to allocate/initialize !! * Local declarations ! Allocate tangent linear variable arrays ! --------------------------------------- IF ( kindic == 0 .OR. kindic == 1 ) THEN IF ( .NOT. ALLOCATED(utau_tl) ) THEN ALLOCATE( utau_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(vtau_tl) ) THEN ALLOCATE( vtau_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(taum_tl) ) THEN ALLOCATE( taum_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(wndm_tl) ) THEN ALLOCATE( wndm_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qns_tl) ) THEN ALLOCATE( qns_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qsr_tl) ) THEN ALLOCATE( qsr_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qns_tot_tl) ) THEN ALLOCATE( qns_tot_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qsr_tot_tl) ) THEN ALLOCATE( qsr_tot_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(emp_tl) ) THEN ALLOCATE( emp_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(emps_tl) ) THEN ALLOCATE( emps_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(fr_i_tl) ) THEN ALLOCATE( fr_i_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(ssu_m_tl) ) THEN ALLOCATE( ssu_m_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(ssv_m_tl) ) THEN ALLOCATE( ssv_m_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(sst_m_tl) ) THEN ALLOCATE( sst_m_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(sss_m_tl) ) THEN ALLOCATE( sss_m_tl(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(ssh_m_tl) ) THEN ALLOCATE( ssh_m_tl(jpi,jpj) ) ENDIF ! Initialize tangent linear variable arrays to zero ! ------------------------------------------------- utau_tl (:,:) = 0.0_wp vtau_tl (:,:) = 0.0_wp taum_tl (:,:) = 0.0_wp wndm_tl (:,:) = 0.0_wp qns_tl (:,:) = 0.0_wp qsr_tl (:,:) = 0.0_wp qns_tot_tl (:,:) = 0.0_wp qsr_tot_tl (:,:) = 0.0_wp emp_tl (:,:) = 0.0_wp emps_tl (:,:) = 0.0_wp fr_i_tl (:,:) = 0.0_wp ssu_m_tl(:,:) = 0.0_wp ssv_m_tl(:,:) = 0.0_wp sst_m_tl(:,:) = 0.0_wp sss_m_tl(:,:) = 0.0_wp ssh_m_tl(:,:) = 0.0_wp ENDIF IF ( kindic == 0 .OR. kindic == 2 ) THEN ! Allocate adjoint variable arrays ! -------------------------------- IF ( .NOT. ALLOCATED(utau_ad) ) THEN ALLOCATE( utau_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(vtau_ad) ) THEN ALLOCATE( vtau_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(taum_ad) ) THEN ALLOCATE( taum_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(wndm_ad) ) THEN ALLOCATE( wndm_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qns_ad) ) THEN ALLOCATE( qns_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qsr_ad) ) THEN ALLOCATE( qsr_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qns_tot_ad) ) THEN ALLOCATE( qns_tot_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(qsr_tot_ad) ) THEN ALLOCATE( qsr_tot_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(emp_ad) ) THEN ALLOCATE( emp_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(emps_ad) ) THEN ALLOCATE( emps_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(fr_i_ad) ) THEN ALLOCATE( fr_i_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(ssu_m_ad) ) THEN ALLOCATE( ssu_m_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(ssv_m_ad) ) THEN ALLOCATE( ssv_m_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(sst_m_ad) ) THEN ALLOCATE( sst_m_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(sss_m_ad) ) THEN ALLOCATE( sss_m_ad(jpi,jpj) ) ENDIF IF ( .NOT. ALLOCATED(ssh_m_ad) ) THEN ALLOCATE( ssh_m_ad(jpi,jpj) ) ENDIF ! Initialize adjoint variable arrays to zero ! ------------------------------------------ utau_ad (:,:) = 0.0_wp vtau_ad (:,:) = 0.0_wp taum_ad (:,:) = 0.0_wp wndm_ad (:,:) = 0.0_wp qns_ad (:,:) = 0.0_wp qsr_ad (:,:) = 0.0_wp qns_tot_ad (:,:) = 0.0_wp qsr_tot_ad (:,:) = 0.0_wp emp_ad (:,:) = 0.0_wp emps_ad (:,:) = 0.0_wp fr_i_ad (:,:) = 0.0_wp ssu_m_ad(:,:) = 0.0_wp ssv_m_ad(:,:) = 0.0_wp sst_m_ad(:,:) = 0.0_wp sss_m_ad(:,:) = 0.0_wp ssh_m_ad(:,:) = 0.0_wp ENDIF END SUBROUTINE sbc_oce_tam_init SUBROUTINE sbc_oce_tam_deallocate( kindic ) !!----------------------------------------------------------------------- !! !! *** ROUTINE sbc_oce_tam_init *** !! !! ** Purpose : Allocate and initialize the tangent linear and !! adjoint arrays !! !! ** Method : kindic = 0 deallocate both tl and ad variables !! kindic = 1 deallocate only tl variables !! kindic = 2 deallocate only ad variables !! !! ** Action : !! !! References : !! !! History : !! ! 2010-06 (A. Vidard) Initial version !!----------------------------------------------------------------------- !! * Arguments INTEGER, INTENT(IN) :: & & kindic ! indicate which variables to deallocate !! * Local declarations ! Deallocate tangent linear variable arrays ! --------------------------------------- IF ( kindic == 0 .OR. kindic == 1 ) THEN IF ( ALLOCATED(utau_tl) ) DEALLOCATE( utau_tl ) IF ( ALLOCATED(vtau_tl) ) DEALLOCATE( vtau_tl ) IF ( ALLOCATED(taum_tl) ) DEALLOCATE( taum_tl ) IF ( ALLOCATED(wndm_tl) ) DEALLOCATE( wndm_tl ) IF ( ALLOCATED(qns_tl) ) DEALLOCATE( qns_tl ) IF ( ALLOCATED(qsr_tl) ) DEALLOCATE( qsr_tl ) IF ( ALLOCATED(qns_tot_tl) ) DEALLOCATE( qns_tot_tl ) IF ( ALLOCATED(qsr_tot_tl) ) DEALLOCATE( qsr_tot_tl ) IF ( ALLOCATED(emp_tl) ) DEALLOCATE( emp_tl ) IF ( ALLOCATED(emps_tl) ) DEALLOCATE( emps_tl ) IF ( ALLOCATED(fr_i_tl) ) DEALLOCATE( fr_i_tl ) IF ( ALLOCATED(ssu_m_tl) ) DEALLOCATE( ssu_m_tl ) IF ( ALLOCATED(ssv_m_tl) ) DEALLOCATE( ssv_m_tl ) IF ( ALLOCATED(sst_m_tl) ) DEALLOCATE( sst_m_tl ) IF ( ALLOCATED(sss_m_tl) ) DEALLOCATE( sss_m_tl ) IF ( ALLOCATED(ssh_m_tl) ) DEALLOCATE( ssh_m_tl ) ENDIF IF ( kindic == 0 .OR. kindic == 2 ) THEN ! Deallocate adjoint variable arrays ! -------------------------------- IF ( ALLOCATED(utau_ad) ) DEALLOCATE( utau_ad ) IF ( ALLOCATED(vtau_ad) ) DEALLOCATE( vtau_ad ) IF ( ALLOCATED(taum_ad) ) DEALLOCATE( taum_ad ) IF ( ALLOCATED(wndm_ad) ) DEALLOCATE( wndm_ad ) IF ( ALLOCATED(qns_ad) ) DEALLOCATE( qns_ad ) IF ( ALLOCATED(qsr_ad) ) DEALLOCATE( qsr_ad ) IF ( ALLOCATED(qns_tot_ad) ) DEALLOCATE( qns_tot_ad ) IF ( ALLOCATED(qsr_tot_ad) ) DEALLOCATE( qsr_tot_ad ) IF ( ALLOCATED(emp_ad) ) DEALLOCATE( emp_ad ) IF ( ALLOCATED(emps_ad) ) DEALLOCATE( emps_ad ) IF ( ALLOCATED(fr_i_ad) ) DEALLOCATE( fr_i_ad ) IF ( ALLOCATED(ssu_m_ad) ) DEALLOCATE( ssu_m_ad ) IF ( ALLOCATED(ssv_m_ad) ) DEALLOCATE( ssv_m_ad ) IF ( ALLOCATED(sst_m_ad) ) DEALLOCATE( sst_m_ad ) IF ( ALLOCATED(sss_m_ad) ) DEALLOCATE( sss_m_ad ) IF ( ALLOCATED(ssh_m_ad) ) DEALLOCATE( ssh_m_ad ) ENDIF END SUBROUTINE sbc_oce_tam_deallocate #endif END MODULE sbc_oce_tam