Ignore:
Timestamp:
2019-09-30T11:07:57+02:00 (14 months ago)
Author:
davestorkey
Message:

UKMO/NEMO_4.0_momentum_trends branch : first set of code changes.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0_momentum_trends/src/OCE/DYN/dynspg_ts.F90

    r10888 r11613  
    6363   USE restart         ! only for lrst_oce 
    6464   USE diatmb          ! Top,middle,bottom output 
     65   USE trd_oce        ! trends: ocean variables 
     66   USE trddyn         ! trend manager: dynamics 
    6567 
    6668   IMPLICIT NONE 
     
    172174      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points 
    173175      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask 
     176      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zspgtrdu, zspgtrdv, zpvotrdu, zpvotrdv  ! SPG and PVO trends (if l_trddyn) 
     177      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zbfrtrdu, zbfrtrdv                      ! BFR trends (if l_trddyn) 
    174178      !!---------------------------------------------------------------------- 
    175179      ! 
     
    177181      !                                         !* Allocate temporary arrays 
    178182      IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj)) 
     183      ! 
     184      IF( l_trddyn ) THEN 
     185          ALLOCATE( zspgtrdu(jpi,jpj), zspgtrdv(jpi,jpj), zpvotrdu(jpi,jpj), zpvotrdv(jpi,jpj), zbfrtrdu(jpi,jpj), zbfrtrdv(jpi,jpj) ) 
     186          zspgtrdu(:,:) = 0._wp 
     187          zspgtrdv(:,:) = 0._wp 
     188          zpvotrdu(:,:) = 0._wp 
     189          zpvotrdv(:,:) = 0._wp 
     190          zbfrtrdu(:,:) = 0._wp 
     191          zbfrtrdv(:,:) = 0._wp 
     192      ENDIF 
    179193      ! 
    180194      zmdi=1.e+20                               !  missing data indicator for masking 
     
    381395!!gm  Is it correct to do so ?   I think so... 
    382396       
    383        
     397 
    384398      !                                   !* barotropic Coriolis trends (vorticity scheme dependent) 
    385399      !                                   ! -------------------------------------------------------- 
     
    387401      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
    388402      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 
     403      ! 
     404      zu_trd(:,:) = 0._wp 
     405      zv_trd(:,:) = 0._wp 
    389406      ! 
    390407      SELECT CASE( nvor_scheme ) 
     
    393410            DO ji = 2, jpim1   ! vector opt. 
    394411               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu_n(ji,jj)                    & 
    395                   &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   & 
    396                   &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   ) 
    397                   ! 
     412                    &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   & 
     413                    &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   ) 
     414               ! 
    398415               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv_n(ji,jj)                    & 
    399                   &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   &  
    400                   &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   )  
    401             END DO   
    402          END DO   
     416                    &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   &  
     417                    &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   )  
     418            END DO 
     419         END DO 
    403420         !          
    404421      CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX 
     
    443460      END SELECT 
    444461      ! 
     462      IF( l_trddyn ) THEN 
     463         ! send correction to baroclinic planetary vorticity trend to trd_dyn 
     464         CALL trd_dyn( zu_trd, zv_trd, jpdyn_pvo_corr, kt ) 
     465      ENDIF 
    445466      !                                   !* Right-Hand-Side of the barotropic momentum equation 
    446467      !                                   ! ---------------------------------------------------- 
    447468      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient 
     469         IF( l_trddyn ) THEN 
     470            zspgtrdu(:,:) = zu_trd(:,:) 
     471            zspgtrdv(:,:) = zv_trd(:,:) 
     472         ENDIF 
    448473         IF( ln_wd_il ) THEN                        ! Calculating and applying W/D gravity filters 
    449474            DO jj = 2, jpjm1 
     
    505530               END DO 
    506531            END DO 
     532         ENDIF 
     533         ! 
     534         IF( l_trddyn ) THEN 
     535            zspgtrdu(:,:) = zu_trd(:,:) - zspgtrdu(:,:)  
     536            zspgtrdv(:,:) = zv_trd(:,:) - zspgtrdv(:,:)  
     537            ! send correction to HPG trend to trd_dyn 
     538            CALL trd_dyn( zspgtrdu, zspgtrdv, jpdyn_hpg_corr, kt ) 
     539            ! reset temporary arrays for use later 
     540            zspgtrdu(:,:) = 0._wp 
     541            zspgtrdv(:,:) = 0._wp 
    507542         ENDIF 
    508543         ! 
     
    10561091         END SELECT 
    10571092         ! 
     1093         IF( l_trddyn ) THEN 
     1094            za2 = wgtbtp2(jn) 
     1095            zpvotrdu(:,:) = zpvotrdu(:,:) + za2 * zu_trd(:,:) * ssumask(:,:) 
     1096            zpvotrdv(:,:) = zpvotrdv(:,:) + za2 * zv_trd(:,:) * ssvmask(:,:) 
     1097         ENDIF 
     1098         ! 
    10581099         ! Add tidal astronomical forcing if defined 
    10591100         IF ( ln_tide .AND. ln_tide_pot ) THEN 
     
    10771118               END DO 
    10781119            END DO 
     1120            ! 
     1121            IF( l_trddyn ) THEN 
     1122               za2 = wgtbtp2(jn) 
     1123               zbfrtrdu(:,:) = zbfrtrdu(:,:) + za2 * zCdU_u(:,:) * un_e(:,:) * hur_e(:,:) 
     1124               zbfrtrdv(:,:) = zbfrtrdv(:,:) + za2 * zCdU_v(:,:) * vn_e(:,:) * hvr_e(:,:) 
     1125            ENDIF 
    10791126         ENDIF  
    10801127         ! 
     
    11011148           END DO 
    11021149         END IF 
    1103  
     1150         ! 
     1151         IF( l_trddyn ) THEN 
     1152            za2 = wgtbtp2(jn) 
     1153            zspgtrdu(:,:) = zspgtrdu(:,:) + za2 * zwx(:,:) * ssumask(:,:) 
     1154            zspgtrdv(:,:) = zspgtrdv(:,:) + za2 * zwy(:,:) * ssvmask(:,:) 
     1155         ENDIF 
    11041156         ! 
    11051157         ! Set next velocities: 
     
    13021354      IF( ln_wd_il )   DEALLOCATE( zcpx, zcpy ) 
    13031355      IF( ln_wd_dl )   DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 
     1356      IF( l_trddyn ) THEN 
     1357         CALL trd_dyn( zspgtrdu, zspgtrdv, jpdyn_spg, kt ) 
     1358         CALL trd_dyn( zpvotrdu, zpvotrdv, jpdyn_pvo, kt ) 
     1359         CALL trd_dyn( zbfrtrdu, zbfrtrdv, jpdyn_bfr, kt ) 
     1360         DEALLOCATE( zspgtrdu, zspgtrdv, zpvotrdu, zpvotrdv, zbfrtrdu, zbfrtrdv ) 
     1361      ENDIF 
    13041362      ! 
    13051363      IF( ln_diatmb ) THEN 
Note: See TracChangeset for help on using the changeset viewer.