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/DOM/domvvl.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/DOM/domvvl.F90

    r4624 r5208  
    4444 
    4545   !!* Namelist nam_vvl 
    46    LOGICAL , PUBLIC                                      :: ln_vvl_zstar              ! zstar  vertical coordinate 
    47    LOGICAL , PUBLIC                                      :: ln_vvl_ztilde             ! ztilde vertical coordinate 
    48    LOGICAL , PUBLIC                                      :: ln_vvl_layer              ! level  vertical coordinate 
    49    LOGICAL , PUBLIC                                      :: ln_vvl_ztilde_as_zstar    ! ztilde vertical coordinate 
    50    LOGICAL , PUBLIC                                      :: ln_vvl_zstar_at_eqtor     ! ztilde vertical coordinate 
    51    LOGICAL , PUBLIC                                      :: ln_vvl_kepe               ! kinetic/potential energy transfer 
    52    !                                                                                           ! conservation: not used yet 
     46   LOGICAL , PUBLIC                                      :: ln_vvl_zstar = .FALSE.              ! zstar  vertical coordinate 
     47   LOGICAL , PUBLIC                                      :: ln_vvl_ztilde = .FALSE.             ! ztilde vertical coordinate 
     48   LOGICAL , PUBLIC                                      :: ln_vvl_layer = .FALSE.              ! level  vertical coordinate 
     49   LOGICAL , PUBLIC                                      :: ln_vvl_ztilde_as_zstar = .FALSE.    ! ztilde vertical coordinate 
     50   LOGICAL , PUBLIC                                      :: ln_vvl_zstar_at_eqtor = .FALSE.     ! ztilde vertical coordinate 
     51   LOGICAL , PUBLIC                                      :: ln_vvl_kepe = .FALSE.               ! kinetic/potential energy transfer 
     52   !                                                                                            ! conservation: not used yet 
    5353   REAL(wp)                                              :: rn_ahe3                   ! thickness diffusion coefficient 
    5454   REAL(wp)                                              :: rn_rst_e3t                ! ztilde to zstar restoration timescale [days] 
    5555   REAL(wp)                                              :: rn_lf_cutoff              ! cutoff frequency for low-pass filter  [days] 
    5656   REAL(wp)                                              :: rn_zdef_max               ! maximum fractional e3t deformation 
    57    LOGICAL , PUBLIC                                      :: ln_vvl_dbg                ! debug control prints 
     57   LOGICAL , PUBLIC                                      :: ln_vvl_dbg = .FALSE.      ! debug control prints 
    5858 
    5959   !! * Module variables 
     
    169169      fsdept_b(:,:,1) = 0.5_wp * fse3w_b(:,:,1) 
    170170      fsdepw_b(:,:,1) = 0.0_wp 
    171       DO jk = 2, jpk 
    172          fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 
    173          fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 
    174          fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:) 
    175          fsdept_b(:,:,jk) = fsdept_b(:,:,jk-1) + fse3w_b(:,:,jk) 
    176          fsdepw_b(:,:,jk) = fsdepw_b(:,:,jk-1) + fse3t_b(:,:,jk-1) 
     171      DO jj = 1,jpj 
     172         DO ji = 1,jpi 
     173            DO jk = 2,mikt(ji,jj)-1 
     174               fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk) 
     175               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 
     176               fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 
     177               fsdept_b(ji,jj,jk) = gdept_0(ji,jj,jk) 
     178               fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk) 
     179            END DO 
     180            IF (mikt(ji,jj) .GT. 1) THEN 
     181               jk = mikt(ji,jj) 
     182               fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk) 
     183               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 
     184               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj) 
     185               fsdept_b(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_b(ji,jj,jk) 
     186               fsdepw_b(ji,jj,jk) = gdepw_0(ji,jj,jk) 
     187            END IF 
     188            DO jk = mikt(ji,jj)+1, jpk 
     189               fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk) 
     190               fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 
     191               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj) 
     192               fsdept_b(ji,jj,jk) = fsdept_b(ji,jj,jk-1) + fse3w_b(ji,jj,jk) 
     193               fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1) 
     194            END DO 
     195         END DO 
    177196      END DO 
    178197 
     
    185204         hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 
    186205      END DO 
    187       hur_b(:,:) = umask(:,:,1) / ( hu_b(:,:) + 1. - umask(:,:,1) ) 
    188       hvr_b(:,:) = vmask(:,:,1) / ( hv_b(:,:) + 1. - vmask(:,:,1) ) 
     206      hur_b(:,:) = umask_i(:,:) / ( hu_b(:,:) + 1. - umask_i(:,:) ) 
     207      hvr_b(:,:) = vmask_i(:,:) / ( hv_b(:,:) + 1. - vmask_i(:,:) ) 
    189208 
    190209      ! Restoring frequencies for z_tilde coordinate 
     
    293312      !                                                ! --------------------------------------------- ! 
    294313 
    295       z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * tmask(:,:,1) / ( ht_0(:,:) + sshn(:,:) + 1. - tmask(:,:,1) ) 
     314      z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
    296315      DO jk = 1, jpkm1 
    297316         ! formally this is the same as fse3t_a = e3t_0*(1+ssha/ht_0) 
     
    313332            zht  (:,:) = zht  (:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 
    314333         END DO 
    315          zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask(:,:,1) ) 
     334         zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) 
    316335 
    317336         ! 2 - Low frequency baroclinic horizontal divergence  (z-tilde case only) 
     
    338357         ELSE                         ! layer case 
    339358            DO jk = 1, jpkm1 
    340                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) 
     359               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   fse3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
    341360            END DO 
    342361         END IF 
     
    386405         ! d - thickness diffusion transport: boundary conditions 
    387406         !     (stored for tracer advction and continuity equation) 
    388          CALL lbc_lnk( un_td , 'U' , -1.) 
    389          CALL lbc_lnk( vn_td , 'V' , -1.) 
     407         CALL lbc_lnk( un_td , 'U' , -1._wp) 
     408         CALL lbc_lnk( vn_td , 'V' , -1._wp) 
    390409 
    391410         ! 4 - Time stepping of baroclinic scale factors 
     
    398417            z2dt = 2.0_wp * rdt 
    399418         ENDIF 
    400          CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1. ) 
     419         CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    401420         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    402421 
     
    453472            zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
    454473         END DO 
    455          z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - tmask(:,:,1) ) 
     474         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
    456475         DO jk = 1, jpkm1 
    457476            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + fse3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
     
    463482      !                                           ! ---baroclinic part--------- ! 
    464483         DO jk = 1, jpkm1 
    465             fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) 
     484            fse3t_a(:,:,jk) = fse3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
    466485         END DO 
    467486      ENDIF 
     
    531550      END DO 
    532551      !                                        ! Inverse of the local depth 
    533       hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
    534       hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
     552      hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 
     553      hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 
    535554 
    536555      CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 
     
    570589      !! * Local declarations 
    571590      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_e3t_def 
    572       INTEGER                             :: jk       ! dummy loop indices 
     591      INTEGER                             :: ji,jj,jk       ! dummy loop indices 
    573592      !!---------------------------------------------------------------------- 
    574593 
     
    622641      fsdepw_n(:,:,1) = 0.0_wp 
    623642      fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:) 
    624       DO jk = 2, jpk 
    625          fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk) 
    626          fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1) 
    627          fsde3w_n(:,:,jk) = fsdept_n(:,:,jk  ) - sshn   (:,:) 
     643      DO jj = 1,jpj 
     644         DO ji = 1,jpi 
     645            DO jk = 2,mikt(ji,jj)-1 
     646               fsdept_n(ji,jj,jk) = gdept_0(ji,jj,jk) 
     647               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 
     648               fsde3w_n(ji,jj,jk) = gdept_0(ji,jj,jk) - sshn(ji,jj) 
     649            END DO 
     650            IF (mikt(ji,jj) .GT. 1) THEN 
     651               jk = mikt(ji,jj) 
     652               fsdept_n(ji,jj,jk) = gdepw_0(ji,jj,jk) + 0.5_wp * fse3w_n(ji,jj,jk) 
     653               fsdepw_n(ji,jj,jk) = gdepw_0(ji,jj,jk) 
     654               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj) 
     655            END IF 
     656            DO jk = mikt(ji,jj)+1, jpk 
     657               fsdept_n(ji,jj,jk) = fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk) 
     658               fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 
     659               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk  ) - sshn   (ji,jj) 
     660            END DO 
     661         END DO 
    628662      END DO 
    629663      ! Local depth and Inverse of the local depth of the water column at u- and v- points 
     
    702736         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    703737         ! boundary conditions 
    704          CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. ) 
     738         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 
    705739         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    706740         !               ! ------------------------------------- ! 
     
    720754         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    721755         ! boundary conditions 
    722          CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. ) 
     756         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 
    723757         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    724758         !               ! ------------------------------------- ! 
     
    738772         IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    739773         ! boundary conditions 
    740          CALL lbc_lnk( pe3_out(:,:,:), 'F', 1. ) 
     774         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 
    741775         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    742776         !               ! ------------------------------------- ! 
     
    808842            id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 
    809843            id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 
    810             id5 = iom_varid( numror, 'hdif_lf', ldstop = .FALSE. ) 
     844            id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 
    811845            !                             ! --------- ! 
    812846            !                             ! all cases ! 
     
    815849               CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    816850               CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) ) 
     851               ! needed to restart if land processor not computed  
     852               IF(lwp) write(numout,*) 'dom_vvl_rst : fse3t_b and fse3t_n found in restart files' 
     853               WHERE ( tmask(:,:,:) == 0.0_wp )  
     854                  fse3t_n(:,:,:) = e3t_0(:,:,:) 
     855                  fse3t_b(:,:,:) = e3t_0(:,:,:) 
     856               END WHERE 
    817857               IF( neuler == 0 ) THEN 
    818858                  fse3t_b(:,:,:) = fse3t_n(:,:,:) 
    819859               ENDIF 
    820860            ELSE IF( id1 > 0 ) THEN 
     861               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_n not found in restart files' 
     862               IF(lwp) write(numout,*) 'fse3t_n set equal to fse3t_b.' 
     863               IF(lwp) write(numout,*) 'neuler is forced to 0' 
     864               CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
     865               fse3t_n(:,:,:) = fse3t_b(:,:,:) 
     866               neuler = 0 
     867            ELSE IF( id2 > 0 ) THEN 
    821868               IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : fse3t_b not found in restart files' 
    822869               IF(lwp) write(numout,*) 'fse3t_b set equal to fse3t_n.' 
    823870               IF(lwp) write(numout,*) 'neuler is forced to 0' 
     871               CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) ) 
    824872               fse3t_b(:,:,:) = fse3t_n(:,:,:) 
    825873               neuler = 0 
     
    830878               DO jk=1,jpk 
    831879                  fse3t_n(:,:,jk) =  e3t_0(:,:,jk) * ( ht_0(:,:) + sshn(:,:) ) & 
    832                       &                            / ( ht_0(:,:) + 1._wp - tmask(:,:,1) ) * tmask(:,:,jk) & 
     880                      &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 
    833881                      &            + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk)) 
    834882               END DO 
     
    9641012 
    9651013      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 
     1014      IF( .NOT. ln_vvl_zstar .AND. nn_isf .NE. 0) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' ) 
    9661015 
    9671016      IF(lwp) THEN                   ! Print the choice 
Note: See TracChangeset for help on using the changeset viewer.