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 2789 for branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90 – NEMO

Ignore:
Timestamp:
2011-06-27T13:18:25+02:00 (13 years ago)
Author:
cetlod
Message:

Implementation of the merge of TRA/TRP : first guess, see ticket #842

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r2715 r2789  
    1414   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter 
    1515   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC  
     16   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys 
    1617   !!---------------------------------------------------------------------- 
    17 #if   defined key_tradmp   ||   defined key_esopa 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_tradmp'                                       internal damping 
     18 
    2019   !!---------------------------------------------------------------------- 
    2120   !!   tra_dmp_alloc : allocate tradmp arrays 
     
    3231   USE zdf_oce        ! ocean: vertical physics 
    3332   USE phycst         ! physical constants 
    34    USE dtatem         ! data: temperature 
    35    USE dtasal         ! data: salinity 
     33   USE dtatsd         ! data: temperature & salinity 
    3634   USE zdfmxl         ! vertical physics: mixed layer depth 
    3735   USE in_out_manager ! I/O manager 
     
    4745   PUBLIC   dtacof_zoom  ! routine called by in both tradmp.F90 and trcdmp.F90 
    4846 
    49 #if ! defined key_agrif 
    50    LOGICAL, PUBLIC, PARAMETER ::   lk_tradmp = .TRUE.     !: internal damping flag 
    51 #else 
    52    LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag 
    53 #endif 
     47   !                                !!* Namelist namtra_dmp : T & S newtonian damping * 
     48   LOGICAL, PUBLIC ::   ln_tradmp = .TRUE.    !: internal damping flag 
     49   INTEGER         ::   nn_hdmp   =   -1      ! = 0/-1/'latitude' for damping over T and S 
     50   INTEGER         ::   nn_zdmp   =    0      ! = 0/1/2 flag for damping in the mixed layer 
     51   REAL(wp)        ::   rn_surf   =   50._wp  ! surface time scale for internal damping        [days] 
     52   REAL(wp)        ::   rn_bot    =  360._wp  ! bottom time scale for internal damping         [days] 
     53   REAL(wp)        ::   rn_dep    =  800._wp  ! depth of transition between rn_surf and rn_bot [meters] 
     54   INTEGER         ::   nn_file   =    2      ! = 1 create a damping.coeff NetCDF file  
     55 
    5456   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s) 
    5557   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s) 
    5658   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
    57     
    58    !                                !!* Namelist namtra_dmp : T & S newtonian damping * 
    59    INTEGER  ::   nn_hdmp =   -1      ! = 0/-1/'latitude' for damping over T and S 
    60    INTEGER  ::   nn_zdmp =    0      ! = 0/1/2 flag for damping in the mixed layer 
    61    REAL(wp) ::   rn_surf =   50._wp  ! surface time scale for internal damping        [days] 
    62    REAL(wp) ::   rn_bot  =  360._wp  ! bottom time scale for internal damping         [days] 
    63    REAL(wp) ::   rn_dep  =  800._wp  ! depth of transition between rn_surf and rn_bot [meters] 
    64    INTEGER  ::   nn_file =    2      ! = 1 create a damping.coeff NetCDF file  
    6559 
    6660   !! * Substitutions 
     
    7670   INTEGER FUNCTION tra_dmp_alloc() 
    7771      !!---------------------------------------------------------------------- 
    78       !!                ***  FUNCTION tra_bbl_alloc  *** 
    79       !!---------------------------------------------------------------------- 
    80       ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
     72      !!                ***  FUNCTION tra_dmp_alloc  *** 
     73      !!---------------------------------------------------------------------- 
     74      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
    8175      ! 
    8276      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
    8377      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed') 
     78      ! 
    8479   END FUNCTION tra_dmp_alloc 
    8580 
     
    10398      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend 
    10499      !!---------------------------------------------------------------------- 
     100      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     101      USE wrk_nemo, ONLY:   zts_dta => wrk_4d_2  ! 4D workspace 
     102      ! 
    105103      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    106104      !! 
    107105      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    108       REAL(wp) ::   zta, zsa     ! local scalars 
    109       !!---------------------------------------------------------------------- 
     106      REAL(wp) ::   zta, zsa             ! local scalars 
     107      !!---------------------------------------------------------------------- 
     108      ! 
     109      IF( wrk_in_use(4, 2) ) THEN 
     110         CALL ctl_stop('tra_dmp: requested workspace arrays unavailable')   ;   RETURN 
     111      ENDIF 
     112      !                           !==   input T-S data at kt   ==! 
     113      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt 
    110114      ! 
    111115      SELECT CASE ( nn_zdmp )     !==    type of damping   ==! 
     
    115119            DO jj = 2, jpjm1 
    116120               DO ji = fs_2, fs_jpim1   ! vector opt. 
    117                   zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    118                   zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     121                  zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     122                  zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    119123                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 
    120124                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    121                   strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj) 
    122                   ttrdmp(ji,jj,jk) = zta 
     125                  strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj) 
     126                  ttrdmp(ji,jj,jk) = zta       
    123127               END DO 
    124128            END DO 
     
    130134               DO ji = fs_2, fs_jpim1   ! vector opt. 
    131135                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 
    132                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    133                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     136                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     137                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    134138                  ELSE 
    135139                     zta = 0._wp 
     
    149153               DO ji = fs_2, fs_jpim1   ! vector opt. 
    150154                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    151                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    152                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     155                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     156                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    153157                  ELSE 
    154158                     zta = 0._wp 
     
    173177         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    174178      ! 
     179      IF( wrk_not_released(4, 2) )  CALL ctl_stop('tra_dmp: failed to release workspace arrays') 
     180      ! 
    175181   END SUBROUTINE tra_dmp 
    176182 
     
    184190      !! ** Method  :   read the nammbf namelist and check the parameters 
    185191      !!---------------------------------------------------------------------- 
    186       NAMELIST/namtra_dmp/ nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
     192      NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
    187193      !!---------------------------------------------------------------------- 
    188194 
     
    194200      IF(lwp) THEN                       ! Namelist print 
    195201         WRITE(numout,*) 
    196          WRITE(numout,*) 'tra_dmp : T and S newtonian damping' 
     202         WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping' 
    197203         WRITE(numout,*) '~~~~~~~' 
    198204         WRITE(numout,*) '   Namelist namtra_dmp : set damping parameter' 
    199          WRITE(numout,*) '      T and S damping option         nn_hdmp = ', nn_hdmp 
    200          WRITE(numout,*) '      mixed layer damping option     nn_zdmp = ', nn_zdmp, '(zoom: forced to 0)' 
    201          WRITE(numout,*) '      surface time scale (days)      rn_surf = ', rn_surf 
    202          WRITE(numout,*) '      bottom time scale (days)       rn_bot  = ', rn_bot 
    203          WRITE(numout,*) '      depth of transition (meters)   rn_dep  = ', rn_dep 
    204          WRITE(numout,*) '      create a damping.coeff file    nn_file = ', nn_file 
    205       ENDIF 
    206  
    207       !                              ! allocate tradmp arrays 
    208       IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
    209  
    210       SELECT CASE ( nn_hdmp ) 
    211       CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
    212       CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees' 
    213       CASE DEFAULT 
    214          WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp 
    215          CALL ctl_stop(ctmp1) 
    216       END SELECT 
    217  
    218       SELECT CASE ( nn_zdmp ) 
    219       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    220       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
    221       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    222       CASE DEFAULT 
    223          WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 
    224          CALL ctl_stop(ctmp1) 
    225       END SELECT 
    226  
    227       IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem )   & 
    228          &   CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' ) 
    229  
    230       strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj) 
    231       ttrdmp(:,:,:) = 0._wp 
    232       !                          ! Damping coefficients initialization 
    233       IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto ) 
    234       ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep,  & 
    235                              &            nn_file, 'TRA'  , resto            ) 
     205         WRITE(numout,*) '      add a damping termn or not      ln_tradmp = ', ln_tradmp 
     206         WRITE(numout,*) '      T and S damping option          nn_hdmp   = ', nn_hdmp 
     207         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp, '(zoom: forced to 0)' 
     208         WRITE(numout,*) '      surface time scale (days)       rn_surf   = ', rn_surf 
     209         WRITE(numout,*) '      bottom time scale (days)        rn_bot    = ', rn_bot 
     210         WRITE(numout,*) '      depth of transition (meters)    rn_dep    = ', rn_dep 
     211         WRITE(numout,*) '      create a damping.coeff file     nn_file   = ', nn_file 
     212         WRITE(numout,*) 
     213      ENDIF 
     214 
     215      IF( ln_tradmp ) THEN               ! initialization for T-S damping 
     216         ! 
     217         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
     218         ! 
     219         SELECT CASE ( nn_hdmp ) 
     220         CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
     221         CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees' 
     222         CASE DEFAULT 
     223            WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp 
     224            CALL ctl_stop(ctmp1) 
     225         END SELECT 
     226         ! 
     227         SELECT CASE ( nn_zdmp ) 
     228         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     229         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     230         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     231         CASE DEFAULT 
     232            WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 
     233            CALL ctl_stop(ctmp1) 
     234         END SELECT 
     235         ! 
     236         IF( .NOT.ln_tsd_tradmp ) THEN 
     237            CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' ) 
     238            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data 
     239         ENDIF 
     240         ! 
     241         strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj) 
     242         ttrdmp(:,:,:) = 0._wp 
     243         !                          ! Damping coefficients initialization 
     244         IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto ) 
     245         ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto ) 
     246         ENDIF 
     247         ! 
    236248      ENDIF 
    237249      ! 
     
    347359      !!---------------------------------------------------------------------- 
    348360 
    349       IF( wrk_in_use(1, 1) .OR.   & 
    350           wrk_in_use(2, 1) .OR.   & 
    351           wrk_in_use(3, 1)   ) THEN 
     361      IF( wrk_in_use(1, 1) .OR. wrk_in_use(2, 1) .OR. wrk_in_use(3, 1)  ) THEN  
    352362          CALL ctl_stop('dtacof: requested workspace arrays unavailable')   ;   RETURN 
    353363      ENDIF 
     
    529539      ELSE                         !     No damping     ! 
    530540         !                         !--------------------! 
    531          CALL ctl_stop( 'Choose a correct value of nn_hdmp or DO NOT defined key_tradmp' ) 
     541         CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' ) 
    532542      ENDIF 
    533543 
     
    544554      ENDIF 
    545555      ! 
    546       IF( wrk_not_released(1, 1) .OR.   & 
    547           wrk_not_released(2, 1) .OR.   & 
    548           wrk_not_released(3, 1) )   CALL ctl_stop('dtacof: failed to release workspace arrays') 
     556      IF( wrk_not_released(1, 1) .OR.  wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )  &  
     557         &                      CALL ctl_stop('dtacof: failed to release workspace arrays') 
    549558      ! 
    550559   END SUBROUTINE dtacof 
     
    572581      !!---------------------------------------------------------------------- 
    573582      USE ioipsl      ! IOipsl librairy 
    574       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    575       USE wrk_nemo, ONLY:   zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4 
     583      USE wrk_nemo, ONLY:  wrk_in_use, wrk_not_released 
     584      USE wrk_nemo, ONLY:  zxt => wrk_2d_1, zyt   => wrk_2d_2  
     585      USE wrk_nemo, ONLY:  zzt => wrk_2d_3, zmask => wrk_2d_4 
    576586      !! 
    577587      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline 
     
    585595      !!---------------------------------------------------------------------- 
    586596 
    587       IF( wrk_in_use(2, 1,2,3,4) .OR.  & 
    588           wrk_in_use(1, 1,2,3,4)  ) THEN 
     597      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
    589598          CALL ctl_stop('cofdis: requested workspace arrays unavailable')   ;   RETURN 
    590599      ENDIF 
     
    745754      CALL restclo( icot ) 
    746755      ! 
    747       IF( wrk_not_released(2, 1,2,3,4) .OR. &  
    748           wrk_not_released(1, 1,2,3,4)  )   CALL ctl_stop('cofdis: failed to release workspace arrays') 
    749       DEALLOCATE( llcotu , llcotv , llcotf ,      & 
    750          &        zxc    , zyc    , zzc    , zdis ) 
     756      IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('cofdis: failed to release workspace arrays') 
     757      DEALLOCATE( llcotu, llcotv, llcotf, zyc, zzc, zdis ) 
    751758      ! 
    752759   END SUBROUTINE cofdis 
    753  
    754 #else 
    755    !!---------------------------------------------------------------------- 
    756    !!   Default key                                     NO internal damping 
    757    !!---------------------------------------------------------------------- 
    758    LOGICAL , PUBLIC, PARAMETER ::   lk_tradmp = .FALSE.    !: internal damping flag 
    759 CONTAINS 
    760    SUBROUTINE tra_dmp( kt )        ! Empty routine 
    761       WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt 
    762    END SUBROUTINE tra_dmp 
    763    SUBROUTINE tra_dmp_init        ! Empty routine 
    764    END SUBROUTINE tra_dmp_init 
    765 #endif 
    766  
    767760   !!====================================================================== 
    768761END MODULE tradmp 
Note: See TracChangeset for help on using the changeset viewer.