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 592 for trunk/NEMO/OPA_SRC/TRA/tranxt.F90 – NEMO

Ignore:
Timestamp:
2007-02-09T10:15:25+01:00 (17 years ago)
Author:
opalod
Message:

nemo_v2_update_001 : CT : - add non linear free surface (variable volume) with new cpp key key_vvl

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/TRA/tranxt.F90

    r503 r592  
    3030   USE agrif_opa_interp 
    3131 
     32   USE ocesbc          ! ocean surface boundary condition 
     33   USE domvvl          ! variable volume 
     34   USE dynspg_oce      ! surface pressure gradient variables 
     35   USE phycst 
     36 
    3237   IMPLICIT NONE 
    3338   PRIVATE 
    … …  
    3540   !! * Routine accessibility 
    3641   PUBLIC   tra_nxt   ! routine called by step.F90 
     42 
     43   REAL(wp) ::   vemp ! total amount of volume added or removed by E-P forcing 
     44 
     45   !! * Substitutions 
     46#  include "domzgr_substitute.h90" 
    3747   !!---------------------------------------------------------------------- 
    3848   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    … …  
    7989      REAL(wp) ::   zt, zs       ! temporary scalars 
    8090      REAL(wp) ::   zfact        ! temporary scalar 
     91      !! Variable volume 
     92      REAL(wp) ::   zssh                         ! temporary scalars 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfse3tb, zfse3tn, zfse3ta  ! 3D workspace 
     94 
    8195      !!---------------------------------------------------------------------- 
     96 
     97      !! Explicit physics with thickness weighted updates 
     98      IF( lk_vvl .AND. ln_zdfexp ) THEN 
     99 
     100         ! Scale factors at before and after time step 
     101         ! ------------------------------------------- 
     102         DO jk = 1, jpkm1 
     103            zfse3tb(:,:,jk)  = fsve3t(:,:,jk) * ( 1 + sshb(:,:) * mut(:,:,jk) ) 
     104            zfse3ta(:,:,jk)  = fsve3t(:,:,jk) * ( 1 + ssha(:,:) * mut(:,:,jk) ) 
     105         END DO 
     106 
     107         ! Asselin filtered scale factor at now time step 
     108         ! ---------------------------------------------- 
     109         IF( (neuler == 0 .AND. kt == nit000) .OR. lk_dynspg_ts ) THEN 
     110            zfse3tn(:,:,:) = fse3t(:,:,:) 
     111         ELSE 
     112            DO jk = 1, jpkm1 
     113               DO jj = 1, jpj 
     114                  DO ji = 1, jpi 
     115                     zssh = atfp * ( sshb(ji,jj) + ssha(ji,jj) ) + atfp1 * sshn(ji,jj) 
     116                     zfse3tn(ji,jj,jk) = fsve3t(ji,jj,jk) * ( 1 + zssh * mut(ji,jj,jk) ) 
     117                  END DO 
     118               END DO 
     119            END DO 
     120         ENDIF 
     121 
     122         ! Thickness weighting 
     123         ! ------------------- 
     124         ta(:,:,1:jpkm1) = ta(:,:,1:jpkm1) * fse3t (:,:,1:jpkm1) 
     125         sa(:,:,1:jpkm1) = sa(:,:,1:jpkm1) * fse3t (:,:,1:jpkm1) 
     126 
     127         tn(:,:,1:jpkm1) = tn(:,:,1:jpkm1) * fse3t (:,:,1:jpkm1) 
     128         sn(:,:,1:jpkm1) = sn(:,:,1:jpkm1) * fse3t (:,:,1:jpkm1) 
     129 
     130         tb(:,:,1:jpkm1) = tb(:,:,1:jpkm1) * zfse3tb(:,:,1:jpkm1) 
     131         sb(:,:,1:jpkm1) = sb(:,:,1:jpkm1) * zfse3tb(:,:,1:jpkm1) 
     132 
     133      ENDIF 
    82134 
    83135      IF( l_trdtra ) THEN 
    … …  
    85137         ztrds(:,:,jpk) = 0.e0 
    86138      ENDIF 
     139 
    87140      ! 0. Lateral boundary conditions on ( ta, sa )   (T-point, unchanged sign) 
    88141      ! ---------------------------------============ 
    … …  
    165218         ELSE                                          ! Default case 
    166219            IF( neuler == 0 .AND. kt == nit000 ) THEN 
    167                DO jj = 1, jpj 
    168                   DO ji = 1, jpi 
    169                      tb(ji,jj,jk) = tn(ji,jj,jk) 
    170                      sb(ji,jj,jk) = sn(ji,jj,jk) 
    171                      tn(ji,jj,jk) = ta(ji,jj,jk) 
    172                      sn(ji,jj,jk) = sa(ji,jj,jk) 
    173                   END DO 
    174                END DO 
     220               IF( (lk_vvl .AND. ln_zdfexp) ) THEN                      ! Varying levels 
     221                  DO jj = 1, jpj 
     222                     DO ji = 1, jpi 
     223                        zssh = tmask(ji,jj,jk) / fse3t(ji,jj,jk) 
     224                        tb(ji,jj,jk) = tn(ji,jj,jk) * zssh * tmask(ji,jj,jk) 
     225                        sb(ji,jj,jk) = sn(ji,jj,jk) * zssh * tmask(ji,jj,jk) 
     226                        zssh = tmask(ji,jj,jk) / zfse3ta(ji,jj,jk) 
     227                        tn(ji,jj,jk) = ta(ji,jj,jk) * zssh * tmask(ji,jj,jk) 
     228                        sn(ji,jj,jk) = sa(ji,jj,jk) * zssh * tmask(ji,jj,jk) 
     229                     END DO 
     230                  END DO 
     231               ELSE                                                     ! Fixed levels 
     232                 DO jj = 1, jpj 
     233                     DO ji = 1, jpi 
     234                        tb(ji,jj,jk) = tn(ji,jj,jk) 
     235                        sb(ji,jj,jk) = sn(ji,jj,jk) 
     236                        tn(ji,jj,jk) = ta(ji,jj,jk) 
     237                        sn(ji,jj,jk) = sa(ji,jj,jk) 
     238                     END DO 
     239                  END DO 
     240               ENDIF 
    175241               IF( l_trdtra ) THEN 
    176242                  ztrdt(:,:,jk) = 0.e0 
    … …  
    186252                  END DO 
    187253               END IF 
    188                DO jj = 1, jpj 
    189                   DO ji = 1, jpi 
    190                      tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk) 
    191                      sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk) 
    192                      tn(ji,jj,jk) = ta(ji,jj,jk) 
    193                      sn(ji,jj,jk) = sa(ji,jj,jk) 
    194                   END DO 
    195                END DO 
     254               IF( (lk_vvl .AND. ln_zdfexp) ) THEN                      ! Varying levels 
     255                  DO jj = 1, jpj 
     256                     DO ji = 1, jpi 
     257                        zssh = tmask(ji,jj,jk) / zfse3tn(ji,jj,jk) 
     258                        tb(ji,jj,jk) = ( atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) & 
     259                          &            + atfp1 * tn(ji,jj,jk) ) * zssh 
     260                        sb(ji,jj,jk) = ( atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) & 
     261                          &            + atfp1 * sn(ji,jj,jk) ) * zssh 
     262                        zssh = tmask(ji,jj,1) / zfse3ta(ji,jj,jk) 
     263                        tn(ji,jj,jk) = ta(ji,jj,jk) * zssh 
     264                        sn(ji,jj,jk) = sa(ji,jj,jk) * zssh 
     265                     END DO 
     266                  END DO 
     267               ELSE                                                     ! Fixed levels or first varying level 
     268                  DO jj = 1, jpj 
     269                     DO ji = 1, jpi 
     270                        tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk) 
     271                        sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk) 
     272                        tn(ji,jj,jk) = ta(ji,jj,jk) 
     273                        sn(ji,jj,jk) = sa(ji,jj,jk) 
     274                     END DO 
     275                  END DO 
     276               ENDIF 
    196277            ENDIF 
    197278         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.