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 5845 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90 – NEMO

Ignore:
Timestamp:
2015-10-31T08:40:45+01:00 (8 years ago)
Author:
gm
Message:

#1613: vvl by default: suppression of domzgr_substitute.h90

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r5505 r5845  
    3030  !!    
    3131  !!---------------------------------------------------------------------- 
    32   !! * Modules used 
    3332  USE oce             ! ocean dynamics and tracers 
    3433  USE dom_oce         ! ocean space and time domain 
     
    5150  PRIVATE 
    5251 
    53   !! * Routine accessibility 
    5452  PUBLIC   dia_dct      ! routine called by step.F90 
    5553  PUBLIC   dia_dct_init ! routine called by opa.F90 
     
    6058  PRIVATE  dia_dct_wri 
    6159 
    62 #include "domzgr_substitute.h90" 
    63  
    64   !! * Shared module variables 
    6560  LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag 
    6661 
    67   !! * Module variables 
    6862  INTEGER :: nn_dct        ! Frequency of computation 
    6963  INTEGER :: nn_dctwri     ! Frequency of output 
     
    112106  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::  transports_2d   
    113107 
     108   !!---------------------------------------------------------------------- 
     109   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    114110   !! $Id$ 
     111   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     112   !!---------------------------------------------------------------------- 
    115113CONTAINS 
    116  
    117114  
    118115  INTEGER FUNCTION diadct_alloc()  
     
    130127  
    131128  END FUNCTION diadct_alloc  
     129 
    132130 
    133131  SUBROUTINE dia_dct_init 
     
    208206     !!               Reinitialise all relevant arrays to zero  
    209207     !!--------------------------------------------------------------------- 
    210      !! * Arguments 
    211      INTEGER,INTENT(IN)        ::kt 
    212  
    213      !! * Local variables 
     208     INTEGER,INTENT(in)        ::kt 
     209     ! 
    214210     INTEGER             :: jsec,            &! loop on sections 
    215211                            itotal            ! nb_sec_max*nb_type_class*nb_class_max 
     
    220216     REAL(wp), POINTER, DIMENSION(:)    :: zwork !   "   
    221217     REAL(wp), POINTER, DIMENSION(:,:,:):: zsum  !   " 
    222  
    223218     !!---------------------------------------------------------------------     
     219     ! 
    224220     IF( nn_timing == 1 )   CALL timing_start('dia_dct') 
    225221 
     
    619615                            zumid_ice, zvmid_ice,                &!U/V ice velocity  
    620616                            zTnorm                                !transport of velocity through one cell's sides  
    621      REAL(wp)            :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep !temperature/salinity/potential density/ssh/depth at u/v point 
     617     REAL(wp)            :: ztn, zsn, zrhoi, zrhop, zsshn, zdep !temperature/salinity/potential density/ssh/depth at u/v point 
    622618 
    623619     TYPE(POINT_SECTION) :: k 
     
    723719              END SELECT  
    724720  
    725               zfsdep= fsdept(k%I,k%J,jk)  
     721              zdep= gdept_n(k%I,k%J,jk)  
    726722   
    727723              !compute velocity with the correct direction  
     
    737733              !zTnorm=transport through one cell;  
    738734              !velocity* cell's length * cell's thickness  
    739               zTnorm=zumid*e2u(k%I,k%J)*  fse3u(k%I,k%J,jk)+     &  
    740                      zvmid*e1v(k%I,k%J)*  fse3v(k%I,k%J,jk)  
     735              zTnorm=zumid*e2u(k%I,k%J)*  e3u_n(k%I,k%J,jk)+     &  
     736                     zvmid*e1v(k%I,k%J)*  e3v_n(k%I,k%J,jk)  
    741737 
    742738#if ! defined key_vvl 
     
    828824     !!  
    829825     !!-------------------------------------------------------------  
    830      !! * arguments  
    831826     TYPE(SECTION),INTENT(INOUT) :: sec  
    832827     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section  
     
    834829     TYPE(POINT_SECTION) :: k  
    835830     INTEGER  :: jk,jseg,jclass                        ! dummy variables for looping on level/segment/classes   
    836      REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point  
     831     REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep ! temperature/salinity/ssh/potential density /depth at u/v point  
    837832     !!-------------------------------------------------------------  
    838833  
     
    903898              END SELECT  
    904899  
    905               zfsdep= fsdept(k%I,k%J,jk)  
     900              zdep= gdept_n(k%I,k%J,jk)  
    906901   
    907902              !-------------------------------  
     
    932927                    ( sec%ztem(jclass) .EQ.99.)) .AND.                     &  
    933928  
    934                     ((( zfsdep .GE. sec%zlay(jclass)) .AND.                &  
    935                     (   zfsdep .LE. sec%zlay(jclass+1))) .OR.              &  
     929                    ((( zdep .GE. sec%zlay(jclass)) .AND.                &  
     930                    (   zdep .LE. sec%zlay(jclass+1))) .OR.              &  
    936931                    ( sec%zlay(jclass) .EQ. 99. ))                         &  
    937932                                                                   ))   THEN  
     
    11441139 
    11451140     CALL wrk_dealloc(nb_type_class , zsumclasses )   
     1141     ! 
    11461142  END SUBROUTINE dia_dct_wri 
     1143 
    11471144 
    11481145  FUNCTION interp(ki, kj, kk, cd_point, ptab) 
     
    12141211  !*local declations 
    12151212  INTEGER :: ii1, ij1, ii2, ij2                                ! local integer 
    1216   REAL(wp):: ze3t, zfse3, zwgt1, zwgt2, zbis, zdepu            ! local real 
     1213  REAL(wp):: ze3t, ze3, zwgt1, zwgt2, zbis, zdepu            ! local real 
    12171214  REAL(wp):: zet1, zet2                                        ! weight for interpolation  
    12181215  REAL(wp):: zdep1,zdep2                                       ! differences of depth 
     
    12411238  IF( ln_sco )THEN   ! s-coordinate case 
    12421239 
    1243      zdepu = ( fsdept(ii1,ij1,kk) +  fsdept(ii2,ij2,kk) ) /2  
    1244      zdep1 = fsdept(ii1,ij1,kk) - zdepu 
    1245      zdep2 = fsdept(ii2,ij2,kk) - zdepu 
     1240     zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp  
     1241     zdep1 = gdept_n(ii1,ij1,kk) - zdepu 
     1242     zdep2 = gdept_n(ii2,ij2,kk) - zdepu 
    12461243 
    12471244     ! weights 
     
    12551252  ELSE       ! full step or partial step case  
    12561253 
    1257 #if defined key_vvl 
    1258  
    1259      ze3t  = fse3t_n(ii2,ij2,kk) - fse3t_n(ii1,ij1,kk)  
    1260      zwgt1 = ( fse3w_n(ii2,ij2,kk) - fse3w_n(ii1,ij1,kk) ) / fse3w_n(ii2,ij2,kk) 
    1261      zwgt2 = ( fse3w_n(ii1,ij1,kk) - fse3w_n(ii2,ij2,kk) ) / fse3w_n(ii1,ij1,kk) 
    1262  
    1263 #else 
    1264  
    1265      ze3t  = fse3t(ii2,ij2,kk)   - fse3t(ii1,ij1,kk)  
    1266      zwgt1 = ( fse3w(ii2,ij2,kk) - fse3w(ii1,ij1,kk) ) / fse3w(ii2,ij2,kk) 
    1267      zwgt2 = ( fse3w(ii1,ij1,kk) - fse3w(ii2,ij2,kk) ) / fse3w(ii1,ij1,kk) 
    1268  
    1269 #endif 
     1254     ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk)  
     1255     zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk) 
     1256     zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk) 
    12701257 
    12711258     IF(kk .NE. 1)THEN 
     
    12881275 
    12891276  ENDIF 
    1290  
    1291  
    1292   END FUNCTION interp 
     1277      ! 
     1278   END FUNCTION interp 
    12931279 
    12941280#else 
Note: See TracChangeset for help on using the changeset viewer.