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 2762 – NEMO

Changeset 2762


Ignore:
Timestamp:
2011-05-04T10:25:35+02:00 (13 years ago)
Author:
cetlod
Message:

modify dtadyn.F90 routine to be used without key_ldfslp, see ticket #822

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r2715 r2762  
    7878   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:,:) :: bblydta    ! frequency of bbl in the y direction at 2 consecutive times  
    7979   LOGICAL :: l_offbbl 
    80 #if defined key_ldfslp 
     80#if defined key_ldfslp && ! defined key_c1d 
    8181   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta    ! zonal isopycnal slopes 
    8282   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta    ! meridional isopycnal slopes 
     
    158158         ! 
    159159         CALL dynrea( kt, MAX( 1, iperm1) )           ! data read for the iperm1 period 
    160           
    161          IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN      ! Computes slopes (here tsn and avt are used as workspace) 
    162             tsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
    163             tsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
    164             avt(:,:,:)         = avtdta(:,:,:,2) 
    165           
    166             CALL eos( tsn, rhd, rhop )   ! Time-filtered in situ density  
    167             CALL bn2( tsn, rn2 )         ! before Brunt-Vaisala frequency 
    168             IF( ln_zps )   & 
    169                &   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
    170                &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level 
    171             CALL zdf_mxl( kt )           ! mixed layer depth 
    172             CALL ldf_slp( kt, rhd, rn2 ) 
    173           
    174             uslpdta (:,:,:,2) = uslp (:,:,:) 
    175             vslpdta (:,:,:,2) = vslp (:,:,:) 
    176             wslpidta(:,:,:,2) = wslpi(:,:,:) 
    177             wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    178          END IF 
    179160         ! 
    180161         CALL swap_dyn_data            ! swap from record 2 to 1 
     
    183164         ! 
    184165         CALL dynrea( kt, iper )       ! data read for the iper period 
    185          ! 
    186          IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN      ! Computes slopes (here tsn and avt are used as workspace) 
    187             tsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
    188             tsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
    189             avt(:,:,:)         = avtdta(:,:,:,2) 
    190             ! 
    191                            CALL eos( tsn, rhd, rhop )                   ! now in situ density  
    192                            CALL bn2( tsn, rn2 )                         ! now Brunt-Vaisala frequency 
    193             IF( ln_zps )   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
    194                &                                   rhd, gru , grv   )   ! of t, s, rd at the bottom ocean level 
    195                            CALL zdf_mxl( kt )                           ! mixed layer depth 
    196                            CALL ldf_slp( kt, rhd, rn2 )                 ! slope of iso-neutral surfaces 
    197             ! 
    198             uslpdta (:,:,:,2) = uslp (:,:,:) 
    199             vslpdta (:,:,:,2) = vslp (:,:,:) 
    200             wslpidta(:,:,:,2) = wslpi(:,:,:) 
    201             wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    202          END IF 
    203166         ! 
    204167         lfirdyn = .FALSE.    ! trace the first call 
     
    226189         CALL dynrea( kt, iper )    ! data read for the iper period 
    227190         ! 
    228          IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 
    229             ! Computes slopes. Caution : here tsn and avt are used as workspace 
    230             tsn(:,:,:,jp_tem) = tdta  (:,:,:,2) 
    231             tsn(:,:,:,jp_sal) = sdta  (:,:,:,2) 
    232             avt(:,:,:)        = avtdta(:,:,:,2) 
    233             ! 
    234                            CALL eos( tsn, rhd, rhop )                   ! now in situ density  
    235                            CALL bn2( tsn, rn2 )                         ! now Brunt-Vaisala frequency 
    236             IF( ln_zps )   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
    237                &                                   rhd, gru , grv   )   ! of t, s, rd at the bottom ocean level 
    238             CALL zdf_mxl( kt )                                          ! mixed layer depth 
    239             CALL ldf_slp( kt, rhd, rn2 )                                ! slope of iso-neutral surfaces 
    240             ! 
    241             uslpdta (:,:,:,2) = uslp (:,:,:) 
    242             vslpdta (:,:,:,2) = vslp (:,:,:) 
    243             wslpidta(:,:,:,2) = wslpi(:,:,:) 
    244             wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    245          END IF 
    246          ! 
    247191         ndyn1 = ndyn2         ! store the information of the period read 
    248192         ndyn2 = iper 
     
    280224         CALL bbl( kt, 'TRC') 
    281225      END IF 
     226      ! 
    282227      IF(ln_ctl) THEN 
    283228         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     
    305250         &      udta    (jpi,jpj,jpk,2), vdta    (jpi,jpj,jpk,2),    & 
    306251         &      wdta    (jpi,jpj,jpk,2), avtdta  (jpi,jpj,jpk,2),    & 
    307 #if defined key_ldfslp  
     252#if defined key_ldfslp && ! defined key_c1d 
    308253         &      uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2),    & 
    309254         &      wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2),    & 
     
    338283      !!---------------------------------------------------------------------- 
    339284      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    340       USE wrk_nemo, ONLY: zu    => wrk_3d_1 , zv    => wrk_3d_2 , zw    => wrk_3d_3 
    341       USE wrk_nemo, ONLY: zt    => wrk_3d_4 , zs    => wrk_3d_5 
    342       USE wrk_nemo, ONLY: zavt  => wrk_3d_6 , zhdiv => wrk_3d_7 
    343       USE wrk_nemo, ONLY: zahtu => wrk_3d_8 , zahtv => wrk_3d_9 , zahtw => wrk_3d_10 
    344       USE wrk_nemo, ONLY: zaeiu => wrk_3d_11, zaeiv => wrk_3d_12, zaeiw => wrk_3d_13 
    345       ! 
    346       USE wrk_nemo, ONLY: zemp  => wrk_2d_1 , zqsr  => wrk_2d_2 , zmld  => wrk_2d_3 
    347       USE wrk_nemo, ONLY: zice  => wrk_2d_4 , zwspd => wrk_2d_5  
    348       USE wrk_nemo, ONLY: ztaux => wrk_2d_6 , ztauy => wrk_2d_7 
    349       USE wrk_nemo, ONLY: zbblx => wrk_2d_8 , zbbly => wrk_2d_9 
     285      USE wrk_nemo, ONLY: zu      => wrk_3d_3  , zv    => wrk_3d_4 , zw   => wrk_3d_5 
     286      USE wrk_nemo, ONLY: zt      => wrk_3d_6  , zs    => wrk_3d_7 , zavt => wrk_3d_8   
     287      USE wrk_nemo, ONLY: zemp    => wrk_2d_11 , zqsr  => wrk_2d_12, zmld => wrk_2d_13 
     288      USE wrk_nemo, ONLY: zice    => wrk_2d_14 , zwspd => wrk_2d_15  
     289      USE wrk_nemo, ONLY: ztaux   => wrk_2d_16 , ztauy => wrk_2d_17 
     290      USE wrk_nemo, ONLY: zbblx   => wrk_2d_18 , zbbly => wrk_2d_19 
    350291      USE wrk_nemo, ONLY: zaeiw2d => wrk_2d_10 
     292      USE wrk_nemo, ONLY: ztsn    => wrk_4d_1 
    351293      ! 
    352294      INTEGER, INTENT(in) ::   kt, kenr   ! time index 
    353295      !! 
    354296      INTEGER ::  jkenr 
     297#if defined key_degrad 
     298      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zahtu, zahtv, zahtw   ! Lateral diffusivity 
     299# if defined key_traldf_eiv 
     300      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zaeiu, zaeiv, zaeiw   ! G&M coefficient 
     301# endif 
     302#endif 
    355303      !!---------------------------------------------------------------------- 
    356304      !  
    357       IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
    358           wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
     305      IF( wrk_in_use(3, 3,4,5,6,7,8) .OR. & 
     306          wrk_in_use(4, 1)                             .OR. & 
     307          wrk_in_use(2, 10,11,12,13,14,15,16,17,18,19)               ) THEN 
    359308         CALL ctl_stop('domrea/dta_dyn: requested workspace arrays unavailable')   ;   RETURN 
    360309      ENDIF 
     310 
     311#if defined key_degrad 
     312      ALLOCATE( zahtu(jpi,jpj,jpk), zahtv(jpi,jpj,jpk), zahtw(jpi,jpj,jpk) )  
     313# if defined key_traldf_eiv 
     314      ALLOCATE( zaeiu(jpi,jpj,jpk), zaeiv(jpi,jpj,jpk), zaeiw(jpi,jpj,jpk) ) 
     315# endif 
     316#endif 
    361317       
    362318      ! cas d'un fichier non periodique : on utilise deux fois le premier et 
     
    414370 
    415371      ! file grid-W 
    416 !!      CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw   (:,:,:), jkenr ) 
     372      ! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw   (:,:,:), jkenr ) 
    417373      ! Computation of vertical velocity using horizontal divergence 
    418       CALL wzv( zu, zv, zw, zhdiv ) 
     374      CALL wzv( zu, zv, zw ) 
    419375 
    420376      IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN          ! avs exist: it is used 
     
    439395#endif 
    440396 
    441       udta(:,:,:,2) = zu(:,:,:) * umask(:,:,:) 
    442       vdta(:,:,:,2) = zv(:,:,:) * vmask(:,:,:)  
    443       wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
    444  
    445       tdta(:,:,:,2)   = zt  (:,:,:) * tmask(:,:,:) 
    446       sdta(:,:,:,2)   = zs  (:,:,:) * tmask(:,:,:) 
     397      udta  (:,:,:,2) = zu  (:,:,:) * umask(:,:,:) 
     398      vdta  (:,:,:,2) = zv  (:,:,:) * vmask(:,:,:)  
     399      wdta  (:,:,:,2) = zw  (:,:,:) * tmask(:,:,:) 
     400      tdta  (:,:,:,2) = zt  (:,:,:) * tmask(:,:,:) 
     401      sdta  (:,:,:,2) = zs  (:,:,:) * tmask(:,:,:) 
    447402      avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 
     403 
     404#if defined key_ldfslp && ! defined key_c1d 
     405      ! Computes slopes (here tsn and avt are used as workspace) 
     406      ztsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
     407      ztsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
     408      avt(:,:,:)          = avtdta(:,:,:,2) 
     409       
     410      CALL eos( ztsn, rhd, rhop )   ! Time-filtered in situ density  
     411      CALL bn2( ztsn, rn2 )         ! before Brunt-Vaisala frequency 
     412      IF( ln_zps )   & 
     413         &   CALL zps_hde( kt, jpts, ztsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
     414         &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level 
     415      CALL zdf_mxl( kt )           ! mixed layer depth 
     416      CALL ldf_slp( kt, rhd, rn2 ) 
     417          
     418      uslpdta (:,:,:,2) = uslp (:,:,:) 
     419      vslpdta (:,:,:,2) = vslp (:,:,:) 
     420      wslpidta(:,:,:,2) = wslpi(:,:,:) 
     421      wslpjdta(:,:,:,2) = wslpj(:,:,:) 
     422#endif 
    448423 
    449424#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
     
    486461      ENDIF 
    487462      !       
    488       IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10,11,12,13) .OR. & 
    489           wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10)               ) THEN 
     463      IF( wrk_not_released(3, 3,4,5,6,7,8) .OR. & 
     464          wrk_not_released(4, 1                            ) .OR. & 
     465          wrk_not_released(2, 10,11,12,13,14,15,16,17,18,19)                ) THEN 
    490466         CALL ctl_stop('domrea/dta_dyn: failed to release workspace arrays') 
    491467      END IF 
     468#if defined key_degrad 
     469      DEALLOCATE( zahtu )   ;   DEALLOCATE( zahtv )   ;   DEALLOCATE( zahtw ) 
     470# if defined key_traldf_eiv 
     471      DEALLOCATE( zaeiu )   ;   DEALLOCATE( zaeiv )   ;   DEALLOCATE( zaeiw ) 
     472# endif 
     473#endif 
    492474      ! 
    493475   END SUBROUTINE dynrea 
     
    540522 
    541523 
    542    SUBROUTINE wzv( pu, pv, pw, phdiv ) 
     524   SUBROUTINE wzv( pu, pv, pw ) 
    543525      !!---------------------------------------------------------------------- 
    544526      !!                    ***  ROUTINE wzv  *** 
     
    556538      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities 
    557539      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  verticla velocity 
    558       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv     !:  horizontal divergence 
    559540      !! 
    560541      INTEGER  ::  ji, jj, jk 
    561542      REAL(wp) ::  zu, zu1, zv, zv1, zet 
     543      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhdiv     !:  horizontal divergence 
    562544      !!---------------------------------------------------------------------- 
    563545      ! 
    564546      ! Computation of vertical velocity using horizontal divergence 
    565       phdiv(:,:,:) = 0. 
     547      zhdiv(:,:,:) = 0. 
    566548      DO jk = 1, jpkm1 
    567549         DO jj = 2, jpjm1 
     
    572554               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) 
    573555               zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    574                phdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet  
     556               zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet  
    575557            END DO 
    576558         END DO 
    577559      END DO 
    578       CALL lbc_lnk( phdiv, 'T', 1. )      ! Lateral boundary conditions on phdiv 
     560      CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv 
    579561      ! 
    580562      ! computation of vertical velocity from the bottom 
    581563      pw(:,:,jpk) = 0._wp 
    582564      DO jk = jpkm1, 1, -1 
    583          pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * phdiv(:,:,jk) 
     565         pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk) 
    584566      END DO 
    585567      ! 
Note: See TracChangeset for help on using the changeset viewer.