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 3881 – NEMO

Changeset 3881


Ignore:
Timestamp:
2013-04-22T12:05:52+02:00 (11 years ago)
Author:
cetlod
Message:

v3_4_stable: fix on passive tracer damping, see ticket #1083

Location:
branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r3294 r3881  
    4040   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
    4141   INTEGER  ::   nn_pisdmp         !: frequency of relaxation or not of nutrients to a mean value 
    42    LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
    4342                                   !: on close seas 
    4443 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r3294 r3881  
    5656#endif 
    5757      NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics 
    58       NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp, ln_pisclo 
     58      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp 
    5959 
    6060      !!---------------------------------------------------------------------- 
     
    170170         WRITE(numout,*) '    Relaxation of tracer to glodap mean value             ln_pisdmp      =', ln_pisdmp 
    171171         WRITE(numout,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp 
    172          WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo 
    173172         WRITE(numout,*) ' ' 
    174173      ENDIF 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    r3294 r3881  
    4242      !!---------------------------------------------------------------------- 
    4343 
    44       ! 
    45       IF( ln_trcdta .AND. ln_pisclo ) CALL pis_dmp_clo  ! restoring of nutrients on close seas 
    4644      ! 
    4745      IF(lwp) WRITE(numout,*) 
     
    9997   END SUBROUTINE trc_rst_wri_pisces 
    10098 
    101    SUBROUTINE pis_dmp_clo    
    102       !!--------------------------------------------------------------------- 
    103       !!                  ***  ROUTINE pis_dmp_clo  *** 
    104       !! 
    105       !! ** Purpose :   Closed sea domain initialization 
    106       !! 
    107       !! ** Method  :   if a closed sea is located only in a model grid point 
    108       !!                we restore to initial data 
    109       !! 
    110       !! ** Action  :   ictsi1(), ictsj1() : south-west closed sea limits (i,j) 
    111       !!                ictsi2(), ictsj2() : north-east Closed sea limits (i,j) 
    112       !!---------------------------------------------------------------------- 
    113       INTEGER, PARAMETER           ::   npicts   = 4        ! number of closed sea 
    114       INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1      ! south-west closed sea limits (i,j) 
    115       INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2      ! north-east closed sea limits (i,j) 
    116       INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indices 
    117       INTEGER :: ierr                                       ! local integer 
    118       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  ztrcdta ! 4D  workspace 
    119       !!---------------------------------------------------------------------- 
    120  
    121       IF(lwp) WRITE(numout,*)  
    122       IF(lwp) WRITE(numout,*)' pis_dmp_clo : closed seas ' 
    123       IF(lwp) WRITE(numout,*)'~~~~~~~' 
    124  
    125       ! initial values 
    126       ictsi1(:) = 1  ;  ictsi2(:) = 1 
    127       ictsj1(:) = 1  ;  ictsj2(:) = 1 
    128  
    129       ! set the closed seas (in data domain indices) 
    130       ! ------------------- 
    131  
    132       IF( cp_cfg == "orca" ) THEN 
    133          ! 
    134          SELECT CASE ( jp_cfg ) 
    135          !                                           ! ======================= 
    136          CASE ( 2 )                                  !  ORCA_R2 configuration 
    137             !                                        ! ======================= 
    138             !                                            ! Caspian Sea 
    139             ictsi1(1)   =  11  ;  ictsj1(1)   = 103 
    140             ictsi2(1)   =  17  ;  ictsj2(1)   = 112 
    141             !                                            ! Great North American Lakes 
    142             ictsi1(2)   =  97  ;  ictsj1(2)   = 107 
    143             ictsi2(2)   = 103  ;  ictsj2(2)   = 111 
    144             !                                            ! Black Sea 1 : west part of the Black Sea 
    145             ictsi1(3)   = 174  ; ictsj1(3)   = 107 
    146             ictsi2(3)   = 181  ; ictsj2(3)   = 112 
    147             !                                            ! Black Sea 2 : est part of the Black Sea 
    148             ictsi1(4)   =   2  ;  ictsj1(4)   = 107 
    149             ictsi2(4)   =   6  ;  ictsj2(4)   = 112 
    150             !                                        ! ======================= 
    151          CASE ( 4 )                                  !  ORCA_R4 configuration 
    152             !                                        ! ======================= 
    153             !                                            ! Caspian Sea 
    154             ictsi1(1)   =  4  ;  ictsj1(1)   = 53 
    155             ictsi2(1)   =  4  ;  ictsj2(1)   = 56 
    156             !                                            ! Great North American Lakes 
    157             ictsi1(2)   = 49  ;  ictsj1(2)   = 55 
    158             ictsi2(2)   = 51  ;  ictsj2(2)   = 56 
    159             !                                            ! Black Sea 
    160             ictsi1(3)   = 88  ;  ictsj1(3)   = 55 
    161             ictsi2(3)   = 91  ;  ictsj2(3)   = 56 
    162             !                                            ! Baltic Sea 
    163             ictsi1(4)   = 75  ;  ictsj1(4)   = 59 
    164             ictsi2(4)   = 76  ;  ictsj2(4)   = 61 
    165             !                                        ! ======================= 
    166             !                                        ! ======================= 
    167          CASE ( 025 )                                ! ORCA_R025 configuration 
    168             !                                        ! ======================= 
    169                                                      ! Caspian + Aral sea 
    170             ictsi1(1)   = 1330 ; ictsj1(1)   = 645 
    171             ictsi2(1)   = 1400 ; ictsj2(1)   = 795 
    172             !                                        ! Azov Sea 
    173             ictsi1(2)   = 1284 ; ictsj1(2)   = 722 
    174             ictsi2(2)   = 1304 ; ictsj2(2)   = 747 
    175             ! 
    176          END SELECT 
    177          ! 
    178       ENDIF 
    179  
    180       ! convert the position in local domain indices 
    181       ! -------------------------------------------- 
    182       DO jc = 1, npicts 
    183          ictsi1(jc)   = mi0( ictsi1(jc) ) 
    184          ictsj1(jc)   = mj0( ictsj1(jc) ) 
    185  
    186          ictsi2(jc)   = mi1( ictsi2(jc) ) 
    187          ictsj2(jc)   = mj1( ictsj2(jc) ) 
    188       END DO 
    189  
    190       ! Restore close seas values to initial data 
    191       IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    192         ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr ) 
    193         IF( ierr > 0 ) THEN 
    194            CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' )   ;   RETURN 
    195         ENDIF 
    196         ! 
    197         CALL trc_dta( nittrc000, ztrcdta )   ! read tracer data at nittrc000 
    198         ! 
    199         DO jn = 1, jptra 
    200            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    201               jl = n_trc_index(jn) 
    202               DO jc = 1, npicts 
    203                  DO jk = 1, jpkm1 
    204                     DO jj = ictsj1(jc), ictsj2(jc) 
    205                        DO ji = ictsi1(jc), ictsi2(jc) 
    206                           trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk)  
    207                           trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    208                        ENDDO 
    209                     ENDDO 
    210                  ENDDO 
    211               ENDDO 
    212            ENDIF 
    213         ENDDO 
    214         DEALLOCATE( ztrcdta ) 
    215       ENDIF 
    216       ! 
    217    END SUBROUTINE pis_dmp_clo 
    21899 
    219100#else 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r3294 r3881  
    1111   !!            3.3  !  2010-06  (C. Ethe, G. Madec) merge TRA-TRC  
    1212   !!---------------------------------------------------------------------- 
    13 #if  defined key_top && defined key_trcdmp  
    14    !!---------------------------------------------------------------------- 
    15    !!   key_trcdmp                                         internal damping 
     13#if  defined key_top  
    1614   !!---------------------------------------------------------------------- 
    1715   !!   trc_dmp      : update the tracer trend with the internal damping 
     
    2523   USE prtctl_trc      ! Print control for debbuging 
    2624   USE trdtra 
     25   USE trdmod_oce 
    2726 
    2827   IMPLICIT NONE 
     
    3029 
    3130   PUBLIC trc_dmp            ! routine called by step.F90 
     31   PUBLIC trc_dmp_clo        ! routine called by step.F90 
    3232   PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90 
    3333 
    34    LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag 
    35  
    3634   !                                !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
    37    INTEGER  ::   nn_hdmp_tr =   -1   ! = 0/-1/'latitude' for damping over passive tracer 
    38    INTEGER  ::   nn_zdmp_tr =    0   ! = 0/1/2 flag for damping in the mixed layer 
    39    REAL(wp) ::   rn_surf_tr =   50.  ! surface time scale for internal damping        [days] 
    40    REAL(wp) ::   rn_bot_tr  =  360.  ! bottom time scale for internal damping         [days] 
    41    REAL(wp) ::   rn_dep_tr  =  800.  ! depth of transition between rn_surf and rn_bot [meters] 
    42    INTEGER  ::   nn_file_tr =    2   ! = 1 create a damping.coeff NetCDF file  
    43  
    4435   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1) 
     36 
     37   INTEGER, PARAMETER           ::   npncts   = 5        ! number of closed sea 
     38   INTEGER, DIMENSION(npncts)   ::   nctsi1, nctsj1      ! south-west closed sea limits (i,j) 
     39   INTEGER, DIMENSION(npncts)   ::   nctsi2, nctsj2      ! north-east closed sea limits (i,j) 
    4540 
    4641   !! * Substitutions 
     
    8681      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    8782      !! 
    88       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
     83      INTEGER  ::   ji, jj, jk, jn, jl       ! dummy loop indices 
    8984      REAL(wp) ::   ztra                 ! temporary scalars 
    9085      CHARACTER (len=22) :: charout 
    9186      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
     87      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace 
    9288      !!---------------------------------------------------------------------- 
    9389      ! 
     
    9995 
    10096      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends 
    101  
    102       ! 1. Newtonian damping trends on tracer fields 
    103       ! -------------------------------------------- 
    104       ! Initialize the input fields for newtonian damping 
    105       CALL trc_dta( kt ) 
    106       !                                                          ! =========== 
    107       DO jn = 1, jptra                                           ! tracer loop 
    108          !                                                       ! =========== 
    109          IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends  
    110  
    111          IF( lutini(jn) ) THEN 
     97      ! 
     98      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     99         ! 
     100         CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation 
     101         CALL trc_dta( kt, ztrcdta )   ! read tracer data at nit000 
     102         !                                                          ! =========== 
     103         DO jn = 1, jptra                                           ! tracer loop 
     104            !                                                       ! =========== 
     105            IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends  
    112106            ! 
    113             SELECT CASE ( nn_zdmp_trc ) 
    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                         ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
    120                         tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     107            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     108                
     109               jl = n_trc_index(jn)  
     110 
     111               SELECT CASE ( nn_zdmp_tr ) 
     112               ! 
     113               CASE( 0 )                !==  newtonian damping throughout the water column  ==! 
     114                  DO jk = 1, jpkm1 
     115                     DO jj = 2, jpjm1 
     116                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     117                           ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) ) 
     118                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     119                        END DO 
    121120                     END DO 
    122121                  END DO 
    123                END DO 
    124             ! 
    125             CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    126                DO jk = 1, jpkm1 
    127                   DO jj = 2, jpjm1 
    128                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    129                         IF( avt(ji,jj,jk) <= 5.e-4 )  THEN  
    130                            ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
    131                            tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    132                         ENDIF 
     122               ! 
     123               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
     124                  DO jk = 1, jpkm1 
     125                     DO jj = 2, jpjm1 
     126                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     127                           IF( avt(ji,jj,jk) <= 5.e-4 )  THEN  
     128                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) ) 
     129                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     130                           ENDIF 
     131                        END DO 
    133132                     END DO 
    134133                  END DO 
    135                END DO 
    136             ! 
    137             CASE ( 2 )               !==  no damping in the mixed layer   ==!  
    138                DO jk = 1, jpkm1 
    139                   DO jj = 2, jpjm1 
    140                      DO ji = fs_2, fs_jpim1   ! vector opt. 
    141                         IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    142                            ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
    143                            tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    144                         END IF 
     134               ! 
     135               CASE ( 2 )               !==  no damping in the mixed layer   ==!  
     136                  DO jk = 1, jpkm1 
     137                     DO jj = 2, jpjm1 
     138                        DO ji = fs_2, fs_jpim1   ! vector opt. 
     139                           IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
     140                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) ) 
     141                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     142                           END IF 
     143                        END DO 
    145144                     END DO 
    146145                  END DO 
    147                END DO 
    148             !   
    149             END SELECT 
    150             !  
    151          ENDIF 
    152          ! 
    153          IF( l_trdtrc ) THEN 
    154             ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:) 
    155             CALL trd_tra( kt, 'TRC', jn, jptra_trd_dmp, ztrtrd ) 
    156          END IF 
    157          !                                                       ! =========== 
    158       END DO                                                     ! tracer loop 
    159       !                                                          ! =========== 
     146               !   
     147               END SELECT 
     148               !  
     149            ENDIF 
     150            ! 
     151            IF( l_trdtrc ) THEN 
     152               ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:) 
     153               CALL trd_tra( kt, 'TRC', jn, jptra_trd_dmp, ztrtrd ) 
     154            END IF 
     155            !                                                       ! =========== 
     156         END DO                                                     ! tracer loop 
     157         !                                                          ! =========== 
     158         CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
     159      ENDIF 
     160      ! 
    160161      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
    161162      !                                          ! print mean trends (used for debugging) 
     
    168169      ! 
    169170   END SUBROUTINE trc_dmp 
     171 
     172   SUBROUTINE trc_dmp_clo( kt ) 
     173      !!--------------------------------------------------------------------- 
     174      !!                  ***  ROUTINE trc_dmp_clo  *** 
     175      !! 
     176      !! ** Purpose :   Closed sea domain initialization 
     177      !! 
     178      !! ** Method  :   if a closed sea is located only in a model grid point 
     179      !!                we restore to initial data 
     180      !! 
     181      !! ** Action  :   nctsi1(), nctsj1() : south-west closed sea limits (i,j) 
     182      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 
     183      !!---------------------------------------------------------------------- 
     184      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     185      ! 
     186      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indicesa 
     187      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta     ! 4D  workspace 
     188 
     189      !!---------------------------------------------------------------------- 
     190 
     191      IF( kt == nit000 ) THEN 
     192         ! initial values 
     193         nctsi1(:) = 1  ;  nctsi2(:) = 1 
     194         nctsj1(:) = 1  ;  nctsj2(:) = 1 
     195 
     196         ! set the closed seas (in data domain indices) 
     197         ! ------------------- 
     198 
     199         IF( cp_cfg == "orca" ) THEN 
     200            ! 
     201            SELECT CASE ( jp_cfg ) 
     202            !                                           ! ======================= 
     203            CASE ( 2 )                                  !  ORCA_R2 configuration 
     204               !                                        ! ======================= 
     205               !                                            ! Caspian Sea 
     206               nctsi1(1)   =  11  ;  nctsj1(1)   = 103 
     207               nctsi2(1)   =  17  ;  nctsj2(1)   = 112 
     208               !                                            ! Great North American Lakes 
     209               nctsi1(2)   =  97  ;  nctsj1(2)   = 107 
     210               nctsi2(2)   = 103  ;  nctsj2(2)   = 111 
     211               !                                            ! Black Sea 1 : west part of the Black Sea 
     212               nctsi1(3)   = 174  ;  nctsj1(3)   = 107 
     213               nctsi2(3)   = 181  ;  nctsj2(3)   = 112 
     214              !                                            ! Black Sea 2 : est part of the Black Sea 
     215               nctsi1(4)   =   2  ;  nctsj1(4)   = 107 
     216               nctsi2(4)   =   6  ;  nctsj2(4)   = 112 
     217               !                                            ! Baltic Sea 
     218               nctsi1(5)   =  145 ;  nctsj1(5)   = 116 
     219               nctsi2(5)   =  150 ;  nctsj2(5)   = 126 
     220               !                                        ! ======================= 
     221            CASE ( 4 )                                  !  ORCA_R4 configuration 
     222               !                                        ! ======================= 
     223               !                                            ! Caspian Sea 
     224               nctsi1(1)   =  4  ;  nctsj1(1)   = 53 
     225               nctsi2(1)   =  4  ;  nctsj2(1)   = 56 
     226               !                                            ! Great North American Lakes 
     227               nctsi1(2)   = 49  ;  nctsj1(2)   = 55 
     228               nctsi2(2)   = 51  ;  nctsj2(2)   = 56 
     229               !                                            ! Black Sea 
     230               nctsi1(3)   = 88  ;  nctsj1(3)   = 55 
     231               nctsi2(3)   = 91  ;  nctsj2(3)   = 56 
     232               !                                            ! Baltic Sea 
     233               nctsi1(4)   = 75  ;  nctsj1(4)   = 59 
     234               nctsi2(4)   = 76  ;  nctsj2(4)   = 61 
     235               !                                        ! ======================= 
     236            CASE ( 025 )                                ! ORCA_R025 configuration 
     237               !                                        ! ======================= 
     238                                                     ! Caspian + Aral sea 
     239               nctsi1(1)   = 1330 ; nctsj1(1)   = 645 
     240               nctsi2(1)   = 1400 ; nctsj2(1)   = 795 
     241               !                                        ! Azov Sea 
     242               nctsi1(2)   = 1284 ; nctsj1(2)   = 722 
     243               nctsi2(2)   = 1304 ; nctsj2(2)   = 747 
     244               ! 
     245            END SELECT 
     246            ! 
     247         ENDIF 
     248         ! 
     249 
     250         ! convert the position in local domain indices 
     251         ! -------------------------------------------- 
     252         DO jc = 1, npncts 
     253            nctsi1(jc)   = mi0( nctsi1(jc) ) 
     254            nctsj1(jc)   = mj0( nctsj1(jc) ) 
     255 
     256            nctsi2(jc)   = mi1( nctsi2(jc) ) 
     257            nctsj2(jc)   = mj1( nctsj2(jc) ) 
     258         END DO 
     259         ! 
     260      ENDIF 
     261 
     262      ! Restore close seas values to initial data 
     263      IF( ln_trcdta .AND. nb_trcdta > 0 )  THEN   ! Initialisation of tracer from a file that may also be used for damping 
     264         ! 
     265         IF(lwp)  WRITE(numout,*) 
     266         IF(lwp)  WRITE(numout,*) ' trc_dmp_clo : Restoring of nutrients on close seas at time-step kt = ', kt 
     267         IF(lwp)  WRITE(numout,*) 
     268         ! 
     269         CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )   ! Memory allocation 
     270         ! 
     271         CALL trc_dta( kt , ztrcdta )   ! read tracer data at nittrc000 
     272         ! 
     273         DO jn = 1, jptra 
     274            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     275                jl = n_trc_index(jn) 
     276                DO jc = 1, npncts 
     277                   DO jk = 1, jpkm1 
     278                      DO jj = nctsj1(jc), nctsj2(jc) 
     279                         DO ji = nctsi1(jc), nctsi2(jc) 
     280                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk) 
     281                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     282                         ENDDO 
     283                      ENDDO 
     284                   ENDDO 
     285                ENDDO 
     286             ENDIF 
     287          ENDDO 
     288          CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
     289      ENDIF 
     290      ! 
     291   END SUBROUTINE trc_dmp_clo 
    170292 
    171293 
     
    199321      END SELECT 
    200322 
    201       IF( .NOT. lk_dtatrc )   & 
    202          &   CALL ctl_stop( 'no passive tracer data define key_dtatrc' ) 
    203  
    204       IF( .NOT. lk_tradmp )   & 
     323      IF( .NOT. ln_tradmp )   & 
    205324         &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' ) 
    206325      ! 
     
    214333      ! 
    215334   END SUBROUTINE trc_dmp_init 
     335 
    216336#else 
    217337   !!---------------------------------------------------------------------- 
    218    !!   Default key                                     NO internal damping 
    219    !!---------------------------------------------------------------------- 
    220    LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .FALSE.    !: internal damping flag 
     338   !!  Dummy module :                                     No passive tracer 
     339   !!---------------------------------------------------------------------- 
    221340CONTAINS 
    222341   SUBROUTINE trc_dmp( kt )        ! Empty routine 
     
    225344   END SUBROUTINE trc_dmp 
    226345#endif 
     346 
     347 
    227348   !!====================================================================== 
    228349END MODULE trcdmp 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90

    r3294 r3881  
    1313   !!   trc_nam_trp  : read the passive tracer namelist for transport 
    1414   !!---------------------------------------------------------------------- 
     15   USE oce_trc 
    1516   USE trc                 ! ocean passive tracers variables 
    1617   USE in_out_manager      ! ocean dynamics and active tracers variables 
     
    4647   INTEGER , PUBLIC ::   nn_trczdf_exp = 3             !: number of sub-time step (explicit time stepping) 
    4748 
    48  
    49 #if defined key_trcdmp 
    5049   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) ** 
    5150   INTEGER , PUBLIC ::   nn_hdmp_tr      =   -1       ! = 0/-1/'latitude' for damping over passive tracer 
     
    5554   REAL(wp), PUBLIC ::   rn_dep_tr       =  800.      ! depth of transition between rn_surf and rn_bot [meters] 
    5655   INTEGER , PUBLIC ::   nn_file_tr      =    2       ! = 1 create a damping.coeff NetCDF file  
    57 #endif 
    5856 
    5957   !!---------------------------------------------------------------------- 
     
    8078      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
    8179      NAMELIST/namtrc_rad/ ln_trcrad 
    82 #if defined key_trcdmp 
    8380      NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, & 
    8481        &                  rn_bot_tr , rn_dep_tr , nn_file_tr 
    85 #endif 
    8682      !!---------------------------------------------------------------------- 
    8783 
     
    146142 
    147143 
    148 # if defined key_trcdmp 
    149144      REWIND ( numnat )                  ! Read Namelist namtra_dmp : temperature and salinity damping term 
    150145      READ   ( numnat, namtrc_dmp ) 
    151       IF( lzoom )   nn_zdmp_trc = 0           ! restoring to climatology at closed north or south boundaries 
     146      IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
    152147 
    153148      IF(lwp) THEN                       ! Namelist print 
     
    163158         WRITE(numout,*) '      create a damping.coeff file    nn_file_tr = ', nn_file_tr 
    164159      ENDIF 
    165 #endif 
    166160      ! 
    167161   END SUBROUTINE trc_nam_trp 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r3294 r3881  
    6565                                CALL trc_sbc( kstp )            ! surface boundary condition 
    6666         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
    67          IF( lk_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
     67         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
     68         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! restoring on close seas 
    6869                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
    6970                                CALL trc_ldf( kstp )            ! lateral mixing 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r3294 r3881  
    5454   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
    5555   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag 
    56    INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model 
     56   LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: Restoring or not of nutrients on close seas 
     57   INTEGER             , PUBLIC                                    ::  nittrc000      !: first time step of passive tracers model 
    5758 
    5859   !! information for outputs 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r3828 r3881  
    255255         ENDIF 
    256256         ! 
    257          IF( .NOT.ln_trcdmp ) THEN                   !==   deallocate data structure   ==!  
     257         IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN  !==   deallocate data structure   ==!  
    258258            !                                              (data used only for initialisation) 
    259259            IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 
  • branches/2012/dev_v3_4_STABLE_2012/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r3319 r3881  
    6060      !! 
    6161      NAMELIST/namtrc/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, & 
    62          &             cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta, ln_trcdmp 
     62         &             cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta, & 
     63         &             ln_trcdmp, ln_trcdmp_clo 
    6364#if defined key_trdmld_trc  || defined key_trdtrc 
    6465      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     
    9192         sn_tracer(jn)%llsave  = .TRUE. 
    9293      END DO 
    93       ln_trcdta = .FALSE. 
    94       ln_trcdmp = .FALSE. 
     94      ln_trcdta     = .FALSE. 
     95      ln_trcdmp     = .FALSE. 
     96      ln_trcdmp_clo = .FALSE. 
    9597 
    9698 
     
    120122         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
    121123         WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
     124         WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
    122125         WRITE(numout,*) ' ' 
    123126         DO jn = 1, jptra 
     
    172175 
    173176 
    174       IF( ln_trcdmp .AND. .NOT.ln_trcdta ) THEN 
    175          CALL ctl_warn( 'trc_nam: passive tracer damping requires data from files we set ln_trcdta to TRUE' ) 
    176          ln_trcdta = .TRUE. 
    177       ENDIF 
    178       ! 
    179       IF( ln_rsttr .AND. .NOT.ln_trcdmp .AND. ln_trcdta ) THEN 
    180           CALL ctl_warn( 'trc_nam: passive tracer restart and  data intialisation, ',   & 
    181              &           'we keep the restart values and set ln_trcdta to FALSE' ) 
    182          ln_trcdta = .FALSE. 
    183       ENDIF 
     177      IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data 
     178      ! 
     179      IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data 
    184180      ! 
    185181      IF( .NOT.ln_trcdta ) THEN 
     
    190186         IF( ln_rsttr ) THEN 
    191187            WRITE(numout,*) 
    192             WRITE(numout,*) '    read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
    193             WRITE(numout,*) 
    194          ELSE 
    195             IF( .NOT.ln_trcdta ) THEN 
    196                 WRITE(numout,*) 
    197                 WRITE(numout,*) '  All the passive tracers are initialised with constant values ' 
    198                 WRITE(numout,*) 
    199             ENDIF 
     188            WRITE(numout,*) '  Read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
     189            WRITE(numout,*) 
     190         ENDIF 
     191         IF( ln_trcdta .AND. .NOT.ln_rsttr ) THEN 
     192            WRITE(numout,*) 
     193            WRITE(numout,*) '  Some of the passive tracers are initialised from climatologies ' 
     194            WRITE(numout,*) 
     195         ENDIF 
     196         IF( .NOT.ln_trcdta ) THEN 
     197            WRITE(numout,*) 
     198            WRITE(numout,*) '  All the passive tracers are initialised with constant values ' 
     199            WRITE(numout,*) 
    200200         ENDIF 
    201201      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.