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 9212 for branches/2017 – NEMO

Changeset 9212 for branches/2017


Ignore:
Timestamp:
2018-01-12T10:11:52+01:00 (6 years ago)
Author:
gm
Message:

dev_merge_2017: OFF_SRC/dtadyn.F90 remove the use ua and tsa as work arrays

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r9169 r9212  
    8585   INTEGER, SAVE  :: nprevrec, nsecdyn 
    8686 
    87  
    8887   !!---------------------------------------------------------------------- 
    89    !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     88   !! NEMO/OFF 4.0 , NEMO Consortium (2017) 
    9089   !! $Id$ 
    9190   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    104103      !!             - interpolates data if needed 
    105104      !!---------------------------------------------------------------------- 
    106       USE oce, ONLY:  zhdivtr => ua 
    107105      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     106      ! 
    108107      INTEGER             ::   ji, jj, jk 
    109       REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zemp 
     108      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zemp 
     109      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zhdivtr 
    110110      !!---------------------------------------------------------------------- 
    111111      ! 
     
    138138      ! 
    139139      IF( .NOT.ln_linssh ) THEN 
    140          ALLOCATE( zemp(jpi,jpj) ) 
    141          zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:)    ! effective u-transport 
    142          emp_b (:,:)    = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
    143          zemp   (:,:)   = 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr * tmask(:,:,1) 
     140         ALLOCATE( zemp(jpi,jpj) , zhdivtr(jpi,jpj,jpk) ) 
     141         zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:)  * tmask(:,:,:)    ! effective u-transport 
     142         emp_b  (:,:)   = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1)    ! E-P 
     143         zemp   (:,:)   = ( 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr ) * tmask(:,:,1) 
    144144         CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) )  !=  ssh, vertical scale factor & vertical transport 
    145          DEALLOCATE( zemp ) 
     145         DEALLOCATE( zemp , zhdivtr ) 
    146146         !                                           Write in the tracer restart file 
    147          !                                          ******************************* 
     147         !                                          ********************************* 
    148148         IF( lrst_trc ) THEN 
    149149            IF(lwp) WRITE(numout,*) 
    150             IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file ',   & 
    151                &                    'at it= ', kt,' date= ', ndastp 
    152             IF(lwp) WRITE(numout,*) '~~~~' 
     150            IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file at it= ', kt,' date= ', ndastp 
     151            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    153152            CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssha ) 
    154153            CALL iom_rstput( kt, nitrst, numrtw, 'sshb', sshn ) 
     
    202201      !! ** Purpose :   Initialisation of the dynamical data      
    203202      !! ** Method  : - read the data namdta_dyn namelist 
    204       !! 
    205       !! ** Action  : - read parameters 
    206203      !!---------------------------------------------------------------------- 
    207204      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
     
    222219      TYPE(FLD_N) :: sn_ubl, sn_vbl, sn_rnf    !   "              " 
    223220      TYPE(FLD_N) :: sn_div  ! informations about the fields to be read 
    224  
    225       !!---------------------------------------------------------------------- 
    226       ! 
     221      !! 
    227222      NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth,  fwbcorr, & 
    228          &                sn_uwd, sn_vwd, sn_wwd, sn_emp,    & 
    229          &                sn_avt, sn_tem, sn_sal, sn_mld , sn_qsr ,   & 
    230          &                sn_wnd, sn_ice, sn_fmf,                    & 
    231          &                sn_ubl, sn_vbl, sn_rnf,                   & 
     223         &                sn_uwd, sn_vwd, sn_wwd, sn_emp,               & 
     224         &                sn_avt, sn_tem, sn_sal, sn_mld , sn_qsr ,     & 
     225         &                sn_wnd, sn_ice, sn_fmf,                       & 
     226         &                sn_ubl, sn_vbl, sn_rnf,                       & 
    232227         &                sn_empb, sn_div  
     228      !!---------------------------------------------------------------------- 
    233229      ! 
    234230      REWIND( numnam_ref )              ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 
     
    252248      ENDIF 
    253249      !  
    254  
    255250      jf_uwd  = 1     ;   jf_vwd  = 2    ;   jf_wwd = 3    ;   jf_emp = 4    ;   jf_avt = 5 
    256251      jf_tem  = 6     ;   jf_sal  = 7    ;   jf_mld = 8    ;   jf_qsr = 9 
    257252      jf_wnd  = 10    ;   jf_ice  = 11   ;   jf_fmf = 12   ;   jfld   = jf_fmf 
    258  
    259253      ! 
    260254      slf_d(jf_uwd)  = sn_uwd    ;   slf_d(jf_vwd)  = sn_vwd   ;   slf_d(jf_wwd) = sn_wwd 
     
    263257      slf_d(jf_qsr)  = sn_qsr    ;   slf_d(jf_wnd)  = sn_wnd   ;   slf_d(jf_ice) = sn_ice 
    264258      slf_d(jf_fmf)  = sn_fmf 
    265  
    266259      ! 
    267260      IF( .NOT.ln_linssh ) THEN 
    268                  jf_div  = jfld + 1    ;         jf_empb  = jfld + 2      ;      jfld = jf_empb 
    269            slf_d(jf_div) = sn_div      ;   slf_d(jf_empb) = sn_empb 
     261               jf_div  = jfld + 1   ;         jf_empb  = jfld + 2    ;   jfld = jf_empb 
     262         slf_d(jf_div) = sn_div     ;   slf_d(jf_empb) = sn_empb 
    270263      ENDIF 
    271264      ! 
    272265      IF( ln_trabbl ) THEN 
    273                  jf_ubl  = jfld + 1    ;         jf_vbl  = jfld + 2     ;      jfld = jf_vbl 
    274            slf_d(jf_ubl) = sn_ubl      ;   slf_d(jf_vbl) = sn_vbl 
     266               jf_ubl  = jfld + 1   ;         jf_vbl  = jfld + 2     ;   jfld = jf_vbl 
     267         slf_d(jf_ubl) = sn_ubl     ;   slf_d(jf_vbl) = sn_vbl 
    275268      ENDIF 
    276269      ! 
    277270      IF( ln_dynrnf ) THEN 
    278                 jf_rnf  = jfld + 1     ;     jfld  = jf_rnf 
    279           slf_d(jf_rnf) = sn_rnf     
     271               jf_rnf  = jfld + 1   ;     jfld  = jf_rnf 
     272         slf_d(jf_rnf) = sn_rnf     
    280273      ELSE 
    281274         rnf(:,:) = 0._wp 
    282275      ENDIF 
    283276 
    284    
    285277      ALLOCATE( sf_dyn(jfld), STAT=ierr )         ! set sf structure 
    286278      IF( ierr > 0 )  THEN 
     
    426418   END SUBROUTINE dta_dyn_init 
    427419 
     420 
    428421   SUBROUTINE dta_dyn_swp( kt ) 
    429422     !!--------------------------------------------------------------------- 
    430423      !!                    ***  ROUTINE dta_dyn_swp  *** 
    431424      !! 
    432       !! ** Purpose : Swap and the data and compute the vertical scale factor at U/V/W point 
    433       !!              and the depht 
    434       !! 
     425      !! ** Purpose :   Swap and the data and compute the vertical scale factor  
     426      !!              at U/V/W pointand the depht 
    435427      !!--------------------------------------------------------------------- 
    436428      INTEGER, INTENT(in) :: kt       ! time step 
     429      ! 
    437430      INTEGER             :: ji, jj, jk 
    438431      REAL(wp)            :: zcoef 
    439       ! 
    440432      !!--------------------------------------------------------------------- 
    441433 
     
    471463      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    472464      gdepw_n(:,:,1) = 0.0_wp 
    473  
     465      ! 
    474466      DO jk = 2, jpk 
    475467         DO jj = 1,jpj 
    476468            DO ji = 1,jpi 
    477                  zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    478                  gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
    479                  gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
    480                      &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 
    481               END DO 
    482            END DO 
    483         END DO 
    484  
     469               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
     470               gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
     471               gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
     472                  &                + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 
     473            END DO 
     474         END DO 
     475      END DO 
     476      ! 
    485477      gdept_b(:,:,:) = gdept_n(:,:,:) 
    486478      gdepw_b(:,:,:) = gdepw_n(:,:,:) 
    487  
    488479      ! 
    489480   END SUBROUTINE dta_dyn_swp 
     481    
    490482 
    491483   SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb,  pemp, pssha, pe3ta ) 
     
    510502      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    511503      !!---------------------------------------------------------------------- 
    512       !! * Arguments 
    513504      INTEGER,                                   INTENT(in )    :: kt        !  time-step 
    514505      REAL(wp), DIMENSION(jpi,jpj,jpk)          , INTENT(in )   :: phdivtr   ! horizontal divergence transport 
     
    517508      REAL(wp), DIMENSION(jpi,jpj)    , OPTIONAL, INTENT(inout) :: pssha     ! after ssh 
    518509      REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(out)   :: pe3ta     ! after vertical scale factor 
    519       !! * Local declarations 
     510      ! 
    520511      INTEGER                       :: jk 
    521512      REAL(wp), DIMENSION(jpi,jpj)  :: zhdiv   
    522513      REAL(wp)  :: z2dt   
    523514      !!---------------------------------------------------------------------- 
    524        
    525515      ! 
    526516      z2dt = 2._wp * rdt 
     
    577567      !! 
    578568      !!--------------------------------------------------------------------- 
    579       USE oce, ONLY:  zts => tsa  
    580       ! 
    581569      INTEGER,  INTENT(in) :: kt       ! time step 
    582570      ! 
     
    585573      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    586574      INTEGER  ::   iswap  
    587       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuslp, zvslp, zwslpi, zwslpj 
     575      REAL(wp), DIMENSION(jpi,jpj,jpk)      ::   zuslp, zvslp, zwslpi, zwslpj 
     576      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zts 
    588577      !!--------------------------------------------------------------------- 
    589578      ! 
     
    658647   END SUBROUTINE dta_dyn_slp 
    659648 
     649 
    660650   SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 
    661651      !!--------------------------------------------------------------------- 
    662652      !!                    ***  ROUTINE dta_dyn_slp  *** 
    663653      !! 
    664       !! ** Purpose : Computation of slope 
    665       !! 
     654      !! ** Purpose :   Computation of slope 
    666655      !!--------------------------------------------------------------------- 
    667656      INTEGER ,                              INTENT(in ) :: kt       ! time step 
     
    672661      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(out) :: pwslpj   ! meridional diapycnal slopes 
    673662      !!--------------------------------------------------------------------- 
     663      ! 
    674664      IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace) 
    675665         CALL eos    ( pts, rhd, rhop, gdept_0(:,:,:) ) 
     
    700690      ! 
    701691   END SUBROUTINE compute_slopes 
     692 
    702693   !!====================================================================== 
    703694END MODULE dtadyn 
Note: See TracChangeset for help on using the changeset viewer.