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 5972 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 – NEMO

Ignore:
Timestamp:
2015-12-02T09:52:20+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded to head of trunk (r5936)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r5967 r5972  
    66   !! History :  OPA  ! 1991-03  (O. Marti, G. Madec)  Original code 
    77   !!                 ! 1992-06  (M. Imbard)  doctor norme 
    8    !!                 ! 1996-01  (G. Madec)  statement function for e3 
    9    !!                 ! 1997-05  (G. Madec)  macro-tasked on jk-slab 
    108   !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version 
    11    !!            7.0  ! 2001-02  (M. Imbard)  cofdis, Original code 
     9   !!            7.0  ! 2001-02  (M. Imbard)  add distance to coast, Original code 
    1210   !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning 
    1311   !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules 
     
    1513   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC  
    1614   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys 
     15   !!            3.6  ! 2015-06  (T. Graham)  read restoring coefficient in a file 
     16   !!            3.7  ! 2015-10  (G. Madec)  remove useless trends arrays 
    1717   !!---------------------------------------------------------------------- 
    1818 
     
    4242 
    4343   PUBLIC   tra_dmp      ! routine called by step.F90 
    44    PUBLIC   tra_dmp_init ! routine called by opa.F90 
    45  
    46    !                               !!* Namelist namtra_dmp : T & S newtonian damping * 
    47    ! nn_zdmp and cn_resto are public as they are used by C1D/dyndmp.F90 
    48    LOGICAL , PUBLIC ::   ln_tradmp   !: internal damping flag 
    49    INTEGER , PUBLIC ::   nn_zdmp     ! = 0/1/2 flag for damping in the mixed layer 
    50    CHARACTER(LEN=200) , PUBLIC :: cn_resto      ! name of netcdf file containing restoration coefficient field 
     44   PUBLIC   tra_dmp_init ! routine called by nemogcm.F90 
     45 
     46   !                                           !!* Namelist namtra_dmp : T & S newtonian damping * 
     47   LOGICAL            , PUBLIC ::   ln_tradmp   !: internal damping flag 
     48   INTEGER            , PUBLIC ::   nn_zdmp     !: = 0/1/2 flag for damping in the mixed layer 
     49   CHARACTER(LEN=200) , PUBLIC ::   cn_resto    !: name of netcdf file containing restoration coefficient field 
    5150   ! 
    52  
    53  
    54    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s) 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s) 
    5651   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
    5752 
     
    7065      !!                ***  FUNCTION tra_dmp_alloc  *** 
    7166      !!---------------------------------------------------------------------- 
    72       ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
     67      ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
    7368      ! 
    7469      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
     
    9691      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend 
    9792      !!---------------------------------------------------------------------- 
    98       ! 
    9993      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    100       !! 
    101       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    102       REAL(wp) ::   zta, zsa             ! local scalars 
    103       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta  
    104       !!---------------------------------------------------------------------- 
    105       ! 
    106       IF( nn_timing == 1 )  CALL timing_start( 'tra_dmp') 
    107       ! 
    108       CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta ) 
    109       ! 
    110       !                           !==   input T-S data at kt   ==! 
     94      ! 
     95      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     96      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts 
     97      !!---------------------------------------------------------------------- 
     98      ! 
     99      IF( nn_timing == 1 )   CALL timing_start('tra_dmp') 
     100      ! 
     101      CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta ) 
     102      ! 
     103      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     104         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts )  
     105         ztrdts(:,:,:,:) = tsa(:,:,:,:)  
     106      ENDIF 
     107      !                           !==  input T-S data at kt  ==! 
    111108      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt 
    112109      ! 
    113       SELECT CASE ( nn_zdmp )     !==    type of damping   ==! 
    114       ! 
    115       CASE( 0 )                   !==  newtonian damping throughout the water column  ==! 
    116          DO jk = 1, jpkm1 
    117             DO jj = 2, jpjm1 
    118                DO ji = fs_2, fs_jpim1   ! vector opt. 
    119                   zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
    120                   zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    121                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 
    122                   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    123                   strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj) 
    124                   ttrdmp(ji,jj,jk) = zta       
     110      SELECT CASE ( nn_zdmp )     !==  type of damping  ==! 
     111      ! 
     112      CASE( 0 )                        !*  newtonian damping throughout the water column  *! 
     113         DO jn = 1, jpts 
     114            DO jk = 1, jpkm1 
     115               DO jj = 2, jpjm1 
     116                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     117                     tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) ) 
     118                  END DO 
    125119               END DO 
    126120            END DO 
    127121         END DO 
    128122         ! 
    129       CASE ( 1 )                  !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
     123      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *! 
    130124         DO jk = 1, jpkm1 
    131125            DO jj = 2, jpjm1 
    132126               DO ji = fs_2, fs_jpim1   ! vector opt. 
    133127                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 
    134                      zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
    135                      zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    136                   ELSE 
    137                      zta = 0._wp 
    138                      zsa = 0._wp   
     128                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
     129                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     130                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   & 
     131                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    139132                  ENDIF 
    140                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 
    141                   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    142                   strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj) 
    143                   ttrdmp(ji,jj,jk) = zta 
    144133               END DO 
    145134            END DO 
    146135         END DO 
    147136         ! 
    148       CASE ( 2 )                  !==  no damping in the mixed layer   ==! 
     137      CASE ( 2 )                       !*  no damping in the mixed layer   *! 
    149138         DO jk = 1, jpkm1 
    150139            DO jj = 2, jpjm1 
    151140               DO ji = fs_2, fs_jpim1   ! vector opt. 
    152141                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    153                      zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
    154                      zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    155                   ELSE 
    156                      zta = 0._wp 
    157                      zsa = 0._wp   
     142                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
     143                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     144                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   & 
     145                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    158146                  ENDIF 
    159                   tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 
    160                   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    161                   strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj) 
    162                   ttrdmp(ji,jj,jk) = zta 
    163147               END DO 
    164148            END DO 
     
    168152      ! 
    169153      IF( l_trdtra )   THEN       ! trend diagnostic 
    170          CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ttrdmp ) 
    171          CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, strdmp ) 
     154         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 
     155         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
     156         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
     157         CALL wrk_dealloc( jpi,jpj,jpk,jpts,   ztrdts )  
    172158      ENDIF 
    173159      !                           ! Control print 
     
    175161         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    176162      ! 
    177       CALL wrk_dealloc( jpi, jpj, jpk, jpts,  zts_dta ) 
    178       ! 
    179       IF( nn_timing == 1 )  CALL timing_stop( 'tra_dmp') 
     163      CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta ) 
     164      ! 
     165      IF( nn_timing == 1 )   CALL timing_stop('tra_dmp') 
    180166      ! 
    181167   END SUBROUTINE tra_dmp 
     
    190176      !! ** Method  :   read the namtra_dmp namelist and check the parameters 
    191177      !!---------------------------------------------------------------------- 
     178      INTEGER ::   ios, imask   ! local integers  
     179      !! 
    192180      NAMELIST/namtra_dmp/ ln_tradmp, nn_zdmp, cn_resto 
    193       INTEGER ::  ios         ! Local integer for output status of namelist read 
    194       INTEGER :: imask        ! File handle  
    195       !! 
    196181      !!---------------------------------------------------------------------- 
    197182      ! 
     
    204189902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp ) 
    205190      IF(lwm) WRITE ( numond, namtra_dmp ) 
    206  
    207       IF(lwp) THEN                 !Namelist print 
     191      ! 
     192      IF(lwp) THEN                  ! Namelist print 
    208193         WRITE(numout,*) 
    209194         WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation' 
    210          WRITE(numout,*) '~~~~~~~' 
     195         WRITE(numout,*) '~~~~~~~~~~~' 
    211196         WRITE(numout,*) '   Namelist namtra_dmp : set relaxation parameters' 
    212197         WRITE(numout,*) '      Apply relaxation   or not       ln_tradmp = ', ln_tradmp 
     
    215200         WRITE(numout,*) 
    216201      ENDIF 
    217  
     202      ! 
    218203      IF( ln_tradmp) THEN 
    219          ! 
    220          !Allocate arrays 
     204         !                          ! Allocate arrays 
    221205         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
    222  
    223          !Check values of nn_zdmp 
    224          SELECT CASE (nn_zdmp) 
    225          CASE ( 0 )  ; IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask' 
    226          CASE ( 1 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline' 
    227          CASE ( 2 )  ; IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     206         ! 
     207         SELECT CASE (nn_zdmp)      ! Check values of nn_zdmp 
     208         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping as specified by mask' 
     209         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixing layer (kz > 5 cm2/s)' 
     210         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed  layer' 
     211         CASE DEFAULT 
     212            CALL ctl_stop('tra_dmp_init : wrong value of nn_zdmp') 
    228213         END SELECT 
    229  
    230          !TG: Initialisation of dtatsd - Would it be better to have dmpdta routine 
    231          !so can damp to something other than intitial conditions files? 
     214         ! 
     215         !!TG: Initialisation of dtatsd - Would it be better to have dmpdta routine 
     216         !    so can damp to something other than intitial conditions files? 
     217         !!gm: In principle yes. Nevertheless, we can't anticipate demands that have never been formulated. 
    232218         IF( .NOT.ln_tsd_tradmp ) THEN 
    233             CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' ) 
     219            IF(lwp) WRITE(numout,*) 
     220            IF(lwp) WRITE(numout, *)  '   read T-S data not initialized, we force ln_tsd_tradmp=T' 
    234221            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data 
    235222         ENDIF 
    236  
    237          !initialise arrays - Are these actually used anywhere else? 
    238          strdmp(:,:,:) = 0._wp 
    239          ttrdmp(:,:,:) = 0._wp 
    240  
    241          !Read in mask from file 
     223         !                          ! Read in mask from file 
    242224         CALL iom_open ( cn_resto, imask) 
    243          CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto) 
     225         CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto ) 
    244226         CALL iom_close( imask ) 
    245        ENDIF 
    246  
     227      ENDIF 
     228      ! 
    247229   END SUBROUTINE tra_dmp_init 
    248230 
Note: See TracChangeset for help on using the changeset viewer.