Changeset 8141


Ignore:
Timestamp:
2017-06-05T16:40:32+02:00 (3 years ago)
Author:
dford
Message:

Initial implementation of surface chlorophyll relaxation for FABM-ERSEM.

Location:
branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP
Files:
2 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90

    r6331 r8141  
    1616   USE in_out_manager      ! ocean dynamics and active tracers variables 
    1717   USE lib_mpp           ! distributed memory computing library 
     18   USE fldread 
    1819 
    1920   IMPLICIT NONE 
     
    5253   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer 
    5354   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient 
     55   CHARACTER(LEN=200) , PUBLIC :: cn_dir_chldmp = './'    !: Directory containing chlorophyll file 
     56   INTEGER , PUBLIC ::    nn_chldmp = 0    !: = 0/1/2 flag for surface chlorophyll damping 
     57   REAL(wp), PUBLIC ::    rn_chldmp = 0.0  !: chlorophyll damping coefficient 
     58   TYPE(FLD_N), PUBLIC :: sn_chldmp        !: informations about the fields to be read 
    5459 
    5560   !!---------------------------------------------------------------------- 
     
    7782      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
    7883      NAMELIST/namtrc_rad/ ln_trcrad 
    79       NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 
     84      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr, cn_dir_chldmp, nn_chldmp, & 
     85         &                 sn_chldmp  , rn_chldmp 
    8086      !!---------------------------------------------------------------------- 
    8187 
     
    179185         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 
    180186         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr 
     187         WRITE(numout,*) '      Surface chlorophyll damping     nn_chldmp = ', nn_chldmp 
     188         WRITE(numout,*) '      Damping coefficient             rn_chldmp = ', rn_chldmp 
     189         WRITE(numout,*) '      Chlorophyll directory       cn_dir_chldmp = ', cn_dir_chldmp 
    181190      ENDIF 
    182191      ! 
  • branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbcssr.F90

    r8110 r8141  
    1 MODULE sbcssr 
     1MODULE trcsbcssr 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  sbcssr  *** 
    4    !! Surface module :  heat and fresh water fluxes a restoring term toward observed SST/SSS 
     3   !!                       ***  MODULE  trcsbcssr  *** 
     4   !! Surface module :  restoring term towards surface chlorophyll climatology 
    55   !!====================================================================== 
    6    !! History :  3.0  !  2006-06  (G. Madec)  Original code 
    7    !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put 
     6   !! History :  3.6  !  2017-06  (D. Ford)  Adapt from sbcssr.F90 
    87   !!---------------------------------------------------------------------- 
    9  
     8#if defined key_top 
    109   !!---------------------------------------------------------------------- 
    11    !!   sbc_ssr       : add to sbc a restoring term toward SST/SSS climatology 
    12    !!   sbc_ssr_init  : initialisation of surface restoring 
     10   !!   trc_sbc_ssr       : add a restoring term toward chl climatology 
     11   !!   trc_sbc_ssr_init  : initialisation of surface restoring 
    1312   !!---------------------------------------------------------------------- 
    14    USE oce            ! ocean dynamics and tracers 
    1513   USE dom_oce        ! ocean space and time domain 
    16    USE sbc_oce        ! surface boundary condition 
    17    USE phycst         ! physical constants 
    18    USE sbcrnf         ! surface boundary condition : runoffs 
     14   USE oce_trc       !  shared variables between ocean and passive tracers 
     15   USE trc 
     16   USE trcnam_trp 
    1917   ! 
    2018   USE fldread        ! read input fields 
     
    2523   USE timing         ! Timing 
    2624   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     25#if defined key_fabm 
     26   USE par_fabm 
     27#endif 
    2728 
    2829   IMPLICIT NONE 
    2930   PRIVATE 
    3031 
    31    PUBLIC   sbc_ssr        ! routine called in sbcmod 
    32    PUBLIC   sbc_ssr_init   ! routine called in sbcmod 
     32   PUBLIC   trc_sbc_ssr        ! routine called in trctrp 
    3333 
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp   !: evaporation damping   [kg/m2/s] 
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp   !: heat flux damping        [w/m2] 
    36  
    37    !                                   !!* Namelist namsbc_ssr * 
    38    INTEGER, PUBLIC ::   nn_sstr         ! SST/SSS restoring indicator 
    39    INTEGER, PUBLIC ::   nn_sssr         ! SST/SSS restoring indicator 
    40    REAL(wp)        ::   rn_dqdt         ! restoring factor on SST and SSS 
    41    REAL(wp)        ::   rn_deds         ! restoring factor on SST and SSS 
    42    LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term  
    43    REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day] 
    44    LOGICAL         ::   ln_UKMO_haney   ! UKMO specific flag to calculate Haney forcing   
    45  
    46    REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange 
    47    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sst   ! structure of input SST (file informations, fields read) 
    48    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sss   ! structure of input SSS (file informations, fields read) 
     34   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chldmp   ! structure of input Chl (file informations, fields read) 
    4935 
    5036   !! * Substitutions 
    51 #  include "domzgr_substitute.h90" 
    52    !!---------------------------------------------------------------------- 
    53    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    54    !! $Id$ 
    55    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    56    !!---------------------------------------------------------------------- 
     37#  include "top_substitute.h90" 
     38 
    5739CONTAINS 
    5840 
    59    SUBROUTINE sbc_ssr( kt ) 
     41   SUBROUTINE trc_sbc_ssr( kt ) 
    6042      !!--------------------------------------------------------------------- 
    61       !!                     ***  ROUTINE sbc_ssr  *** 
     43      !!                     ***  ROUTINE trc_sbc_ssr  *** 
    6244      !! 
    63       !! ** Purpose :   Add to heat and/or freshwater fluxes a damping term 
    64       !!                toward observed SST and/or SSS. 
     45      !! ** Purpose :   Add to chlorophyll a damping term 
     46      !!                toward chlorophyll climatology 
    6547      !! 
    66       !! ** Method  : - Read namelist namsbc_ssr 
    67       !!              - Read observed SST and/or SSS 
    68       !!              - at each nscb time step 
    69       !!                   add a retroaction term on qns    (nn_sstr = 1) 
    70       !!                   add a damping term on sfx        (nn_sssr = 1) 
    71       !!                   add a damping term on emp        (nn_sssr = 2) 
     48      !! ** Method  : - Read chlorophyll climatology 
     49      !!              - at each trc time step add term to each PFT 
     50      !!                   surface only    (nn_chldmp = 1) 
     51      !!                   mixed layer     (nn_chldmp = 2) 
    7252      !!--------------------------------------------------------------------- 
    7353      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    7454      !! 
    75       INTEGER  ::   ji, jj   ! dummy loop indices 
    76       REAL(wp) ::   zerp     ! local scalar for evaporation damping 
    77       REAL(wp) ::   zqrp     ! local scalar for heat flux damping 
    78       REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor 
    79       REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 
    80       INTEGER  ::   ierror   ! return error code 
    81       !! 
    82       REAL(wp) ::   sst1,sst2                      ! sea surface temperature 
    83       REAL(wp) ::   e_sst1, e_sst2                 ! saturation vapour pressure 
    84       REAL(wp) ::   qs1,qs2                        ! specific humidity 
    85       REAL(wp) ::   pr_tmp                         ! temporary variable for pressure 
     55      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    8656  
    87       REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc1    ! Haney forcing for sensible heat, correction for latent heat    
    88       REAL(wp), DIMENSION(jpi,jpj) ::  hny_frc2    ! Haney forcing for sensible heat, correction for latent heat    
    89       !! 
    90       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    91       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
     57      REAL(wp), DIMENSION(jpi,jpj) :: ztra, zchl 
     58      REAL(wp)                     :: zpft 
    9259      !!---------------------------------------------------------------------- 
    9360      ! 
    94       IF( nn_timing == 1 )  CALL timing_start('sbc_ssr') 
     61      IF( nn_timing == 1 )  CALL timing_start('trc_sbc_ssr') 
    9562      ! 
    96       IF( nn_sstr + nn_sssr /= 0 ) THEN 
     63      IF( kt == nittrc000 ) THEN 
    9764         ! 
    98          IF( nn_sstr == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it at kt 
    99          IF( nn_sssr >= 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it at kt 
     65         CALL trc_sbc_ssr_init 
    10066         ! 
    101          !                                         ! ========================= ! 
    102          IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    Add restoring term     ! 
    103             !                                      ! ========================= ! 
     67         IF( nn_chldmp > 0 ) THEN 
    10468            ! 
    105             IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    106                   IF( ln_UKMO_haney ) THEN 
    107                      DO jj = 1, jpj 
    108                         DO ji = 1, jpi 
    109                            sst1   =  sst_m(ji,jj) 
    110                            sst2   =  sf_sst(1)%fnow(ji,jj,1)    
    111                            e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1)) 
    112                            e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2))          
    113                            pr_tmp = 0.01*pressnow(ji,jj)  !pr_tmp = 1012.0 
    114                            qs1    = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1) 
    115                            qs2    = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2) 
    116                            hny_frc1(ji,jj) = sst1-sst2                    
    117                            hny_frc2(ji,jj) = qs1-qs2                      
    118                           !Might need to mask off land points. 
    119                            hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42 
    120                            hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0 
    121                            qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj)    
    122                            qrp(ji,jj) = 0.e0 
     69            IF (lwp) WRITE(numout,*) 'Damping chlorophyll on timestep ', kt 
     70            ! 
     71            CALL fld_read( kt, 1, sf_chldmp )   ! Read Chl data and provides it at kt 
     72            ! 
     73#if defined key_fabm 
     74            zchl(:,:) = trb(:,:,1,jp_fabm_m1+jp_fabm_chl1) + & 
     75               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl2) + & 
     76               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl3) + & 
     77               &        trb(:,:,1,jp_fabm_m1+jp_fabm_chl4) 
     78            ztra(:,:) = rn_chldmp * ( sf_chldmp(1)%fnow(:,:,1) - zchl(:,:) ) 
     79            ! 
     80            DO jj = 2, jpjm1 
     81               DO ji = fs_2, fs_jpim1   ! vector opt. 
     82                  IF ( ( sf_chldmp(1)%fnow(ji,jj,1) >   0.0 ) .AND. & 
     83                     & ( sf_chldmp(1)%fnow(ji,jj,1) < 100.0 ) .AND. & 
     84                     & ( zchl(ji,jj)                >   0.0 ) ) THEN 
     85                     WRITE(numout,'(A,3I,3F)') 'ssr, nproc, ji, jj, zchl, sf, ztra = ', nproc, ji, jj, zchl(ji,jj), sf_chldmp(1)%fnow(ji,jj,1), ztra(ji,jj) 
     86                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) / zchl(ji,jj) ) * ztra(ji,jj) 
     87                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) + zpft 
     88                     WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb1, zpft1 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1), zpft 
     89                     IF( nn_chldmp == 2 ) THEN 
     90                        DO jk = 2, jpkm1 
     91                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 
     92                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) + zpft 
     93                           ENDIF 
    12394                        END DO 
    124                      END DO 
    125                   ELSE 
    126                      DO jj = 1, jpj 
    127                         DO ji = 1, jpi 
    128                            zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
    129                            qns(ji,jj) = qns(ji,jj) + zqrp 
    130                            qrp(ji,jj) = zqrp 
     95                     ENDIF 
     96                     ! 
     97                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) / zchl(ji,jj) ) * ztra(ji,jj) 
     98                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) + zpft 
     99                     WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb2, zpft2 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2), zpft 
     100                     IF( nn_chldmp == 2 ) THEN 
     101                        DO jk = 2, jpkm1 
     102                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 
     103                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) + zpft 
     104                           ENDIF 
    131105                        END DO 
    132                      END DO 
     106                     ENDIF 
     107                     ! 
     108                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) / zchl(ji,jj) ) * ztra(ji,jj) 
     109                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) + zpft 
     110                     WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb3, zpft3 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3), zpft 
     111                     IF( nn_chldmp == 2 ) THEN 
     112                        DO jk = 2, jpkm1 
     113                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 
     114                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) + zpft 
     115                           ENDIF 
     116                        END DO 
     117                     ENDIF 
     118                     ! 
     119                     zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) / zchl(ji,jj) ) * ztra(ji,jj) 
     120                     tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) + zpft 
     121                     WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb4, zpft4 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4), zpft 
     122                     IF( nn_chldmp == 2 ) THEN 
     123                        DO jk = 2, jpkm1 
     124                           IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 
     125                              tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) + zpft 
     126                           ENDIF 
     127                        END DO 
     128                     ENDIF 
    133129                  ENDIF 
    134                CALL iom_put( "qrp", qrp )                             ! heat flux damping 
    135             ENDIF 
    136             ! 
    137             IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    138                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    139 !CDIR COLLAPSE 
    140                DO jj = 1, jpj 
    141                   DO ji = 1, jpi 
    142                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    143                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )  
    144                      sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux 
    145                      erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only) 
    146                   END DO 
    147130               END DO 
    148                CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    149                ! 
    150             ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 
    151                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    152                zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    153 !CDIR COLLAPSE 
    154                DO jj = 1, jpj 
    155                   DO ji = 1, jpi                             
    156                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    157                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    158                         &        / MAX(  sss_m(ji,jj), 1.e-20   ) 
    159                      IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 
    160                      emp(ji,jj) = emp (ji,jj) + zerp 
    161                      qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 
    162                      erp(ji,jj) = zerp 
    163                   END DO 
    164                END DO 
    165                CALL iom_put( "erp", erp )                             ! freshwater flux damping 
    166             ENDIF 
     131            END DO 
     132#else 
     133            CALL ctl_stop( 'STOP', 'trc_sbc_ssr: only works with FABM-ERSEM' ) 
     134#endif 
    167135            ! 
    168136         ENDIF 
     
    170138      ENDIF 
    171139      ! 
    172       IF( nn_timing == 1 )  CALL timing_stop('sbc_ssr') 
     140      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc_ssr') 
    173141      ! 
    174    END SUBROUTINE sbc_ssr 
     142   END SUBROUTINE trc_sbc_ssr 
    175143 
    176144  
    177    SUBROUTINE sbc_ssr_init 
     145   SUBROUTINE trc_sbc_ssr_init 
    178146      !!--------------------------------------------------------------------- 
    179       !!                  ***  ROUTINE sbc_ssr_init  *** 
     147      !!                  ***  ROUTINE trc_sbc_ssr_init  *** 
    180148      !! 
    181149      !! ** Purpose :   initialisation of surface damping term 
    182150      !! 
    183       !! ** Method  : - Read namelist namsbc_ssr 
    184       !!              - Read observed SST and/or SSS if required 
     151      !! ** Method  : - Read chlorophyll 
    185152      !!--------------------------------------------------------------------- 
    186       INTEGER  ::   ji, jj   ! dummy loop indices 
    187       REAL(wp) ::   zerp     ! local scalar for evaporation damping 
    188       REAL(wp) ::   zqrp     ! local scalar for heat flux damping 
    189       REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor 
    190       REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 
    191153      INTEGER  ::   ierror   ! return error code 
    192       !! 
    193       CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    194       TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    195       NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, ln_UKMO_haney 
    196       INTEGER     ::  ios 
    197154      !!---------------------------------------------------------------------- 
    198155      ! 
    199   
    200       REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :  
    201       READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) 
    202 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp ) 
    203  
    204       REWIND( numnam_cfg )              ! Namelist namsbc_ssr in configuration namelist : 
    205       READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 ) 
    206 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp ) 
    207       IF(lwm) WRITE ( numond, namsbc_ssr ) 
    208  
    209       IF(lwp) THEN                 !* control print 
    210          WRITE(numout,*) 
    211          WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
    212          WRITE(numout,*) '~~~~~~~ ' 
    213          WRITE(numout,*) '   Namelist namsbc_ssr :' 
    214          WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr 
    215          WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr 
    216          WRITE(numout,*) '                       (Yes=2, volume flux) ' 
    217          WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
    218          WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
    219          WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
    220          WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
    221          WRITE(numout,*) '      Haney forcing                          ln_UKMO_haney = ', ln_UKMO_haney 
    222       ENDIF 
    223       ! 
    224       !                            !* Allocate erp and qrp array 
    225       ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 
    226       IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 
    227       ! 
    228       IF( nn_sstr == 1 ) THEN      !* set sf_sst structure & allocate arrays 
     156      IF( nn_chldmp > 0 ) THEN      !* set sf_sss structure & allocate arrays 
    229157         ! 
    230          ALLOCATE( sf_sst(1), STAT=ierror ) 
    231          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' ) 
    232          ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror ) 
    233          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' ) 
     158         ALLOCATE( sf_chldmp(1), STAT=ierror ) 
     159         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp structure' ) 
     160         ALLOCATE( sf_chldmp(1)%fnow(jpi,jpj,1), STAT=ierror ) 
     161         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp now array' ) 
    234162         ! 
    235          ! fill sf_sst with sn_sst and control print 
    236          CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 
    237          IF( sf_sst(1)%ln_tint )   ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    238          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' ) 
     163         ! fill sf_sss with sn_sss and control print 
     164         CALL fld_fill( sf_chldmp, (/ sn_chldmp /), cn_dir_chldmp, 'trc_sbc_ssr', 'Chl restoring term', 'namtrc_dmp' ) 
     165         IF( sf_chldmp(1)%ln_tint )   ALLOCATE( sf_chldmp(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
     166         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp data array' ) 
    239167         ! 
    240168      ENDIF 
    241169      ! 
    242       IF( nn_sssr >= 1 ) THEN      !* set sf_sss structure & allocate arrays 
    243          ! 
    244          ALLOCATE( sf_sss(1), STAT=ierror ) 
    245          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' ) 
    246          ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror ) 
    247          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' ) 
    248          ! 
    249          ! fill sf_sss with sn_sss and control print 
    250          CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 
    251          IF( sf_sss(1)%ln_tint )   ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 
    252          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 
    253          ! 
    254       ENDIF 
    255       ! 
    256       !                            !* Initialize qrp and erp if no restoring  
    257       IF( nn_sstr /= 1                   )   qrp(:,:) = 0._wp 
    258       IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0._wp 
    259       ! 
    260    END SUBROUTINE sbc_ssr_init 
    261        
     170   END SUBROUTINE trc_sbc_ssr_init 
     171 
     172#else 
     173   SUBROUTINE trc_sbc_ssr( kt )        ! Empty routine 
     174      INTEGER, INTENT(in) :: kt 
     175      WRITE(*,*) 'trc_sbc_ssr: You should not have seen this print! error?', kt 
     176   END SUBROUTINE trc_sbc_ssr 
     177#endif 
    262178   !!====================================================================== 
    263 END MODULE sbcssr 
     179END MODULE trcsbcssr 
  • branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r6332 r8141  
    2929   USE trcbdy          ! BDY open boundaries 
    3030   USE bdy_par, only: lk_bdy 
     31   USE trcsbcssr 
    3132 
    3233#if defined key_agrif 
     
    6667      IF( .NOT. lk_c1d ) THEN 
    6768         ! 
     69         IF( nn_chldmp > 0 )    CALL trc_sbc_ssr( kstp )        ! add Chl damping term 
    6870                                CALL trc_sbc( kstp )            ! surface boundary condition 
    6971         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
     
    9395         ! 
    9496      ELSE                                               ! 1D vertical configuration 
     97         IF( nn_chldmp > 0 )    CALL trc_sbc_ssr( kstp )        ! add Chl damping term 
    9598                                CALL trc_sbc( kstp )            ! surface boundary condition 
    9699         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
Note: See TracChangeset for help on using the changeset viewer.