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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90

    • Property svn:keywords set to Id
    r4624 r6225  
    44   !! Ocean data  :  read ocean U & V current data from gridded data 
    55   !!====================================================================== 
    6    !! History :  3.5   ! 2013-08  (D. Calvert)  Original code 
    7    !!---------------------------------------------------------------------- 
    8  
    9    !!---------------------------------------------------------------------- 
    10    !!   dta_uvd_init   : read namelist and allocate data structures 
    11    !!   dta_uvd        : read and time-interpolate ocean U & V current data 
    12    !!---------------------------------------------------------------------- 
    13    USE oce             ! ocean dynamics and tracers 
    14    USE dom_oce         ! ocean space and time domain 
    15    USE fldread         ! read input fields 
    16    USE in_out_manager  ! I/O manager 
    17    USE phycst          ! physical constants 
    18    USE lib_mpp         ! MPP library 
    19    USE wrk_nemo        ! Memory allocation 
    20    USE timing          ! Timing 
     6   !! History :  3.5  ! 2013-08  (D. Calvert)  Original code 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   dta_uvd_init  : read namelist and allocate data structures 
     11   !!   dta_uvd       : read and time-interpolate ocean U & V current data 
     12   !!---------------------------------------------------------------------- 
     13   USE oce            ! ocean dynamics and tracers 
     14   USE phycst         ! physical constants 
     15   USE dom_oce        ! ocean space and time domain 
     16   ! 
     17   USE in_out_manager ! I/O manager 
     18   USE fldread        ! read input fields 
     19   USE lib_mpp        ! MPP library 
     20   USE wrk_nemo       ! Memory allocation 
     21   USE timing         ! Timing 
    2122 
    2223   IMPLICIT NONE 
     
    2627   PUBLIC   dta_uvd        ! called by istate.F90 and dyndmp.90 
    2728 
    28    LOGICAL , PUBLIC ::   ln_uvd_init         ! Flag to initialise with U & V current data 
    29    LOGICAL , PUBLIC ::   ln_uvd_dyndmp       ! Flag for Newtonian damping toward U & V current data 
     29   LOGICAL , PUBLIC ::   ln_uvd_init     ! Flag to initialise with U & V current data 
     30   LOGICAL , PUBLIC ::   ln_uvd_dyndmp   ! Flag for Newtonian damping toward U & V current data 
    3031 
    3132   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_uvd   ! structure for input U & V current (file information and data) 
    3233 
    33    !! * Substitutions 
    34 #  include "domzgr_substitute.h90" 
    35    !!---------------------------------------------------------------------- 
    36    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    37    !! $Id: dtauvd.F90 2392 2010-11-15 21:20:05Z gm $  
     34   !!---------------------------------------------------------------------- 
     35   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     36   !! $Id$  
    3837   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3938   !!---------------------------------------------------------------------- 
     
    5049      !!              - fld_fill data structure with namelist information 
    5150      !!---------------------------------------------------------------------- 
    52       LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp         ! force the initialization when dyndmp is used 
    53       ! 
    54       INTEGER ::   ierr0, ierr1, ierr2, ierr3              ! temporary integers 
    55       ! 
    56       CHARACTER(len=100)            ::   cn_dir            ! Root directory for location of files to be used 
    57       TYPE(FLD_N), DIMENSION(2)     ::   suv_i             ! Combined U & V namelist information 
    58       TYPE(FLD_N)                   ::   sn_ucur, sn_vcur  ! U & V data namelist information 
     51      LOGICAL, INTENT(in), OPTIONAL ::   ld_dyndmp   ! force the initialization when dyndmp is used 
     52      ! 
     53      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3     ! local integers 
     54      CHARACTER(len=100)        ::   cn_dir            ! Root directory for location of files to be used 
     55      TYPE(FLD_N), DIMENSION(2) ::   suv_i             ! Combined U & V namelist information 
     56      TYPE(FLD_N)               ::   sn_ucur, sn_vcur  ! U & V data namelist information 
    5957      !! 
    6058      NAMELIST/namc1d_uvd/ ln_uvd_init, ln_uvd_dyndmp, cn_dir, sn_ucur, sn_vcur 
    61       INTEGER  ::   ios 
    62       !!---------------------------------------------------------------------- 
    63       ! 
    64       IF( nn_timing == 1 )  CALL timing_start('dta_uvd_init') 
    65       ! 
    66       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
     59      !!---------------------------------------------------------------------- 
     60      ! 
     61      IF( nn_timing == 1 )   CALL timing_start('dta_uvd_init') 
     62      ! 
     63      ierr0 = 0   ;   ierr1 = 0   ;   ierr2 = 0  ;   ierr3 = 0 
    6764 
    6865      REWIND( numnam_ref )              ! Namelist namc1d_uvd in reference namelist :  
    6966      READ  ( numnam_ref, namc1d_uvd, IOSTAT = ios, ERR = 901) 
    70 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp ) 
    71  
     67901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in reference namelist', lwp ) 
     68      ! 
    7269      REWIND( numnam_cfg )              ! Namelist namc1d_uvd in configuration namelist : Parameters of the run 
    7370      READ  ( numnam_cfg, namc1d_uvd, IOSTAT = ios, ERR = 902 ) 
    74 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp ) 
     71902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namc1d_uvd in configuration namelist', lwp ) 
    7572      IF(lwm) WRITE ( numond, namc1d_uvd ) 
    7673 
     
    149146      !!---------------------------------------------------------------------- 
    150147      ! 
    151       IF( nn_timing == 1 )  CALL timing_start('dta_uvd') 
     148      IF( nn_timing == 1 )   CALL timing_start('dta_uvd') 
    152149      ! 
    153150      CALL fld_read( kt, 1, sf_uvd )      !==   read U & V current data at time step kt   ==! 
    154       ! 
    155       ! 
    156       !                                   !==   ORCA_R2 configuration and U & V current damping   ==!  
    157       IF( cp_cfg == "orca" .AND. jp_cfg == 2 .AND. ln_uvd_dyndmp ) THEN    ! some hand made alterations 
    158          !!! EMPTY- to be added for running in 3D context !!! 
    159       ENDIF 
    160151      ! 
    161152      puvd(:,:,:,1) = sf_uvd(1)%fnow(:,:,:)                 ! NO mask 
     
    164155      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    165156         ! 
    166          CALL wrk_alloc( jpk, zup, zvp ) 
     157         CALL wrk_alloc( jpk,   zup, zvp ) 
    167158         ! 
    168159         IF( kt == nit000 .AND. lwp )THEN 
     
    174165            DO ji = 1, jpi                ! determines the interpolated U & V current profiles at each (i,j) point 
    175166               DO jk = 1, jpk 
    176                   zl = fsdept(ji,jj,jk) 
     167                  zl = gdept_n(ji,jj,jk) 
    177168                  IF    ( zl < gdept_1d(1  ) ) THEN          ! extrapolate above the first level of data 
    178169                     zup(jk) =  puvd(ji,jj,1    ,1) 
     
    200191         END DO 
    201192         !  
    202          CALL wrk_dealloc( jpk, zup, zvp ) 
     193         CALL wrk_dealloc( jpk,   zup, zvp ) 
    203194         !  
    204195      ELSE                                !==   z- or zps- coordinate   ==! 
     
    222213      ENDIF 
    223214      ! 
    224       IF( lwp .AND. kt == nit000 ) THEN   ! control print 
    225          WRITE(numout,*) ' U current ' 
    226          WRITE(numout,*) 
    227          WRITE(numout,*)'  level = 1' 
    228          CALL prihre( puvd(:,:,1    ,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    229          WRITE(numout,*)'  level = ', jpk/2 
    230          CALL prihre( puvd(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    231          WRITE(numout,*)'  level = ', jpkm1 
    232          CALL prihre( puvd(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    233          WRITE(numout,*) 
    234          WRITE(numout,*) ' V current ' 
    235          WRITE(numout,*) 
    236          WRITE(numout,*)'  level = 1' 
    237          CALL prihre( puvd(:,:,1    ,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    238          WRITE(numout,*)'  level = ', jpk/2 
    239          CALL prihre( puvd(:,:,jpk/2,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    240          WRITE(numout,*)'  level = ', jpkm1 
    241          CALL prihre( puvd(:,:,jpkm1,2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    242          WRITE(numout,*) 
    243       ENDIF 
    244       ! 
    245215      IF( .NOT. ln_uvd_dyndmp    ) THEN   !==   deallocate U & V current structure   ==!  
    246216         !                                !==   (data used only for initialization)  ==! 
Note: See TracChangeset for help on using the changeset viewer.