MODULE obcdyn_tam #if defined key_obc !!================================================================================= !! *** MODULE obcdyn *** !! Ocean dynamics: Radiation of velocities on each open boundary !!================================================================================= !!--------------------------------------------------------------------------------- !! obc_dyn_tan : call the subroutine for each open boundary !! obc_dyn_east_tan : !! obc_dyn_west_tan : !! obc_dyn_north_tan : !! obc_dyn_south_tan : !! obc_dyn_adj : call the subroutine for each open boundary !! obc_dyn_east_adj : !! obc_dyn_west_adj : !! obc_dyn_north_adj : !! obc_dyn_south_adj : !!---------------------------------------------------------------------------------- !!---------------------------------------------------------------------------------- !! * Modules used USE oce_tam, ONLY : ub_tl, vb_tl, ua_tl, va_tl, & ! ocean dynamics and tracers & ub_ad, vb_ad, ua_ad, va_ad USE obc_oce USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE obc_oce ! ocean open boundary conditions USE lbclnk ! ??? USE lbclnk_tam, ONLY : lbc_lnk_adj ! ocean lateral boundary conditions (or mpp link) USE lib_mpp ! ??? USE dynspg_oce ! choice/control of key cpp for surface pressure gradient USE obccli ! ocean open boundary conditions: climatology USE in_out_manager ! I/O manager USE prtctl IMPLICIT NONE PRIVATE !! * Accessibility PUBLIC obc_dyn_tan ! routine called in dynspg_flt PUBLIC obc_dyn_adj ! routine called in dynspg_flt PUBLIC obc_dyn_adj_tst !! * Module variables INTEGER :: ji, jj, jk ! dummy loop indices LOGICAL :: ll_fbc !!--------------------------------------------------------------------------------- CONTAINS SUBROUTINE obc_dyn_tan ( kt ) !!------------------------------------------------------------------------------ !! SUBROUTINE obc_dyn !! ******************** !! ** Purpose : !! Compute dynamics (u,v) at the open boundaries. !! if defined key_dynspg_flt: !! this routine is called by dynspg_flt and updates !! ua, va which are the actual velocities (not trends) !! !! The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north, !! and/or lp_obc_south allow the user to determine which boundary is an !! open one (must be done in the param_obc.h90 file). !! !! ** Reference : !! Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France. !! !! History : !! ! 95-03 (J.-M. Molines) Original, SPEM !! ! 97-07 (G. Madec, J.-M. Molines) addition !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT( in ) :: kt !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/OBC/obcdyn.F90,v 1.5 2005/12/28 09:25:07 opalod Exp $ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- ! 0. Local constant initialization ! -------------------------------- #if defined key_pomme_r025 ! Warning : TAM is available only for fixed boundary conditions (FBC) ll_fbc = .true. #else Error, OBC not ready. #endif # if defined key_dynspg_rl Error, this option is obsolete (suppressed after nemo_v3_2) # endif IF( lp_obc_east ) CALL obc_dyn_east_tan IF( lp_obc_west ) CALL obc_dyn_west_tan IF( lp_obc_north ) CALL obc_dyn_north_tan IF( lp_obc_south ) CALL obc_dyn_south_tan IF( lk_mpp ) THEN CALL lbc_lnk( ub_tl, 'U', -1. ) CALL lbc_lnk( vb_tl, 'V', -1. ) CALL lbc_lnk( ua_tl, 'U', -1. ) CALL lbc_lnk( va_tl, 'V', -1. ) ENDIF END SUBROUTINE obc_dyn_tan SUBROUTINE obc_dyn_adj ( kt ) !!------------------------------------------------------------------------------ !! *** SUBROUTINE obc_dyn_adj *** !! !! ** Purpose : !! !! History : !! ! !!------------------------------------------------------------------------------ !! * Arguments INTEGER, INTENT( in ) :: kt !! * Local declaration !!------------------------------------------------------------------------------ #if defined key_pomme_r025 ! Warning : TAM is available only for fixed boundary conditions (FBC) ll_fbc = .true. #else Error, OBC not ready. #endif IF( lk_mpp ) THEN CALL lbc_lnk_adj( va_ad, 'V', -1. ) CALL lbc_lnk_adj( ua_ad, 'U', -1. ) CALL lbc_lnk_adj( vb_ad, 'V', -1. ) CALL lbc_lnk_adj( ub_ad, 'U', -1. ) ENDIF IF( lp_obc_south ) CALL obc_dyn_south_adj IF( lp_obc_north ) CALL obc_dyn_north_adj IF( lp_obc_west ) CALL obc_dyn_west_adj IF( lp_obc_east ) CALL obc_dyn_east_adj END SUBROUTINE obc_dyn_adj SUBROUTINE obc_dyn_east_tan !!------------------------------------------------------------------------------ !! *** SUBROUTINE obc_dyn_east *** !! !! ** Purpose : !! Apply the radiation algorithm on east OBC velocities ua, va using the !! phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module !! If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC !! !! History : !! ! 95-03 (J.-M. Molines) Original from SPEM !! ! 97-07 (G. Madec, J.-M. Molines) additions !! ! 97-12 (M. Imbard) Mpp adaptation !! ! 00-06 (J.-M. Molines) !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!------------------------------------------------------------------------------ ! 1. First three time steps and more if lfbceast is .TRUE. ! In that case open boundary conditions are FIXED. ! -------------------------------------------------------- WRITE(numout,*) 'verif passage dans obc_dyn_east_tan' IF ( ll_fbc .OR. lfbceast ) THEN ! 1.1 U zonal velocity ! -------------------- DO ji = nie0, nie1 DO jk = 1, jpkm1 DO jj = 1, jpj ua_tl(ji,jj,jk) = ua_tl(ji,jj,jk) * ( 1. - uemsk(jj,jk) ) END DO END DO END DO ! 1.2 V meridional velocity ! ------------------------- DO ji = nie0+1, nie1+1 DO jk = 1, jpkm1 DO jj = 1, jpj va_tl(ji,jj,jk) = va_tl(ji,jj,jk) * ( 1. - vemsk(jj,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_east_tan SUBROUTINE obc_dyn_east_adj !!------------------------------------------------------------------------------ !! *** SUBROUTINE obc_dyn_east_adj *** !! !! ** Purpose : !! !! History : !! ! !!------------------------------------------------------------------------------ !! * Arguments !! * Local declaration !!------------------------------------------------------------------------------ WRITE(numout,*) 'verif passage dans obc_dyn_east_adj' IF ( ll_fbc .OR. lfbceast ) THEN ! 1.2 V meridional velocity ! ------------------------- DO ji = nie0+1, nie1+1 DO jk = 1, jpkm1 DO jj = 1, jpj va_ad(ji,jj,jk) = va_ad(ji,jj,jk) * ( 1. - vemsk(jj,jk) ) END DO END DO END DO ! 1.1 U zonal velocity ! -------------------- DO ji = nie0, nie1 DO jk = 1, jpkm1 DO jj = 1, jpj ua_ad(ji,jj,jk) = ua_ad(ji,jj,jk) * ( 1. - uemsk(jj,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_east_adj SUBROUTINE obc_dyn_west_tan !!------------------------------------------------------------------------------ !! *** SUBROUTINE obc_dyn_west *** !! !! ** Purpose : !! Apply the radiation algorithm on west OBC velocities ua, va using the !! phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module !! If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC !! !! History : !! ! 95-03 (J.-M. Molines) Original from SPEM !! ! 97-07 (G. Madec, J.-M. Molines) additions !! ! 97-12 (M. Imbard) Mpp adaptation !! ! 00-06 (J.-M. Molines) !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!------------------------------------------------------------------------------ ! 1. First three time steps and more if lfbcwest is .TRUE. ! In that case open boundary conditions are FIXED. ! -------------------------------------------------------- IF ( ll_fbc .OR. lfbcwest ) THEN ! 1.1 U zonal velocity ! --------------------- DO ji = niw0, niw1 DO jk = 1, jpkm1 DO jj = 1, jpj ua_tl(ji,jj,jk) = ua_tl(ji,jj,jk) * ( 1. - uwmsk(jj,jk) ) END DO END DO END DO ! 1.2 V meridional velocity ! ------------------------- DO ji = niw0, niw1 DO jk = 1, jpkm1 DO jj = 1, jpj va_tl(ji,jj,jk) = va_tl(ji,jj,jk) * ( 1. - vwmsk(jj,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_west_tan SUBROUTINE obc_dyn_west_adj !!------------------------------------------------------------------------------ !! *** SUBROUTINE obc_dyn_west_adj *** !! !! ** Purpose : !! !! History : !! ! !!------------------------------------------------------------------------------ !! * Arguments !! * Local declaration !!------------------------------------------------------------------------------ IF ( ll_fbc .OR. lfbcwest ) THEN ! 1.2 V meridional velocity ! ------------------------- DO ji = niw0, niw1 DO jk = 1, jpkm1 DO jj = 1, jpj va_ad(ji,jj,jk) = va_ad(ji,jj,jk) * ( 1. - vwmsk(jj,jk) ) END DO END DO END DO ! 1.1 U zonal velocity ! --------------------- DO ji = niw0, niw1 DO jk = 1, jpkm1 DO jj = 1, jpj ua_ad(ji,jj,jk) = ua_ad(ji,jj,jk) * ( 1. - uwmsk(jj,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_west_adj SUBROUTINE obc_dyn_north_tan !!------------------------------------------------------------------------------ !! SUBROUTINE obc_dyn_north !! ************************* !! ** Purpose : !! Apply the radiation algorithm on north OBC velocities ua, va using the !! phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module !! If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC !! !! History : !! ! 95-03 (J.-M. Molines) Original from SPEM !! ! 97-07 (G. Madec, J.-M. Molines) additions !! ! 97-12 (M. Imbard) Mpp adaptation !! ! 00-06 (J.-M. Molines) !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!------------------------------------------------------------------------------ ! 1. First three time steps and more if lfbcnorth is .TRUE. ! In that case open boundary conditions are FIXED. ! --------------------------------------------------------- IF ( ll_fbc .OR. lfbcnorth ) THEN ! 1.1 U zonal velocity ! -------------------- DO jj = njn0+1, njn1+1 DO jk = 1, jpkm1 DO ji = 1, jpi ua_tl(ji,jj,jk) = ua_tl(ji,jj,jk) * ( 1. - unmsk(ji,jk) ) END DO END DO END DO ! 1.2 V meridional velocity ! ------------------------- DO jj = njn0, njn1 DO jk = 1, jpkm1 DO ji = 1, jpi va_tl(ji,jj,jk)= va_tl(ji,jj,jk) * ( 1. - vnmsk(ji,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_north_tan SUBROUTINE obc_dyn_north_adj !!------------------------------------------------------------------------------ !! *** SUBROUTINE obc_dyn_north_adj *** !! !! ** Purpose : !! !! History : !! ! !!------------------------------------------------------------------------------ !! * Arguments !! * Local declaration !!------------------------------------------------------------------------------ IF ( ll_fbc .OR. lfbcnorth ) THEN ! 1.2 V meridional velocity ! ------------------------- DO jj = njn0, njn1 DO jk = 1, jpkm1 DO ji = 1, jpi va_ad(ji,jj,jk)= va_ad(ji,jj,jk) * ( 1. - vnmsk(ji,jk) ) END DO END DO END DO ! 1.1 U zonal velocity ! -------------------- DO jj = njn0+1, njn1+1 DO jk = 1, jpkm1 DO ji = 1, jpi ua_ad(ji,jj,jk) = ua_ad(ji,jj,jk) * ( 1. - unmsk(ji,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_north_adj SUBROUTINE obc_dyn_south_tan !!------------------------------------------------------------------------------ !! SUBROUTINE obc_dyn_south !! ************************* !! ** Purpose : !! Apply the radiation algorithm on south OBC velocities ua, va using the !! phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module !! If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC !! !! History : !! ! 95-03 (J.-M. Molines) Original from SPEM !! ! 97-07 (G. Madec, J.-M. Molines) additions !! ! 97-12 (M. Imbard) Mpp adaptation !! ! 00-06 (J.-M. Molines) !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!------------------------------------------------------------------------------ ! 1. First three time steps and more if lfbcsouth is .TRUE. ! In that case open boundary conditions are FIXED. ! --------------------------------------------------------- IF ( ll_fbc .OR. lfbcsouth ) THEN ! 1.1 U zonal velocity ! -------------------- DO jj = njs0, njs1 DO jk = 1, jpkm1 DO ji = 1, jpi ua_tl(ji,jj,jk) = ua_tl(ji,jj,jk) * ( 1. - usmsk(ji,jk) ) END DO END DO END DO ! 1.2 V meridional velocity ! ------------------------- DO jj = njs0, njs1 DO jk = 1, jpkm1 DO ji = 1, jpi va_tl(ji,jj,jk) = va_tl(ji,jj,jk) * ( 1. - vsmsk(ji,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_south_tan SUBROUTINE obc_dyn_south_adj !!------------------------------------------------------------------------------ !! *** SUBROUTINE obc_dyn_south_adj *** !! !! ** Purpose : !! !! History : !! ! !!------------------------------------------------------------------------------ !! * Arguments !! * Local declaration !!------------------------------------------------------------------------------ IF ( ll_fbc .OR. lfbcsouth ) THEN ! 1.2 V meridional velocity ! ------------------------- DO jj = njs0, njs1 DO jk = 1, jpkm1 DO ji = 1, jpi va_ad(ji,jj,jk) = va_ad(ji,jj,jk) * ( 1. - vsmsk(ji,jk) ) END DO END DO END DO ! 1.1 U zonal velocity ! -------------------- DO jj = njs0, njs1 DO jk = 1, jpkm1 DO ji = 1, jpi ua_ad(ji,jj,jk) = ua_ad(ji,jj,jk) * ( 1. - usmsk(ji,jk) ) END DO END DO END DO ELSE CALL ctl_stop( 'Error in obcdyn_tam : TAM is available only for fixed boundary conditions' ) END IF END SUBROUTINE obc_dyn_south_adj SUBROUTINE obc_dyn_adj_tst( kumadt ) USE gridrandom, ONLY : grid_rd_sd USE tstool_tam, ONLY : prntst_adj, stdu, stdv USE dotprodfld, ONLY : dot_product ! Computes dot product for 3D and 2D fields INTEGER, INTENT(IN) :: kumadt ! Output unit REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & zua_tlin, zva_tlin, zua_adin, zva_adin, z3r REAL(wp) :: zspdx, zspdy CHARACTER (LEN=14) :: cl_name ! ... Allocate memory ALLOCATE( zua_tlin (jpi,jpj,jpk), zva_tlin(jpi,jpj,jpk), & zua_adin (jpi,jpj,jpk), zva_adin(jpi,jpj,jpk), & z3r(jpi,jpj,jpk) ) ! ... Initialisations zua_tlin(:,:,:) = 0.e0 ; zua_adin(:,:,:) = 0.e0 zva_tlin(:,:,:) = 0.e0 ; zva_adin(:,:,:) = 0.e0 ! ... Define random working arrays CALL grid_rd_sd( 456953, z3r, 'U', 0.0_wp, stdu) DO jk = 1, jpk ; DO jj = nldj, nlej ; DO ji = nldi, nlei zua_tlin(ji,jj,jk) = z3r(ji,jj,jk) END DO ; END DO ; END DO CALL grid_rd_sd( 3434334, z3r, 'V', 0.0_wp, stdv) DO jk = 1, jpk ; DO jj = nldj, nlej ; DO ji = nldi, nlei zva_tlin(ji,jj,jk) = z3r(ji,jj,jk) END DO ; END DO ; END DO ! ... Initialize the tangent variables ua_tl(:,:,:) = zua_tlin(:,:,:) ; ub_tl(:,:,:) = 0.e0 va_tl(:,:,:) = zva_tlin(:,:,:) ; vb_tl(:,:,:) = 0.e0 ! ... Call the tangent routine CALL obc_dyn_tan( nit000 ) ! ... Initialize the adjoint variables zua_adin(:,:,:) = 1. * ua_tl(:,:,:) zva_adin(:,:,:) = 1. * va_tl(:,:,:) ! ... Calculate the scalar product for the output zspdy = DOT_PRODUCT( ua_tl, zua_adin ) & + DOT_PRODUCT( va_tl, zva_adin ) ! ... Call the adjoint routine ua_ad(:,:,:) = zua_adin(:,:,:) ; ub_ad(:,:,:) = 0.e0 va_ad(:,:,:) = zva_adin(:,:,:) ; vb_ad(:,:,:) = 0.e0 CALL obc_dyn_adj( nit000 ) ! ... Calculate the scalar product for the input zspdx = DOT_PRODUCT( zua_tlin, ua_ad ) & + DOT_PRODUCT( zva_tlin, va_ad ) ! ... Diagnostic write ! 14 char:'12345678901234' cl_name = 'obcdyn_tam ' CALL prntst_adj( cl_name, kumadt, zspdx, zspdy ) END SUBROUTINE obc_dyn_adj_tst #else !!================================================================================= !! *** MODULE obcdyn *** !! Ocean dynamics: Radiation of velocities on each open boundary !!================================================================================= CONTAINS SUBROUTINE obc_dyn_tan ! No open boundaries ==> empty routine END SUBROUTINE obc_dyn_tan SUBROUTINE obc_dyn_adj ! No open boundaries ==> empty routine END SUBROUTINE obc_dyn_adj SUBROUTINE obc_dyn_adj_tst END SUBROUTINE obc_dyn_adj_tst #endif END MODULE obcdyn_tam