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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/C1D/dyndmp.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/C1D/dyndmp.F90

    r10425 r13463  
    4343 
    4444   !! * Substitutions 
    45 #  include "vectopt_loop_substitute.h90" 
     45#  include "do_loop_substitute.h90" 
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
    81       REWIND( numnam_ref )              ! Namelist namc1d_dyndmp in reference namelist :  
    8281      READ  ( numnam_ref, namc1d_dyndmp, IOSTAT = ios, ERR = 901) 
    83 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist', lwp ) 
    84       REWIND( numnam_cfg )              ! Namelist namc1d_dyndmp in configuration namelist : Parameters of the run 
     82901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in reference namelist' ) 
    8583      READ  ( numnam_cfg, namc1d_dyndmp, IOSTAT = ios, ERR = 902 ) 
    86 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist', lwp ) 
     84902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namc1d_dyndmp in configuration namelist' ) 
    8785      IF(lwm) WRITE ( numond, namc1d_dyndmp ) 
    8886      ! 
     
    123121         !Read in mask from file 
    124122         CALL iom_open ( cn_resto, imask) 
    125          CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto) 
     123         CALL iom_get  ( imask, jpdom_auto, 'resto', resto) 
    126124         CALL iom_close( imask ) 
    127125      ENDIF 
     
    130128 
    131129 
    132    SUBROUTINE dyn_dmp( kt ) 
     130   SUBROUTINE dyn_dmp( kt, Kbb, Kmm, puu, pvv, Krhs ) 
    133131      !!---------------------------------------------------------------------- 
    134132      !!                   ***  ROUTINE dyn_dmp  *** 
     
    140138      !! ** Method  :   Compute Newtonian damping towards u_dta and v_dta  
    141139      !!      and add to the general momentum trends: 
    142       !!                     ua = ua + resto_uv * (u_dta - ub) 
    143       !!                     va = va + resto_uv * (v_dta - vb) 
     140      !!                     puu(Krhs) = puu(Krhs) + resto_uv * (u_dta - puu(Kbb)) 
     141      !!                     pvv(Krhs) = pvv(Krhs) + resto_uv * (v_dta - pvv(Kbb)) 
    144142      !!      The trend is computed either throughout the water column 
    145143      !!      (nn_zdmp=0), where the vertical mixing is weak (nn_zdmp=1) or 
    146144      !!      below the well mixed layer (nn_zdmp=2) 
    147145      !! 
    148       !! ** Action  : - (ua,va)   momentum trends updated with the damping trend 
    149       !!---------------------------------------------------------------------- 
    150       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     146      !! ** Action  : - (puu(:,:,:,Krhs),pvv(:,:,:,Krhs))   momentum trends updated with the damping trend 
     147      !!---------------------------------------------------------------------- 
     148      INTEGER                             , INTENT(in   ) ::   kt             ! ocean time-step index 
     149      INTEGER                             , INTENT(in   ) ::   Kbb, Kmm, Krhs ! ocean time level indices 
     150      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv       ! ocean velocities and RHS of momentum equation 
    151151      !! 
    152152      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    159159      ! 
    160160      !                           !==   read and interpolate U & V current data at kt   ==! 
    161       CALL dta_uvd( kt, zuv_dta ) !!! NOTE: This subroutine must be altered for use outside 
     161      CALL dta_uvd( kt, Kmm, zuv_dta ) !!! NOTE: This subroutine must be altered for use outside 
    162162                                  !!!       the C1D context (use of U,V grid variables) 
    163163      ! 
     
    165165      ! 
    166166      CASE( 0 )                   ! Newtonian damping throughout the water column 
    167          DO jk = 1, jpkm1 
    168             DO jj = 2, jpjm1 
    169                DO ji = fs_2, fs_jpim1   ! vector opt. 
    170                   zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) ) 
    171                   zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) ) 
    172                   ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    173                   va(ji,jj,jk) = va(ji,jj,jk) + zva 
    174                   utrdmp(ji,jj,jk) = zua           ! save the trends 
    175                   vtrdmp(ji,jj,jk) = zva       
    176                END DO 
    177             END DO 
    178          END DO 
     167         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     168            zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) ) 
     169            zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - pvv(ji,jj,jk,Kbb) ) 
     170            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zua 
     171            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zva 
     172            utrdmp(ji,jj,jk) = zua           ! save the trends 
     173            vtrdmp(ji,jj,jk) = zva       
     174         END_3D 
    179175         ! 
    180176      CASE ( 1 )                  ! no damping above the turbocline (avt > 5 cm2/s) 
    181          DO jk = 1, jpkm1 
    182             DO jj = 2, jpjm1 
    183                DO ji = fs_2, fs_jpim1   ! vector opt. 
    184                   IF( avt(ji,jj,jk) <= avt_c ) THEN 
    185                      zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) ) 
    186                      zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) ) 
    187                   ELSE 
    188                      zua = 0._wp 
    189                      zva = 0._wp   
    190                   ENDIF 
    191                   ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    192                   va(ji,jj,jk) = va(ji,jj,jk) + zva 
    193                   utrdmp(ji,jj,jk) = zua           ! save the trends 
    194                   vtrdmp(ji,jj,jk) = zva 
    195                END DO 
    196             END DO 
    197          END DO 
     177         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     178            IF( avt(ji,jj,jk) <= avt_c ) THEN 
     179               zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) ) 
     180               zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - pvv(ji,jj,jk,Kbb) ) 
     181            ELSE 
     182               zua = 0._wp 
     183               zva = 0._wp   
     184            ENDIF 
     185            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zua 
     186            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zva 
     187            utrdmp(ji,jj,jk) = zua           ! save the trends 
     188            vtrdmp(ji,jj,jk) = zva 
     189         END_3D 
    198190         ! 
    199191      CASE ( 2 )                  ! no damping in the mixed layer 
    200          DO jk = 1, jpkm1 
    201             DO jj = 2, jpjm1 
    202                DO ji = fs_2, fs_jpim1   ! vector opt. 
    203                   IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    204                      zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - ub(ji,jj,jk) ) 
    205                      zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - vb(ji,jj,jk) ) 
    206                   ELSE 
    207                      zua = 0._wp 
    208                      zva = 0._wp   
    209                   ENDIF 
    210                   ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    211                   va(ji,jj,jk) = va(ji,jj,jk) + zva 
    212                   utrdmp(ji,jj,jk) = zua           ! save the trends 
    213                   vtrdmp(ji,jj,jk) = zva 
    214                END DO 
    215             END DO 
    216          END DO 
     192         DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     193            IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 
     194               zua = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,1) - puu(ji,jj,jk,Kbb) ) 
     195               zva = resto_uv(ji,jj,jk) * ( zuv_dta(ji,jj,jk,2) - pvv(ji,jj,jk,Kbb) ) 
     196            ELSE 
     197               zua = 0._wp 
     198               zva = 0._wp   
     199            ENDIF 
     200            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zua 
     201            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zva 
     202            utrdmp(ji,jj,jk) = zua           ! save the trends 
     203            vtrdmp(ji,jj,jk) = zva 
     204         END_3D 
    217205         ! 
    218206      END SELECT 
    219207      ! 
    220208      !                           ! Control print 
    221       IF( ln_ctl   )   CALL prt_ctl( tab3d_1=ua(:,:,:), clinfo1=' dmp  - Ua: ', mask1=umask,   & 
    222          &                           tab3d_2=va(:,:,:), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     209      IF( sn_cfctl%l_prtctl   )   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' dmp  - Ua: ', mask1=umask,   & 
     210         &                                      tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    223211      ! 
    224212      ! 
Note: See TracChangeset for help on using the changeset viewer.