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.
Changeset 5208 for branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 – NEMO

Ignore:
Timestamp:
2015-04-13T15:08:59+02:00 (9 years ago)
Author:
davestorkey
Message:

Merge in changes from trunk up to 5021.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO11_restart_functionality/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    r3294 r5208  
    44   !! Ocean diagnostics:  momentum trends 
    55   !!===================================================================== 
    6    !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code  
    7    !!            2.0  !  04-2008  (C. Talandier) New trends organization 
     6   !! History :  1.0  !  2006-01  (L. Brunier, A-M. Treguier) Original code  
     7   !!            2.0  !  2008-04  (C. Talandier) New trends organization 
     8   !!            3.5  !  2012-02  (G. Madec) regroup beta.V computation with pvo trend 
    89   !!---------------------------------------------------------------------- 
    9 #if defined key_trdvor   ||   defined key_esopa 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_trdvor'   : momentum trend diagnostics 
     10 
    1211   !!---------------------------------------------------------------------- 
    1312   !!   trd_vor      : momentum trends averaged over the depth 
     
    1716   USE oce             ! ocean dynamics and tracers variables 
    1817   USE dom_oce         ! ocean space and time domain variables 
    19    USE trdmod_oce      ! ocean variables trends 
     18   USE trd_oce         ! trends: ocean variables 
    2019   USE zdf_oce         ! ocean vertical physics 
    21    USE in_out_manager  ! I/O manager 
     20   USE sbc_oce         ! surface boundary condition: ocean 
    2221   USE phycst          ! Define parameters for the routines 
    2322   USE ldfdyn_oce      ! ocean active tracers: lateral physics 
    2423   USE dianam          ! build the name of file (routine) 
    2524   USE zdfmxl          ! mixed layer depth 
     25   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     26   USE in_out_manager  ! I/O manager 
    2627   USE ioipsl          ! NetCDF library 
    27    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2828   USE lib_mpp         ! MPP library 
    2929   USE wrk_nemo        ! Memory allocation 
    30  
    3130 
    3231   IMPLICIT NONE 
     
    3736   END INTERFACE 
    3837 
    39    PUBLIC   trd_vor        ! routine called by step.F90 
    40    PUBLIC   trd_vor_zint   ! routine called by dynamics routines 
     38   PUBLIC   trd_vor        ! routine called by trddyn.F90 
    4139   PUBLIC   trd_vor_init   ! routine called by opa.F90 
    4240   PUBLIC   trd_vor_alloc  ! routine called by nemogcm.F90 
     
    8078      IF( trd_vor_alloc /= 0 )   CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 
    8179   END FUNCTION trd_vor_alloc 
     80 
     81 
     82   SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt ) 
     83      !!---------------------------------------------------------------------- 
     84      !!                  ***  ROUTINE trd_vor  *** 
     85      !!  
     86      !! ** Purpose :  computation of cumulated trends over analysis period 
     87      !!               and make outputs (NetCDF or DIMG format) 
     88      !!---------------------------------------------------------------------- 
     89      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends  
     90      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index 
     91      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
     92      ! 
     93      INTEGER ::   ji, jj   ! dummy loop indices 
     94      REAL(wp), POINTER, DIMENSION(:,:) ::   ztswu, ztswv    ! 2D workspace  
     95      !!---------------------------------------------------------------------- 
     96 
     97      CALL wrk_alloc( jpi, jpj, ztswu, ztswv ) 
     98 
     99      SELECT CASE( ktrd )  
     100      CASE( jpdyn_hpg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_prg )   ! Hydrostatique Pressure Gradient  
     101      CASE( jpdyn_keg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_keg )   ! KE Gradient  
     102      CASE( jpdyn_rvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo )   ! Relative Vorticity  
     103      CASE( jpdyn_pvo )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo )   ! Planetary Vorticity Term  
     104      CASE( jpdyn_ldf )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf )   ! Horizontal Diffusion  
     105      CASE( jpdyn_zad )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_zad )   ! Vertical Advection  
     106      CASE( jpdyn_spg )   ;   CALL trd_vor_zint( putrd, pvtrd, jpvor_spg )   ! Surface Pressure Grad.  
     107      CASE( jpdyn_zdf )                                                      ! Vertical Diffusion  
     108         ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0 
     109         DO jj = 2, jpjm1                                                             ! wind stress trends 
     110            DO ji = fs_2, fs_jpim1   ! vector opt. 
     111               ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 ) 
     112               ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 ) 
     113            END DO 
     114         END DO 
     115         ! 
     116         CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf )                             ! zdf trend including surf./bot. stresses  
     117         CALL trd_vor_zint( ztswu, ztswv, jpvor_swf )                             ! surface wind stress  
     118      CASE( jpdyn_bfr ) 
     119         CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr )                             ! Bottom stress 
     120         ! 
     121      CASE( jpdyn_atf )       ! last trends: perform the output of 2D vorticity trends 
     122         CALL trd_vor_iom( kt ) 
     123      END SELECT 
     124      ! 
     125      CALL wrk_dealloc( jpi, jpj, ztswu, ztswv ) 
     126      ! 
     127   END SUBROUTINE trd_vor 
    82128 
    83129 
     
    109155      !!      trends output in netCDF format using ioipsl 
    110156      !!---------------------------------------------------------------------- 
    111       ! 
    112157      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
    113158      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
     
    131176      !  ===================================== 
    132177 
    133       SELECT CASE (ktrd)  
    134       ! 
    135       CASE (jpvor_bfr)        ! bottom friction 
     178      SELECT CASE( ktrd )  
     179      ! 
     180      CASE( jpvor_bfr )        ! bottom friction 
    136181         DO jj = 2, jpjm1 
    137182            DO ji = fs_2, fs_jpim1  
     
    143188         END DO 
    144189         ! 
    145       CASE (jpvor_swf)        ! wind stress 
     190      CASE( jpvor_swf )        ! wind stress 
    146191         zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1) 
    147192         zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1) 
     
    154199    
    155200      ! Curl 
    156       DO ji=1,jpim1 
    157          DO jj=1,jpjm1 
     201      DO ji = 1, jpim1 
     202         DO jj = 1, jpjm1 
    158203            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)       & 
    159204                 &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     
    229274      END DO 
    230275 
    231       ! Save Beta.V term to avoid average before Curl 
    232       ! Beta.V : intergration, no average 
    233       IF( ktrd == jpvor_bev ) THEN  
     276      ! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum 
     277      ! as Beta.V term need intergration, not average 
     278      IF( ktrd == jpvor_pvo ) THEN  
    234279         zubet(:,:) = zudpvor(:,:) 
    235280         zvbet(:,:) = zvdpvor(:,:) 
    236       ENDIF 
    237  
    238       ! Average except for Beta.V 
     281         DO ji = 1, jpim1 
     282            DO jj = 1, jpjm1 
     283               vortrd(ji,jj,jpvor_bev) = (    zvbet(ji+1,jj) - zvbet(ji,jj)     & 
     284                  &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     285            END DO 
     286         END DO 
     287         ! Average of the Curl and Surface mask 
     288         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1) 
     289      ENDIF 
     290      ! 
     291      ! Average  
    239292      zudpvor(:,:) = zudpvor(:,:) * hur(:,:) 
    240293      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:) 
    241     
     294      ! 
    242295      ! Curl 
    243296      DO ji=1,jpim1 
     
    247300         END DO 
    248301      END DO 
    249  
    250302      ! Surface mask 
    251303      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) 
    252  
    253       ! Special treatement for the Beta.V term 
    254       ! Compute the Curl of the Beta.V term which is not averaged 
    255       IF( ktrd == jpvor_bev ) THEN 
    256          DO ji=1,jpim1 
    257             DO jj=1,jpjm1 
    258                vortrd(ji,jj,jpvor_bev) = (    zvbet(ji+1,jj) - zvbet(ji,jj)     & 
    259                   &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) 
    260             END DO 
    261          END DO 
    262  
    263          ! Average on the Curl 
    264          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) 
    265  
    266          ! Surface mask 
    267          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1) 
    268       ENDIF 
    269304    
    270305      IF( ndebug /= 0 ) THEN 
     
    278313 
    279314 
    280    SUBROUTINE trd_vor( kt ) 
     315   SUBROUTINE trd_vor_iom( kt ) 
    281316      !!---------------------------------------------------------------------- 
    282317      !!                  ***  ROUTINE trd_vor  *** 
     
    285320      !!               and make outputs (NetCDF or DIMG format) 
    286321      !!---------------------------------------------------------------------- 
    287       ! 
    288       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     322      INTEGER                   , INTENT(in   ) ::   kt             ! time step 
    289323      ! 
    290324      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     
    305339 
    306340      IF( kt > nit000 )   vor_avrb(:,:) = vor_avr(:,:) 
    307  
    308       IF( ndebug /= 0 ) THEN 
    309           WRITE(numout,*) ' debuging trd_vor: I.1 done ' 
    310           CALL FLUSH(numout) 
    311       ENDIF 
    312341 
    313342      ! I.2 vertically integrated vorticity 
     
    330359 
    331360      ! Curl 
    332       DO ji=1,jpim1 
    333          DO jj=1,jpjm1 
     361      DO ji = 1, jpim1 
     362         DO jj = 1, jpjm1 
    334363            vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    & 
    335364               &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1) 
     
    337366      END DO 
    338367       
    339       IF( ndebug /= 0 ) THEN 
    340          WRITE(numout,*) ' debuging trd_vor: I.2 done' 
    341          CALL FLUSH(numout) 
    342       ENDIF 
    343  
    344368      !  ================================= 
    345369      !   II. Cumulated trends 
     
    351375         vor_avrbb(:,:) = vor_avrb(:,:) 
    352376         vor_avrbn(:,:) = vor_avr (:,:) 
    353       ENDIF 
    354  
    355       IF( ndebug /= 0 ) THEN 
    356          WRITE(numout,*) ' debuging trd_vor: I1.1 done' 
    357          CALL FLUSH(numout) 
    358377      ENDIF 
    359378 
     
    371390      ENDIF 
    372391 
    373       IF( ndebug /= 0 ) THEN 
    374          WRITE(numout,*) ' debuging trd_vor: II.2 done' 
    375          CALL FLUSH(numout) 
    376       ENDIF 
    377  
    378392      !  ============================================= 
    379393      !   III. Output in netCDF + residual computation 
     
    391405         vor_avrtot(:,:) = (  vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean 
    392406 
    393          IF( ndebug /= 0 ) THEN 
    394              WRITE(numout,*) ' zmean = ',zmean 
    395              WRITE(numout,*) ' debuging trd_vor: III.1 done' 
    396              CALL FLUSH(numout) 
    397          ENDIF 
    398407 
    399408         ! III.2 compute residual 
     
    406415         CALL lbc_lnk( vor_avrres, 'F', 1. ) 
    407416 
    408          IF( ndebug /= 0 ) THEN 
    409             WRITE(numout,*) ' debuging trd_vor: III.2 done' 
    410             CALL FLUSH(numout) 
    411          ENDIF 
    412417 
    413418         ! III.3 time evolution array swap 
     
    415420         vor_avrbb(:,:) = vor_avrb(:,:) 
    416421         vor_avrbn(:,:) = vor_avr (:,:) 
    417  
    418          IF( ndebug /= 0 ) THEN 
    419             WRITE(numout,*) ' debuging trd_vor: III.3 done' 
    420             CALL FLUSH(numout) 
    421          ENDIF 
    422422         ! 
    423423         nmoydpvor = 0 
     
    463463      CALL wrk_dealloc( jpi, jpj, zun, zvn )                                    
    464464      ! 
    465    END SUBROUTINE trd_vor 
     465   END SUBROUTINE trd_vor_iom 
    466466 
    467467 
     
    587587   END SUBROUTINE trd_vor_init 
    588588 
    589 #else 
    590    !!---------------------------------------------------------------------- 
    591    !!   Default option :                                       Empty module 
    592    !!---------------------------------------------------------------------- 
    593    INTERFACE trd_vor_zint 
    594       MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d 
    595    END INTERFACE 
    596 CONTAINS 
    597    SUBROUTINE trd_vor( kt )        ! Empty routine 
    598       WRITE(*,*) 'trd_vor: You should not have seen this print! error?', kt 
    599    END SUBROUTINE trd_vor 
    600    SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
    601       REAL, DIMENSION(:,:), INTENT( inout ) ::   putrdvor, pvtrdvor 
    602       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    603       WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd 
    604    END SUBROUTINE trd_vor_zint_2d 
    605    SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd ) 
    606       REAL, DIMENSION(:,:,:), INTENT( inout ) ::   putrdvor, pvtrdvor 
    607       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index 
    608       WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd 
    609    END SUBROUTINE trd_vor_zint_3d 
    610    SUBROUTINE trd_vor_init              ! Empty routine 
    611       WRITE(*,*) 'trd_vor_init: You should not have seen this print! error?' 
    612    END SUBROUTINE trd_vor_init 
    613 #endif 
    614589   !!====================================================================== 
    615590END MODULE trdvor 
Note: See TracChangeset for help on using the changeset viewer.