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 4448 for branches – NEMO

Changeset 4448 for branches


Ignore:
Timestamp:
2014-02-04T13:16:06+01:00 (10 years ago)
Author:
trackstand2
Message:

Changes for z-first in dynvor.F90. Unoptimised.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r4424 r4448  
    566566      !!---------------------------------------------------------------------- 
    567567      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     568#if defined key_z_first 
     569!FTRANS zwx :I :I :z 
     570!FTRANS zwy :I :I :z 
     571!FTRANS zwz :I :I :z 
     572!FTRANS ztnw :I :I :z 
     573!FTRANS ztne :I :I :z 
     574!FTRANS ztsw :I :I :z 
     575!FTRANS ztse :I :I :z 
     576      USE wrk_nemo, ONLY:   zwx  => wrk_3d_8 , zwy  => wrk_3d_2 ,  zwz => wrk_3d_3     ! 2D workspace 
     577      USE wrk_nemo, ONLY:   ztnw => wrk_3d_4 , ztne => wrk_3d_5  
     578      USE wrk_nemo, ONLY:   ztsw => wrk_3d_6 , ztse => wrk_3d_7 
     579#else 
    568580      USE wrk_nemo, ONLY:   zwx  => wrk_2d_1 , zwy  => wrk_2d_2 ,  zwz => wrk_2d_3     ! 2D workspace 
    569581      USE wrk_nemo, ONLY:   ztnw => wrk_2d_4 , ztne => wrk_2d_5  
    570582      USE wrk_nemo, ONLY:   ztsw => wrk_2d_6 , ztse => wrk_2d_7 
     583#endif 
    571584#if defined key_vvl 
    572585!FTRANS ze3f :I :I :z 
     
    580593!FTRANS pva :I :I :z 
    581594!! DCSE_NEMO: work around a deficiency in ftrans 
    582 !     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pua    ! total u-trend 
    583 !     REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend 
    584       REAL(wp), INTENT(inout) ::   pua(jpi,jpj,jpkorig)    ! total u-trend 
     595      REAL(wp), INTENT(inout) ::   pua(jpi,jpj,jpkorig)   ! total u-trend 
    585596      REAL(wp), INTENT(inout) ::   pva(jpi,jpj,jpkorig)   ! total v-trend 
    586597      !! 
     
    594605      !!---------------------------------------------------------------------- 
    595606 
     607#if defined key_z_first 
     608      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8) ) THEN 
     609#else 
    596610      IF( wrk_in_use(2, 1,2,3,4,5,6,7) .OR. wrk_in_use(3, 1) ) THEN 
     611#endif 
    597612         CALL ctl_stop('dyn:vor_een: requested workspace arrays unavailable')   ;   RETURN 
    598613      ENDIF 
     
    610625 
    611626      IF( kt == nit000 .OR. lk_vvl ) THEN      ! reciprocal of e3 at F-point (masked averaging of e3t) 
     627#if defined key_z_first 
     628         DO jj = 1, jpjm1 
     629            DO ji = 1, jpim1 
     630               DO jk = 1, jpk 
     631#else 
    612632         DO jk = 1, jpk 
    613633            DO jj = 1, jpjm1 
    614634               DO ji = 1, jpim1 
     635#endif 
    615636                  ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    616637                     &             + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * 0.25 
     
    624645      zfac12 = 1._wp / 12._wp    ! Local constant initialization 
    625646 
     647#if defined key_z_first 
     648!      DO jk = 1, jpkm1 
     649          
     650         ! Potential vorticity and horizontal fluxes 
     651         ! ----------------------------------------- 
     652         SELECT CASE( kvor )      ! vorticity considered 
     653         CASE ( 1 )                                                ! planetary vorticity (Coriolis) 
     654            DO jk = 1, jpkm1 
     655               zwz(:,:,jk) = ff(:,:)      * ze3f(:,:,jk) 
     656            END DO 
     657         CASE ( 2 )                                                ! relative  vorticity 
     658            DO jk = 1, jpkm1 
     659               zwz(:,:,jk) = rotn(:,:,jk) * ze3f(:,:,jk) 
     660            END DO 
     661         CASE ( 3 )                                                ! metric term 
     662            DO jj = 1, jpjm1 
     663               DO ji = 1, jpim1  
     664                  DO jk = 1, jpkm1 
     665                     zwz(ji,jj,jk) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) ) & 
     666                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     667                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 
     668                  END DO 
     669               END DO 
     670            END DO 
     671            CALL lbc_lnk( zwz, 'F', 1. ) 
     672         CASE ( 4 )                                                ! total (relative + planetary vorticity) 
     673            DO jk = 1, jpkm1 
     674               zwz(:,:,jk) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 
     675            END DO 
     676         CASE ( 5 )                                                ! total (coriolis + metric) 
     677            DO jj = 1, jpjm1 
     678               DO ji = 1, fs_jpim1   ! vector opt. 
     679                  DO jk = 1, jpkm1 
     680                     zwz(ji,jj,jk) = ( ff (ji,jj)                                                                 & 
     681                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
     682                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
     683                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                & 
     684                       &       ) * ze3f(ji,jj,jk) 
     685                  END DO 
     686               END DO 
     687            END DO 
     688            CALL lbc_lnk( zwz, 'F', 1. ) 
     689         END SELECT 
     690 
     691         DO jj = 1, jpj, 1 
     692            DO ji = 1, jpi, 1 
     693               DO jk = 1, jpkm1 
     694                  zwx(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 
     695                  zwy(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 
     696               END DO 
     697            END DO 
     698         END DO 
     699 
     700         ! Compute and add the vorticity term trend 
     701         ! ---------------------------------------- 
     702         jj = 2 
     703         ztne(1,:,:) = 0   ;   ztnw(1,:,:) = 0   ;   ztse(1,:,:) = 0   ;   ztsw(1,:,:) = 0 
     704         DO ji = 2, jpi    
     705               DO jk = 1, jpkm1 
     706                  ztne(ji,jj,jk) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
     707                  ztnw(ji,jj,jk) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
     708                  ztse(ji,jj,jk) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
     709                  ztsw(ji,jj,jk) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
     710               END DO 
     711         END DO 
     712         DO jj = 3, jpj 
     713            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3 
     714               DO jk = 1, jpkm1 
     715                  ztne(ji,jj,jk) = zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) 
     716                  ztnw(ji,jj,jk) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) 
     717                  ztse(ji,jj,jk) = zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) 
     718                  ztsw(ji,jj,jk) = zwz(ji  ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) 
     719               END DO 
     720            END DO 
     721         END DO 
     722         DO jj = 2, jpjm1 
     723            DO ji = fs_2, jpim1 
     724               DO jk = 1, jpkm1 
     725                  zua = + zfac12 / e1u(ji,jj) * (  ztne(ji,jj  ,jk) * zwy(ji  ,jj  ,jk) + & 
     726                          ztnw(ji+1,jj,jk) * zwy(ji+1,jj  ,jk)   & 
     727                  &     + ztse(ji,jj  ,jk) * zwy(ji  ,jj-1,jk) + ztsw(ji+1,jj,jk) * zwy(ji+1,jj-1,jk) ) 
     728                  zva = - zfac12 / e2v(ji,jj) * (  ztsw(ji,jj+1,jk) * zwx(ji-1,jj+1,jk) + & 
     729                          ztse(ji,jj+1,jk) * zwx(ji  ,jj+1,jk)   & 
     730                  &     + ztnw(ji,jj  ,jk) * zwx(ji-1,jj  ,jk) + ztne(ji,jj  ,jk) * zwx(ji  ,jj  ,jk) ) 
     731                  pua(ji,jj,jk) = pua(ji,jj,jk) + zua 
     732                  pva(ji,jj,jk) = pva(ji,jj,jk) + zva 
     733               END DO 
     734            END DO   
     735         END DO   
     736 
     737!      END DO 
     738 
     739#else 
    626740!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 
    627741      !                                                ! =============== 
     
    694808      END DO                                           !   End of slab 
    695809      !                                                ! =============== 
     810#endif 
     811 
     812#if defined key_z_first 
     813      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('dyn:vor_een: failed to release workspace arrays') 
     814#else 
    696815      IF( wrk_not_released(2, 1,2,3,4,5,6,7) .OR.   & 
    697816          wrk_not_released(3, 1)             )   CALL ctl_stop('dyn:vor_een: failed to release workspace arrays') 
     817#endif 
    698818      ! 
    699819   END SUBROUTINE vor_een 
Note: See TracChangeset for help on using the changeset viewer.